Module ChooseColor()

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Mesa
Messages : 1126
Inscription : mer. 14/sept./2011 16:59

Module ChooseColor()

Message par Mesa »

Un module qui affiche le color requester mais complètement ouvert avec gestion des 16 couleurs en mémoire et avec la possibilité d'afficher le requester n'importe où dans l'écran.

Pour Windows seulement.

Code : Tout sélectionner

;- 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
[Edition Juillet 2023] Ajout de couleur par défaut.


M.
Dernière modification par Mesa le mer. 26/juil./2023 14:58, modifié 2 fois.
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Module ChooseColor()

Message par Ollivier »

Code : Tout sélectionner

Case #LANG_GERMAN
WindowTitle$ = "Farben"
! (avant de tester...)
Répondre