For Windows only.
[Edit june 2023]: Add language Russian, Spanish, German and fix something wrong in the preference file name
[Edit july 2023] : Add default color as parameter.
Code: Select all
;- TOP
;|-------------------------------------------------------------------------------------------------
;|
;| Title : Module ChooseColor requester
;| Author : Mesa
;| Version : 0.2
;| Copyright : Mesa
;| Date : July 2023
;|
;| PureBasic : 5.70 and over
;| Operating System : Windows only
;| Processor : x86, x64, (arm not tested)
;| DPI aware : ?
;|
;|-------------------------------------------------------------------------------------------------
;|
;| Description : Module for displaying the color requester wide open + owner colors + move
;|
;| Forum Topic : https://www.purebasic.fr/french/viewtopic.php?t=19015
;| https://www.purebasic.fr/english/viewtopic.php?t=81888
;|
;|
;|-------------------------------------------------------------------------------------------------
;.-------------------------------------------------------------------------------------------------
;|
;| License Mesa.
;| The license Mesa is, do what you like but make the World better, easier and enjoyable.
;|
;|
;|
;| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;| IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;| FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;| AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;| LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;| OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;| SOFTWARE.
;|
;.-------------------------------------------------------------------------------------------------
;.-------------------------------------------------------------------------------------------------
;|
;| USE:
;|
;| Result = ChooseColor([Color, IniFile$, ParentWindowHandle, IndexColorSelected, X, Y])
;|
;| (all integers .i)
;|
;.-------------------------------------------------------------------------------------------------
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
CompilerEndIf
;-
;- DeclareModule ChooseColor
DeclareModule ChooseColor
; Struct used to move the ChooseColor requester in the screen
Structure ChooseColorPos
Title$
X.i
Y.i
EndStructure
Declare ThreadMoveWindow(*Parameter.ChooseColorPos)
Declare ChooseColor(Color=0, IniFile$="", Parent=0, ColorSelected=0, x=0, y=0)
EndDeclareModule
;-
;- Module
Module ChooseColor
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
CompilerEndIf
Procedure ThreadMoveWindow(*Parameter.ChooseColorPos)
; Thread procedure used to move the ChooseColor requester in the screen
Protected WindowHwd
If WindowHwd = 0
Repeat
WindowHwd = FindWindow_("#32770", *Parameter\Title$)
Until WindowHwd
; Pos.RECT : GetWindowRect_(WindowHwd,Pos); Could be usefull if you've got dpi problems
SetWindowPos_(WindowHwd, #HWND_TOPMOST, *Parameter\X, *Parameter\Y, 0, 0, #SWP_NOSIZE|#SWP_SHOWWINDOW)
ClearStructure(*Parameter, ChooseColorPos)
FreeMemory(*Parameter)
EndIf
EndProcedure
Procedure ChooseColor(Color=0, IniFile$ = "", Parent = 0, ColorSelected = 0, X = 0, Y = 0)
; IniFile$: Path and file name of a preference (ini) file that contains the 16 owner's colors
; Parent: WindowID of the parent. 0 = no parent. If non valid, the ChooseColor doesn't display
; ColorSelected: Select one of the 16 owner's Requester colors, index from [0..15] and display it
; X, Y: (experimental): Move the requester at these cordonnates
Structure ColorMemory
RGB.l[16]
EndStructure
Protected ColorMemory.ColorMemory
Protected ChooseColor.ChooseColor
Protected ExistingINI, i, hw, ThreadID, WindowTitle$, IniPath, IniFilename, Result
;{ If IniFile$ then open or create a preference file to save the 16 owner's requester colors
If IniFile$ <> ""
; Check the path
If FileSize(GetPathPart(IniFile$))= -2
IniPath=10
EndIf
;Check filename
If CheckFilename(GetFilePart(IniFile$))>0
IniFilename=1
EndIf
; 3 Cases
Select IniPath+IniFilename
Case 0
IniFile$=GetCurrentDirectory() + "ChooseColor.ini"
Case 1
IniFile$=GetCurrentDirectory() + GetFilePart(IniFile$)
Case 10
IniFile$=GetPathPart(IniFile$) + "ChooseColor.ini"
; Case 11
; ok
Default
IniFile$=GetCurrentDirectory() + "ChooseColor.ini"
EndSelect
ExistingINI = OpenPreferences(IniFile$)
;If not exists then create it with default values 0
If ExistingINI = 0
ExistingINI = CreatePreferences(IniFile$)
For i=0 To 15
WritePreferenceInteger("ColorMemory" + Str(i), 0)
Next i
FlushPreferenceBuffers()
Else ; it exists then retrieve colors
For i=0 To 15
ColorMemory\RGB[i] = ReadPreferenceInteger("ColorMemory" + Str(i), ColorMemory\RGB[i])
Next i
EndIf
EndIf
;}
;Set ChooseColor_() flags
ChooseColor\LStructSize = SizeOf(ChooseColor)
ChooseColor\hwndOwner = Parent
ChooseColor\rgbResult = Color ; 0 = no color selected
ChooseColor\lpCustColors = ColorMemory
ChooseColor\flags = #CC_ANYCOLOR | #CC_FULLOPEN | #CC_RGBINIT
;{ Move the requester (experimental)
If x<>0 Or y<>0
Select GetUserDefaultLangID_() & $0003FF
; +-------------------------+-------------------------+
; | SubLanguage ID | Primary Language ID |
; +-------------------------+-------------------------+
; 15 10 9 0 bit
Case #LANG_ENGLISH
WindowTitle$ = "Colors"
Case #LANG_FRENCH
WindowTitle$ = "Couleurs"
Case #LANG_GERMAN
WindowTitle$ = "Farben"
Case #LANG_RUSSIAN
WindowTitle$ = "Цвет"
Case #LANG_SPANISH
WindowTitle$ = "Colores"
;Case xxx
;TODO your own language
Default
WindowTitle$ = "Colors"
DebuggerWarning("PLEASE ADD YOUR LANGUAGE !")
EndSelect
Protected *Parameter.ChooseColorPos = AllocateMemory(SizeOf(ChooseColorPos))
*Parameter\Title$ = WindowTitle$
*Parameter\X = x
*Parameter\Y = y
ThreadID=CreateThread(@ThreadMoveWindow(),*Parameter)
EndIf
;}
;Display the color requester
Result= ChooseColor_(@ChooseColor)
;As the requester is a modal window, it's closed now then update the ini file if a color was chosen
If Result
If ExistingINI And ChooseColor\rgbResult
For i=0 To 15
WritePreferenceInteger("ColorMemory"+Str(i), ColorMemory\RGB[i])
Next i
ClosePreferences()
EndIf
ProcedureReturn ChooseColor\rgbResult
Else
ProcedureReturn -1
EndIf
EndProcedure
EndModule
;-
;- END
;-
;- Example
CompilerIf #PB_Compiler_IsMainFile
UseModule ChooseColor
; Debug ChooseColor()
Debug ChooseColor(#Red,"ok",0,1,500,100)
CompilerEndIf
M.
