Module ChooseColor()
Posted: Thu Jun 22, 2023 10:18 am
A module that displays the color requester but completely open with management of the 16 user colors and with the possibility of displaying the requester anywhere on the screen.
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.
M.
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.
