Page 1 of 1

Choose a color

Posted: Sun Dec 29, 2024 6:13 pm
by AZJIO
Image

Code: Select all

EnableExplicit

Structure NMBHOTITEM Extends NMHDR
	dwFlags.l
EndStructure

#BCN_HOTITEMCHANGE = -1249

Enumeration
	#Window
	#WinSetColor
EndEnumeration

Enumeration
	#btn
	#StatusBar
EndEnumeration


Global hovering, hBtn, hGUI, wwe, eg, hGUI2
Global m.POINT

Declare MyWindowCallback(hWin, Msg, wParam, lParam)
Declare PopupWindow(id)
Declare CreatePopupWindow()
Declare SizeWindowHandler()

Structure ListColor
	id.i
	color.l
EndStructure

Global NewList ListColor.ListColor()


hGUI = OpenWindow(#Window, 0, 0, 290, 260, "Color selection",
                  #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget)
hBtn = ButtonGadget(#btn, 10, 10, 120, 22, "Menu")
TextGadget(#StatusBar, 5, 260 - 20, 150, 17, "StatusBar")

CreatePopupWindow()

BindEvent(#PB_Event_SizeWindow, @SizeWindowHandler())
SetWindowCallback(@MyWindowCallback())

Repeat
	wwe = WaitWindowEvent()
	If EventWindow() = #WinSetColor
		Select wwe
			Case #PB_Event_DeactivateWindow
				hovering = 0
				HideWindow(#WinSetColor, #True)
				; If hovering = 1
				; m\x = WindowMouseX(#WinSetColor)
				; m\y = WindowMouseY(#WinSetColor)
				; ; 					Debug m\x
				; If m\x = -1 Or m\y = -1
				; hovering = 0
				; HideWindow(#WinSetColor, #True)
				; ; 						Break
				; EndIf
				; EndIf
			Case #PB_Event_Gadget
				eg = EventGadget()
				With ListColor()
					; Debug wwe
					ForEach ListColor()
						; Debug \id
						If eg = \id
							; Debug \id
							; Debug \color
							SetGadgetText(#btn, RSet(Hex(\color), 6, "0"))
							SetWindowColor(#Window, \color)
							SetGadgetColor(#StatusBar, #PB_Gadget_BackColor, \color)
							HideWindow(#WinSetColor, #True)
							Break
						EndIf
					Next
				EndWith
		EndSelect
	EndIf
	If wwe = #PB_Event_CloseWindow
		CloseWindow(#Window)
		End
	EndIf
	If hovering = 2
		hovering = 0
		PopupWindow(#btn)
	EndIf
ForEver

Procedure CreatePopupWindow()
	Protected i, xx = -22, yy
	hGUI2 = OpenWindow(#WinSetColor, 0, 0, 22 * 7, 22 * 5, "",
	                   #PB_Window_BorderLess | #PB_Window_Invisible, hGUI)
	; UseGadgetList(hGUI2)
	; HideWindow(#WinSetColor, #True)
	; Restore color
	With ListColor()
; 		Debug(?colorEnd - ?color) / SizeOf(Long)
		For i = 1 To 35
			AddElement(ListColor())
			Read.l \color
			If CreateImage(i, 22, 22, 24, \color)
				Select i
					Case 8, 15, 22, 29
						xx = 0
						yy + 22
					Default
						xx + 22
				EndSelect
				\id = ImageGadget(#PB_Any, xx, yy, 22, 22, ImageID(i))
				; \id = ButtonImageGadget(#PB_Any, xx, yy, 22, 22, ImageID(i))
				; \id = i
				; ImageGadget(i, xx, yy, 22, 22, ImageID(i))
			EndIf
		Next
	EndWith
	; UseGadgetList(hGUI)
EndProcedure


; BORDER
; #SM_CXBORDER = 5
; #SM_CYBORDER = 6
; Norm
; #SM_CXDLGFRAME = 7
; #SM_CYDLGFRAME = 8
; Resize
; #SM_CXFRAME = 32
; #SM_CYFRAME = 33

Procedure PopupWindow(id)
	Protected x, y, xd, yd, Style, Caption
	Style = GetWindowLongPtr_(WindowID(#Window), #GWL_STYLE)
	If Style & #WS_THICKFRAME
		; xd = #SM_CXFRAME
		xd = #SM_CXDLGFRAME
		yd = #SM_CYFRAME
		Caption = GetSystemMetrics_(#SM_CYCAPTION)
		; Debug "THICKFRAME"
	ElseIf Style & #WS_DLGFRAME
		xd = #SM_CXDLGFRAME
		yd = #SM_CYDLGFRAME
		Caption = GetSystemMetrics_(#SM_CYCAPTION)
		; Debug "DLGFRAME"
	Else
		xd = #SM_CXBORDER
		yd = #SM_CYBORDER
		Caption = 0
		; Debug "BORDER"
	EndIf
	x = WindowX(#Window) + GadgetX(id) + GetSystemMetrics_(xd)
	y = WindowY(#Window) + GadgetY(id) + GadgetHeight(id) + Caption + GetSystemMetrics_(yd)
	ResizeWindow(#WinSetColor, x, y, #PB_Ignore, #PB_Ignore)
	HideWindow(#WinSetColor, #False)
EndProcedure

Procedure SizeWindowHandler()
	HideWindow(#WinSetColor, #True)
EndProcedure


Procedure MyWindowCallback(hWin, Msg, wParam, lParam)
	Protected *pnmlv2.NMBHOTITEM = lParam
	; ID = *pnmlv2\IDFrom
	Select Msg
		Case #WM_NOTIFY
			Select *pnmlv2\hWndFrom
				Case hBtn
					Select *pnmlv2\Code
						Case #BCN_HOTITEMCHANGE ; Win XP и выше
							If *pnmlv2\dwFlags & $10
								hovering = 2
							ElseIf *pnmlv2\dwFlags & $20
								hovering = 1
							EndIf
					EndSelect
			EndSelect
	EndSelect
	ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

DataSection
	color:
	Data.l $9999bb, $aa99aa, $cccc00, $CCCCEE, $b0b558, $dadd4e, $FF0000
	Data.l $FFCA42, $E2B4B4, $C04141, $99CCFF, $F06320, $862D2D, $F9E6E6
	Data.l $0000FF, $FFFF00, $72ADC0, $71AE71, $C738B9, $AAA6DB, $0080FF
	Data.l $FF46FF, $FF8080, $D29A6C, $EA9515, $F000FF, $0080C0, $7D8AE6
	Data.l $FFFFFF, $cccccc, $696969, $CCCCEE, $5d5d5d, $AAAAAA, $3F3F3F
	colorEnd:
EndDataSection

Re: Choose a color

Posted: Mon Jan 13, 2025 10:15 am
by Zapman
A very compact and efficient code!
Thank you Azjio!