# PureBasic Forum

 It is currently Wed Oct 21, 2020 2:56 am

 All times are UTC + 1 hour

 Page 1 of 1 [ 4 posts ]
 Print view Previous topic | Next topic
Author Message
 Post subject: Ultimate colour requestorPosted: Fri Sep 25, 2020 2:57 pm
 User

Joined: Tue Dec 31, 2013 9:18 pm
Posts: 21
Recently I needed a colour requestor for a program I was developing. I needed to be able to load and save user defined colours and to store the currently selected colour. The program used several different colour palettes so I needed to be able to store the data for each palettes independently.

I decided to create a class that would achieve this purpose [I am using the term 'class' to refer to a template that defines a set of methods and variables. I will use the term object to refer to an instance of a class]. The code for the class is shown below.

Code:
; To use this object in another PB file, use:

; XIncludeFile "PaletteObj.pbi"
; UseModule JC_ClassColourPalette

; Copyright (C) 2020 John Crew

; Redistribution and use in source and binary forms, with or without modification, for commercial and non-commercial
; purposes are permitted provided that the following conditions are met:

; 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

; 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following
; disclaimer in the documentation and/or other materials provided with the distribution.

; 3. Neither the name of the copyright holder nor contributors may be used to endorse or promote products derived
; from this software.

; 4. The source code, and any derived source code, must be made available to users of this software and any software
; derived from this source code.

; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS" AND ANY
; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
; THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
; TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

DeclareModule JC_ModColourPalette
#Edge = 10 ;Distance from the inner edge of the palette window to the first colour square
#Border = 2 ;
#Separation=5 ;Distance between coloured squares
#OSq = 15 ; Length of each side of the coloured squares
#Rows=5 ;Number of rows of coloured squares
#Columns=8 ;Number of columns of coloured squares

;CLASS INTERFACE

Interface JC_ClassColourPalette
PutUserDefinedColours(Array Colours(1))
GetUserDefinedColours(Array Colours(1))
PaletteWindowEvents()
BalloonInfo()
OriginalProcessButtonMsg()
MoreColoursClicked()
GetSelectedColour()
SquareClicked()
DrawBorder(index)
GetColouredSquare()
ShowPalette(xpos, ypos)     ;Call this method to show the palette. xpos and ypos are screen co-ords that determine where to position the palette window
KillFocus(hwnd)
MouseLeave()
SaveUserColours()
Free()            ;Call this method to free the palette object
EndInterface

Declare.i InitColourPalette(initColour = $0000FF) EndDeclareModule Module JC_ModColourPalette EnableExplicit Enumeration;{ #btnMoreColours EndEnumeration ;Constants for the tooltip #TTF_ABSOLUTE =$0080
#TTF_TRACK = $0020 ;} ;{ Structures for the palette ;The structure COLORREF is used to store user defined colours from the Color common dialog box. Structure COLORREF ; Used by Colour requestor RGB.l[16] EndStructure CompilerIf #PB_Compiler_Processor = #PB_Processor_x86 ;A set of PALETTE structures are stored in a list within the Structure Class_Palette ;Each element in the list represents one of the coloured squares in the palette Structure PALETTE index.w ;Index for the coloured square - starts at 0 color.l ;A property that represents the colour of the square colName.s ;The name of the colour rc.RECT ;The co-ords of the rectangle containing the coloured square EndStructure ;-CLASS TEMPLATE Structure Class_Palette VirtualTable.i ;This table contains a set of addresses for the functions in the class. MUST be first item in the structure rcPrev.Rect ;These are data associated with the class CurrentIndex.i ;Index of the currently selected element in the palette list hTooltip.l ;Windows handle for the tooltip List palette.PALETTE() ;List of PALETTE structures for each coloured square in the object CurrentColour.l IDPaletteWindow.l ;PB ID of the Palette window hwndPalette.l ;Windows handle of the Palette window IDBtnMoreCols.l ;PB ID of the 'More colours' button hwndBtnMoreCols.l ;Windows handle of the 'More colours' button oldButtonProc.l ;Pointer to original message processing proc for the 'More colours' button ColourRef.COLORREF;Used for getting more colours PaleteFile.s ;Stores name of the file containing details of user defined colours EndStructure ;======================================================== CompilerElse ;RGB.i[16] for x64 ;A set of PALETTE structures are stored in a list within the Structure Class_Palette ;Each element in the list represents one of the coloured squares in the palette Structure PALETTE index.w ;Index for the coloured square - starts at 0 color.i ;A property that represents the colour of the square colName.s ;The name of the colour rc.RECT ;The co-ords of the rectangle containing the coloured square EndStructure ;-CLASS TEMPLATE Structure Class_Palette VirtualTable.i ;This table contains a set of addresses for the functions in the class. MUST be first item in the structure rcPrev.Rect ;These are data associated with the class CurrentIndex.i ;Index of the currently selected element in the palette list hTooltip.i ;Windows handle for the tooltip List palette.PALETTE() ;List of PALETTE structures for each coloured square in the object CurrentColour.i IDPaletteWindow.i ;PB ID of the Palette window hwndPalette.i ;Windows handle of the Palette window IDBtnMoreCols.i ;PB ID of the 'More colours' button hwndBtnMoreCols.i ;Windows handle of the 'More colours' button oldButtonProc.i ;Pointer to original message processing proc for the 'More colours' button ColourRef.COLORREF;Used for getting more colours PaleteFile.s ;Stores name of the file containing details of user defined colours EndStructure CompilerEndIf ;} Procedure MAKELONG(low, high) ProcedureReturn low | (high<<16) EndProcedure Procedure PutUserDefinedColours(*This.Class_Palette, Array Colours(1)) ; This procedure will get user defined colours from the array that is passed as a parameter and store them in the object Protected j For j=0 To 15 *This\ColourRef\RGB[j] = Colours(j) Next j EndProcedure Procedure GetUserDefinedColours(*This.Class_Palette, Array Colours(1)) ; This procedure will copy user defined colours from the object to the array that is passed as a parameter Protected j For j=0 To 15 Colours(j) = *This\ColourRef\RGB[j] Next j EndProcedure Procedure PaletteWindowEvents(*This.Class_Palette) ; When another module calls ShowPalette(), control is immediately passed back to the other module before a colour can be selected. ; So if the other module tries to get a selected colour immediately after the palette window opens by calling GetSelectedColour() ; then as a colour has not been selected the old colour is returned. ; To prevent this, the object uses its own WaitWindowEvent() in this procedure. ; The effect of the WaitWindowEvent() in this procedure is that it suspends events from being processed by the WaitWindowEvent() ; of the other module as events are passed to this procedure. ; When the palette window closes [using PostMessage_(*This\hwndPalette,#WM_SYSCOMMAND,#SC_CLOSE,0)] the WaitWindowEvent() in ; the other module takes over event processing. ; IMPORTANT The palette window must be closed by calling PostMessage_(*This\hwndPalette,#WM_SYSCOMMAND,#SC_CLOSE,0) ; If the palette window is closed using any other means then then WaitWindowEvent() in this procedure will continue to process ; events and the main window will not receive them. This will freeze the main window Protected QuitPaletteWindow Repeat Select WaitWindowEvent() Case #PB_Event_CloseWindow If EventWindow() = *This\IDPaletteWindow QuitPaletteWindow = #True CloseWindow(*This\IDPaletteWindow) EndIf EndSelect Until QuitPaletteWindow EndProcedure Procedure Free(*This.Class_Palette) ClearStructure(*This, Class_Palette) FreeStructure(*This) EndProcedure Procedure BalloonInfo(*This.Class_Palette, PosX, PosY, MaxWidth) Protected hToolTip Protected Balloon.TOOLINFO Protected null.w hToolTip=CreateWindowEx_(#WS_EX_TOPMOST,#TOOLTIPS_CLASS,#Null,#WS_POPUP | #TTS_NOPREFIX | #TTS_ALWAYSTIP | #TTS_BALLOON | #TTS_CLOSE,0,0,0,0,*This\hwndPalette,0,GetModuleHandle_(0),0) SetWindowTheme_(hToolTip, @null, @null); Required for the colours below SendMessage_(hToolTip,#TTM_SETTIPTEXTCOLOR,$0202FD,0)
SendMessage_(hToolTip,#TTM_SETTIPBKCOLOR,$DCFFFF,0) SendMessage_(hToolTip,#TTM_SETMAXTIPWIDTH,0,MaxWidth) ;Set as a multiline tooltip with wordwrap SendMessage_(hToolTip, #TTM_TRACKPOSITION, 0, MAKELONG(PosX,PosY)) Balloon.TOOLINFO\cbSize=SizeOf(TOOLINFO) Balloon\uFlags=#TTF_IDISHWND | #TTF_TRACK | #TTF_ABSOLUTE Balloon\hwnd=*This\hwndPalette Balloon\uId=*This\hwndPalette Balloon\lpszText= @*This\palette()\colName Balloon\hinst = GetModuleHandle_(0) GetWindowRect_(*This\hwndPalette, @Balloon\rect) SendMessage_(hToolTip, #TTM_ADDTOOL, 0, @Balloon); ;Register tooltip with the control SendMessage_(hToolTip, #TTM_TRACKACTIVATE, 1, @Balloon) ProcedureReturn hToolTip EndProcedure Procedure SetMouseTracking(hWindow) ;This procedure is not a class method ;If the mouse leaves the Palette Window rapidly then the tooltip over the coloured squares may stay on show. ;Also, the border around a non-selected colour square may show if the mouse moves rapidly outside this window. ;To prevent this, the Palette Window must respond to the #WM_MOUSELEAVE message to destroy the tooltip and ;remove the unwanted border ;To allow the Palette Window to respond to the #WM_MOUSELEAVE message the Window's ;function TrackMouseEvent() must be called ;As Windows cancels the tracking function whenever the #WM_MOUSELEAVE message fires, it ;is necessary to call the TrackMouseEvent() again when the mouse returns to the Palette Window. ;This procedure sets up the TRACKMOUSEEVENT structure and calls TrackMouseEvent() Protected TrackMouse.TRACKMOUSEEVENT TrackMouse\cbSize =SizeOf(TrackMouse) TrackMouse\dwFlags = #TME_LEAVE TrackMouse\hwndTrack = hWindow TrackMouseEvent_(@TrackMouse) EndProcedure Procedure MoreColoursClicked(*This.Class_Palette) ;This procedure opens the Color common dialog box that enables the user to select a color. ;It is called when the user clicks the button 'More colours' Protected ChooseColour.CHOOSECOLOR, hwnd, I ChooseColour\rgbResult = *This\CurrentColour ChooseColour\lpCustColors = *This\ColourRef ChooseColour\flags = #CC_ANYCOLOR | #CC_RGBINIT ;if required, use #CC_FULLOPEN to display the additional controls ChooseColour\lStructSize = SizeOf(CHOOSECOLOR) ChooseColour\hwndOwner = *This\hwndPalette ChooseColour\rgbResult = *This\CurrentColour ChooseColour\lpCustColors = *This\ColourRef ChooseColour\flags = #CC_ANYCOLOR | #CC_RGBINIT ;| #CC_FULLOPEN ;To display custom colour controls too | #CC_ENABLEHOOK If ChooseColor_(@ChooseColour) ;Open a Color dialog box; @ChooseColour points to a CHOOSECOLOR structure that contains information used to initialize the dialog box. When ChooseColor returns, this structure contains information about the user's color selection. *This\CurrentColour = ChooseColour\rgbResult EndIf PostMessage_(*This\hwndPalette,#WM_SYSCOMMAND,#SC_CLOSE,0) EndProcedure Procedure OriginalProcessButtonMsg(*This.Class_Palette) ProcedureReturn *This\oldButtonProc EndProcedure Procedure BtnGadgetProc(hwnd, msg, wparam, lparam) Protected *This.JC_ClassColourPalette = GetWindowLongPtr_(hwnd, #GWLP_USERDATA) Select msg Case #WM_LBUTTONDOWN *This\MoreColoursClicked() ProcedureReturn 1 EndSelect ProcedureReturn CallWindowProc_(*This\OriginalProcessButtonMsg(), hwnd, msg, wparam, lparam) EndProcedure Procedure DrawBorder(*This.Class_Palette, index) ;This procedure is called as the mouse moves over the palette window ;Index is the index number of the coloured square that the mouse is over (-1 if it is not over a coloured square) ;This procedure draws a border around the square with the specified index. ;It also shows the name of the colour in a tooltip ;It removes the border if the index is -1 and destroys the tooltip Protected rc.Rect, BorderCol, BorderInvCol Protected rcPalette.RECT BorderCol = RGB(0,0,0) BorderInvCol = GetSysColor_(#COLOR_BTNFACE) ;Need to use the normal window background colour for this... If (index >-1) And index < ((#Rows*#Columns)) ;Latter needed as index goes above #Rows*#Columns if more colours dialog shows SelectElement(*This\palette(), index) ;Get the structure for the selected coloured square rc=*This\palette()\rc ;Get the rectangular co=ords for the current colour InflateRect_(@rc, #Border, #Border) ;and increase its size for drawing its border If StartDrawing(WindowOutput(*This\IDPaletteWindow)) ;Remove the border from the previously selected colour square Line(*This\rcPrev\left, *This\rcPrev\top, *This\rcPrev\right-*This\rcPrev\left, 1, BorderInvCol) Line(*This\rcPrev\right, *This\rcPrev\top, 1, *This\rcPrev\bottom-*This\rcPrev\top, BorderInvCol) Line(*This\rcPrev\left, *This\rcPrev\bottom, *This\rcPrev\right-*This\rcPrev\left, 1, BorderInvCol) Line(*This\rcPrev\left, *This\rcPrev\top, 1, *This\rcPrev\bottom-*This\rcPrev\top, BorderInvCol) If (*This\CurrentIndex <> index) ;Do not remove the border from the square showing the current colour *This\rcPrev = rc ;Store the current expanded rectangle pointed to by the mouse if it is not the current colour ; so that its border can be erased when the mouse moves over a different colour EndIf ;Draw a rectangle around the selected coloured square Line(rc\left, rc\top, rc\right-rc\left, 1, BorderCol) Line(rc\right, rc\top, 1, rc\bottom-rc\top, BorderCol) Line(rc\left, rc\bottom, rc\right-rc\left, 1, BorderCol) Line(rc\left, rc\top, 1, rc\bottom-rc\top, BorderCol) StopDrawing() EndIf ;Now show tooltip If *This\hToolTip = #Null GetClientRect_(*This\hwndPalette, @rcPalette) ; Get client co-ords for Palette window MapWindowPoints_(*This\hwndPalette, 0, @rcPalette, 2) ; Convert rcPalette co-ords to screen coords ;Screen coords are needed for positioning the tooltip *This\hToolTip = BalloonInfo(*This.Class_Palette, rc\right+rcPalette\left, rcPalette\top+rc\bottom, 100) ;Tracking is cancelled by Windows when the mouse leaves the palette window so ;the procedure SetMouseTracking() must be called again when the mouse is in the palette window ;to reset the tracking process SetMouseTracking(*This\hwndPalette) EndIf ;Else Index is -1; this will occur as the mouse moves between the coloured squares so remove the border ;from the highlighted square and detroy the tooltip Else If StartDrawing(WindowOutput(*This\IDPaletteWindow)) ;Remove the border from coloured squares when a custom colour is selected Line(*This\rcPrev\left, *This\rcPrev\top, *This\rcPrev\right-*This\rcPrev\left, 1, BorderInvCol) Line(*This\rcPrev\right, *This\rcPrev\top, 1, *This\rcPrev\bottom-*This\rcPrev\top, BorderInvCol) Line(*This\rcPrev\left, *This\rcPrev\bottom, *This\rcPrev\right-*This\rcPrev\left, 1, BorderInvCol) Line(*This\rcPrev\left, *This\rcPrev\top, 1, *This\rcPrev\bottom-*This\rcPrev\top, BorderInvCol) StopDrawing() EndIf DestroyWindow_(*This\hToolTip) *This\hToolTip=#Null EndIf EndProcedure Procedure GetColouredSquare(*This.Class_Palette) ;This procedure determines the index for the square that the mouse is over and then calls DrawBorder() to ;draw a border around the coloured square that the mouse occupies and show a tooltip describing the colour ;It is called by the Palette window's callback procedure when the message #WM_MOUSEMOVE is sent to the palette window ;This code cannot be placed in the callback procedure itself as that can only access functions in the ;object and not, for example, access variables such as the list when it needs to be reset as in ResetList(*This\palette()) Protected MousePos.POINT, rc.RECT Protected Found=-1 Protected BorderInvCol = GetSysColor_(#COLOR_BTNFACE) GetCursorPos_(@MousePos) ;Gets cursor position of the mouse in the palette window in screen co-ords ScreenToClient_(*This\hwndPalette, @MousePos) ;converts the screen coordinates of the mouse position to palette window coordinates. ResetList(*This\palette()) ; Reset the List To access the first element. While NextElement(*This\palette()) And Found=-1 ; Look for the structure for the currently selected square in the palette rc=*This\palette()\rc If PtInRect_(@rc, MousePos\x | (MousePos\y<<32)) <>0 ;If mouse is on this coloured square then get index of square Found= *This\palette()\index EndIf Wend DrawBorder(*This.Class_Palette, Found) EndProcedure Procedure SquareClicked(*This.Class_Palette) ; This is called by paletteWinProc() when the left mouse button is clicked on the palette ; window (whether the mouse is on a coloured square or between the coloured squares) ; It resets the fields in rcPrev to zero, sets the value of CurrentColour, destroys the tooltip and posts ; a message to close the palette window. *This\rcPrev\right = 0 *This\rcPrev\left = 0 *This\rcPrev\top = 0 *This\rcPrev\bottom = 0 *This\CurrentColour=*This\palette()\color DestroyWindow_(*This\hToolTip) *This\hToolTip=#Null PostMessage_(*This\hwndPalette,#WM_SYSCOMMAND,#SC_CLOSE,0) ;Close the palette window using the waitWindowEvent() loop in PaletteWindowEvents(*This.Class_Palette) EndProcedure Procedure KillFocus(*This.Class_Palette, wParam) ;This procedure is called by paletteWinProc() ;Closes the palette window if another window is given the focus except for btnMoreColours ;Do not close the palette window if btnMoreColours has the focus ;otherwise the dialog for setting a custom colour is not shown when ;btnMoreColours is clicked PostMessage_(*This\hwndPalette,#WM_SYSCOMMAND,#SC_CLOSE,0) ;Close the palette window using the waitWindowEvent() loop in PaletteWindowEvents(*This.Class_Palette) DestroyWindow_(*This\hToolTip) *This\hToolTip=#Null EndProcedure Procedure MouseLeave(*This.Class_Palette) ;This procedure is called by paletteWinProc() ;It prevents the tooltip from staying on show if the mouse leaves the palette window rapidly when ;the palette window receives the message #WM_MOUSELEAVE ;It also removes the border around the coloured square that is not selected if the mouse ;leaves the palette window too quickly ;Requires the procedure SetMouseTracking() to enable the palette window to respond to this message ;Tracking is cancelled by Windows when the mouse leaves the window so ;the procedure SetMouseTracking() must be called again when the mouse is in the palette window Protected BorderInvCol = GetSysColor_(#COLOR_BTNFACE) DestroyWindow_(*This\hToolTip) *This\hToolTip=#Null If StartDrawing(WindowOutput(*This\IDPaletteWindow)) ;Remove the border from coloured squares Line(*This\rcPrev\left, *This\rcPrev\top, *This\rcPrev\right-*This\rcPrev\left, 1, BorderInvCol) Line(*This\rcPrev\right, *This\rcPrev\top, 1, *This\rcPrev\bottom-*This\rcPrev\top, BorderInvCol) Line(*This\rcPrev\left, *This\rcPrev\bottom, *This\rcPrev\right-*This\rcPrev\left, 1, BorderInvCol) Line(*This\rcPrev\left, *This\rcPrev\top, 1, *This\rcPrev\bottom-*This\rcPrev\top, BorderInvCol) StopDrawing() EndIf EndProcedure Procedure GetSelectedColour(*This.Class_Palette) ;This method is called by the parent module to obtain the selected colour ProcedureReturn *This\CurrentColour EndProcedure Procedure paletteWinProc(hwnd, msg, wparam, lparam) ;This is a callback procedure for the colour palette window ;When an object is created it is not possible to pass its address to callback methods. ;However, it can call object methods. ;This callback procedure responds to messages sent to the palette window from the mouse: ;It calls GetColouredSquare() when the mouse is over a coloured square to draws a border around ;the square that the mouse is over and to show a tooltip naming the selected colour. ;When the mouse is between coloured squares the tooltip is removed ;It calls SquareClicked() when the left mouse button is clicked. ; Get the pointer to the object in *This.JC_ClassColourPalette Protected *This.JC_ClassColourPalette = GetWindowLongPtr_(hwnd, #GWLP_USERDATA) Select msg Case #WM_MOUSEMOVE *This\GetColouredSquare() ;Draw border around coloured square under mouse cursor and show tooltip naming the colour of the square Case #WM_LBUTTONDOWN *This\SquareClicked() Case #WM_KILLFOCUS If hwnd<>(GetActiveWindow_()) *This\KillFocus(0) EndIf ProcedureReturn 0 Case #WM_MOUSELEAVE *This\MouseLeave() EndSelect ProcedureReturn #PB_ProcessPureBasicEvents EndProcedure Procedure ShowPalette(*This.Class_Palette,xpos=0, ypos=0) ; Draws the palette window and initialises the value of CurrentIndex ; Calls DrawBorder() to draw a border around the currently selected colour and ; calls PaletteWindowEvents() so that all events are processed by this object instead of ; the parent module. ; x and y specify the position of the top left hand corner of the colour palette window Protected Found=-1 Protected PaletteWidth= (2* #Edge)+(#Separation*(#Columns-1))+((#Columns) *#OSq) Protected PaletteHeight= (2* #Edge)+#Separation*(#Rows-1)+(#Rows*#OSq) Protected row, column, index=0 Protected LeftX = #Edge, TopY = #Edge Protected Width = #OSq Protected Height = #OSq PaletteHeight= PaletteHeight + 30 ;Allow space for the button 'More colours' *This\IDPaletteWindow = OpenWindow(#PB_Any, xpos, ypos, PaletteWidth, PaletteHeight, "", #PB_Window_BorderLess) *This\hwndPalette=WindowID(*This\IDPaletteWindow) SetWindowCallback(@paletteWinProc(), *This\IDPaletteWindow) ; Set up a callback procedure for the palette window with ID of IDPaletteWindow SetWindowLongPtr_(*This\hwndPalette, #GWLP_USERDATA, *This) ;Enables paletteWinProc() to access the object StickyWindow(*This\IDPaletteWindow, #True) ;Set Palette window topmost *This\IDBtnMoreCols = ButtonGadget(#PB_Any, 10, PaletteHeight-25, 150, 18, "More colours") *This\hwndBtnMoreCols = GadgetID(*This\IDBtnMoreCols) *This\oldButtonProc = SetWindowLongPtr_(*This\hwndBtnMoreCols, #GWL_WNDPROC, @BtnGadgetProc()) SetWindowLongPtr_(*This\hwndBtnMoreCols, #GWLP_USERDATA, *This) ;Enables the callback BtnGadgetProc() to access the object ;Draw a coloured square for each element in the list palette() FirstElement(*This\palette()) For row = 0 To #Rows-1 For column = 0 To #Columns-1 If StartDrawing(WindowOutput(*This\IDPaletteWindow)) Box(LeftX, TopY, Width, Height, *This\palette()\color) StopDrawing() *This\palette()\rc\left = LeftX *This\palette()\rc\top = TopY *This\palette()\rc\right = LeftX + #OSq *This\palette()\rc\bottom = TopY + #OSq LeftX = LeftX + #OSq + #Separation EndIf NextElement(*This\palette()) Next column LeftX = #Edge TopY = TopY + #OSq + #Separation Next Row ResetList(*This\palette()) ; Reset the list named palette to access the first element. While NextElement(*This\palette()) And *This\palette()\color<>*This\CurrentColour ; Find the index of the current colour Found= *This\palette()\index Wend Found=Found+1 *This\CurrentIndex = Found ; store the index for the current colour DrawBorder(*This.Class_Palette, Found) PaletteWindowEvents(*This.Class_Palette) EndProcedure Procedure SaveUserColours(*This.Class_Palette) ;This procedure saves user defined colours to a file that can be specified by the user. ;It is more likely that the main program file will get the user defined colours using ;GetUserDefinedColours() and store the colours in a generic data file Protected Pattern$, Pattern, FileName$, hFile, j, Result Pattern$ = "All files (*.*)|*.*"
Pattern = 0
FileName$= SaveFileRequester("Please name the file to save", *This\PaleteFile, Pattern$, Pattern)
If FileName$hFile = CreateFile(#PB_Any, FileName$)

If hFile <> 0
For j=0 To 15
Result = WriteInteger(hFile, *This\ColourRef\RGB[j])
Next j
CloseFile(hFile)
Else
MessageRequester("Information", "File error", 0)
EndIf

Else
MessageRequester("Information", "The file was not saved", 0)
EndIf
EndProcedure

;This procedure loads user defined colours from a file that can be specified by the user.
;It is more likely that the main program file will get the user defined colours
;from a generic data file and put the colours in the palette using PutUserDefinedColours()
Protected Pattern$, Pattern, Filename$, hFile, j
Pattern$= "All files (*.*)|*.*" Pattern = 0 Filename$ = OpenFileRequester("Load file", *This\PaleteFile, Pattern$, Pattern) If FileName$
hFile= ReadFile(#PB_Any, Filename$) For j=0 To 15 *This\ColourRef\RGB[j]=ReadInteger(hFile) Next j *This\PaleteFile=Filename$
CloseFile(hFile)
Else
MessageRequester("Information", "The file was not loaded.", 0)
EndIf
EndProcedure

Procedure.i InitColourPalette(initColour = $0000FF) ;This method initialises an instance of the class ;It allocates memory for the object using the PB call AllocateStructure(), stores the addresses of ; the methods for the object in the virtual table and initialises values ;It returns the address of the object Protected *This.Class_Palette, i *This = AllocateStructure(Class_Palette) *This\VirtualTable = ?VTable_Class_Palette *This\CurrentColour = initColour *This\hTooltip = #Null ;Initialise the rcPrev structure to give a square of zero dimensions *This\rcPrev\right = 0 *This\rcPrev\left = 0 *This\rcPrev\top = 0 *This\rcPrev\bottom = 0 ;Read the numerical values of the colours from the data section into the object's list named palette() ;and store a zero-based index for each one Restore cols For i = 0 To (#Rows*#Columns)-1 AddElement(*This\palette()) Read *This\palette()\color *This\palette()\index = i Next i ;Read the names of each colour from the data section and store them in the object's list named palette() FirstElement(*This\palette()) Restore stringnames For i = 0 To (#Rows*#Columns)-1 Read.s *This\palette()\colName NextElement(*This\palette()) Next i ProcedureReturn *This EndProcedure DataSection ;{ ;VIRTUAL TABLE ;This data block contains the addresses of class functions that will be stored in the VirtualTable for the class VTable_Class_Palette: Data.i @PutUserDefinedColours() Data.i @GetUserDefinedColours() Data.i @PaletteWindowEvents() Data.i @BalloonInfo() Data.i @OriginalProcessButtonMsg() Data.i @MoreColoursClicked() Data.i @GetSelectedColour() Data.i @SquareClicked() Data.i @DrawBorder() Data.i @GetColouredSquare() Data.i @ShowPalette() Data.i @KillFocus() Data.i @MouseLeave() Data.i @SaveUserColours() Data.i @LoadUserColours() Data.i @Free() ;This is the data for the colours that are displayed in the colour palette with their names cols: Data.i$000000,$003399,$003333,$003300,$663300,$800000,$993333,$333333 Data.i$000080,$0066FF,$008080,$008000,$808000,$FF0000,$996666,$808080 Data.i$0000FF,$0099FF,$00CC99,$669933,$CCCC33,$FF6633,$800080,$999999 Data.i$FF00FF,$00CCFF,$00FFFF,$00FF00,$FFFF00,$FFCC00,$663399,$C0C0C0 Data.i$CC99FF,$99CCFF,$99FFFF,$CCFFCC,$FFFFCC,$FFCC99,$FF99CC,$FFFFFF stringnames: Data.s "Black","Brown","Dark Olive Green","Dark Green","Dark Teal","Dark blue","Indigo","Dark grey" Data.s "Dark red","Orange","Olive","Green","Teal","Blue","Blue-grey","Grey - 40" Data.s "Red","Light orange","Lime","Sea green","Aqua","Light blue","Violet","Grey - 50" Data.s "Pink","Gold","Yellow","Bright green","Turquoise","Skyblue","Plum","Light grey" Data.s "Rose","Tan","Light yellow","Pale green","Pale turquoise","Pale blue","Lavender","White" EndDataSection ;} EndModule How to use the module PaletteObj.pbi =============================================== Insert the following code in the module that will use the palette code: XIncludeFile "PaletteObj.pbi" UseModule JC_ModColourPalette Declare a global value for the object: Global ColourPalette1.JC_ClassColourPalette Set up an instance of the class for the palette object: ColourPalette1.JC_ModColourPalette::JC_ClassColourPalette = JC_ModColourPalette::Init(0) ;Create an instance for the class with initial colour Black (0) Initialise the object: Global ColourPalette1.JC_ClassColourPalette = InitColourPalette(0) ;Create an instance of the class with initial colour Black (0) The parameter passed to the object is the colour that is to be highlighted when the palette window opens. Alternatively the object can be initialised when it is declared: Global ColourPalette1.JC_ClassColourPalette = InitColourPalette(0) ;Create an instance of the class with initial colour Black (0) Each object stores the currently selected colour and any customised colours that you may have set up (discussed later). If you are writing an Editor then the palette instance that has been created may be for the font colour. You may need to set up another instance of the object for the background colour and call this ColourPalette2, eg: Global ColourPalette2.JC_ClassColourPalette = InitColourPalette() ;Create an instance of the class for the second object To show the first palette use: ColourPalette1\ShowPalette(610, 250) ;the parameters are the x and y (screen) coordinates for the top left corner of the colour palette. This will open a palette window and draw a black border around the currently selected colour. If none of the squares have this border then a custom colour is in use and this colour may be accessed by clicking the button marked More colours. While the palette window is open, window events are sent to the palette window; events will not be processed by the parent window. When the user clicks on a colour in the palette window the palette window closes and parent window will process any events that now occur. User defined colours are available from the main palette window by clicking the button marked More colours. This will open the Color common dialog box in Windows. The user may select one of the colours shown under Basic colours or click the button Define Custom Colours>> to define their own colour(s). Defined colours can be stored by clicking the button "Add to Custom Colours". When the user clicks the OK button the object stores the Custom colour so that it is available for selection later on. After closing the Palette window, the user may retrieve the selected colour number using the object's function GetSelectedColour(), eg: ColourPalette1\GetSelectedColour() The user defined colours may be copied into an array in the parent module from the object by calling the method GetUserDefinedColours(). This must include a parameter that is a 1-dimensional array of 16 elements. This enables the colours to be stored in a file using a procedure in the parent module. Example code that gets user defined colours into the array UserDefinedColours() Dim UserDefinedColours(16) ColourPalette1\GetUserDefinedColours(UserDefinedColours()) ;'1' indicates a 1-dimensional array For j = 0 To 15 Debug Str(j)+ " "+ Str(UserDefinedColours(j)) ;Shows the values of the stored colours Next j The object may be initialilsed with a set of user defined colours. The user defined colours must be stored in an array with 16 elements; this is the maximum number of custom colours that can be defined. For example: Dim UserDefinedColours(16) The default value of each colour in this array is 0 coresponding the colour black. Colours need not be put in this array in sequence eg you could put custom colours in the first and last element of the array. UserDefinedColours(0) = 255 UserDefinedColours(15) = RGB(0, 0, 255) To transfer the values in this array to the object use the method PutUserDefinedColours(): ColourPalette1\PutUserDefinedColours(UserDefinedColours()) When the palette Window is no longer required, the object must be freed using the Free() method: ColourPalette1\Free() The following program demonstrates the Ultimate Colour Requestor: Code: ; This module demonstrates my ultimate colour palette window object ; Copyright (C) 2020 John Crew ; Redistribution and use in source and binary forms, with or without modification, for commercial and non-commercial ; purposes are permitted provided that the following conditions are met: ; 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. ; 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following ; disclaimer in the documentation and/or other materials provided with the distribution. ; 3. Neither the name of the copyright holder nor contributors may be used to endorse or promote products derived ; from this software. ; 4. The source code, and any derived source code, must be made available to users of this software and any software ; derived from this source code. ; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS" AND ANY ; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF ; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL ; THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, ; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT ; OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) ; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR ; TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. EnableExplicit XIncludeFile "PaletteObj.pbi" UseModule JC_ModColourPalette Enumeration;{ #MainWindow=10 #Editor #Button1 #Button2 #Button3 EndEnumeration ;} Global j, Quit=#False Global colPalette1.JC_ClassColourPalette = InitColourPalette(0) ;Create an instance for the class with initial selected colour Black (0) Global colPalette2.JC_ClassColourPalette = InitColourPalette() ;Create another instance for the class with default colour selected Dim UserDefinedColours(16) ;This stores user defined colours OpenWindow(#MainWindow, 0, 0, 512, 470, "Colour palette demo", #PB_Window_ScreenCentered | #PB_Window_SystemMenu) EditorGadget(#Editor, 10, 10, 512-20, 384-30-22) ButtonGadget(#Button1, 10, 350, 100, 22, "Show palette 1") ButtonGadget(#Button2, 120, 350, 100, 22, "Show palette 2") ButtonGadget(#Button3, 230, 350, 260, 22, "Show user defined colour refs for Palette1") ;Set two user defined colours UserDefinedColours(0) = 255 ;Red UserDefinedColours(15) = RGB(0, 0, 255) ;Blue ;Put these user defined colours in colPalette1 colPalette1\PutUserDefinedColours(UserDefinedColours()) Repeat ;{ Select WaitWindowEvent() Case #PB_Event_CloseWindow If EventWindow() = #MainWindow Quit=#True EndIf Case #PB_Event_Gadget Select EventGadget() Case #Button1 colPalette1\ShowPalette(610, 250) ;Co-ords for the palette window are passed as arguments Debug "Curently selected colour reference for colPalette1 is: "+Str(colPalette1\GetSelectedColour()) Case #Button2 colPalette2\ShowPalette(610,250) Debug "Curently selected colour reference for colPalette2 is: "+Str(colPalette2\GetSelectedColour()) Case #Button3 Debug #CRLF$ +"User defined colour references for colPalette1 are:"+ #CRLF$colPalette1\GetUserDefinedColours(UserDefinedColours()) For j = 0 To 15 Debug Str(j)+ " "+ Str(UserDefinedColours(j)) Next j Debug #CRLF$ +"========================================"+ #CRLF\$
EndSelect

EndSelect
Until Quit=#True
colPalette1\Free()
colPalette2\Free();}

Last edited by XCoder on Sat Sep 26, 2020 11:13 am, edited 1 time in total.

Top

 Post subject: Re: Ultimate colour requestorPosted: Fri Sep 25, 2020 6:57 pm

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4741
Location: Lyon - France
Works apparently here, thanks for sharing

_________________
Not a destination

Top

 Post subject: Re: Ultimate colour requestorPosted: Fri Sep 25, 2020 8:39 pm
 User

Joined: Sun Oct 09, 2011 7:39 am
Posts: 22
when i press on "show palette 1" or "show palette 2"
I get an IMA in line 251
Code:
ProcedureReturn CallWindowProc_(*This\OriginalProcessButtonMsg(), hwnd, msg, wparam, lparam)

Top

 Post subject: Re: Ultimate colour requestorPosted: Sat Sep 26, 2020 11:14 am
 User

Joined: Tue Dec 31, 2013 9:18 pm
Posts: 21
I have updated the code in the first post of this thread to correct an error identified by Mr.L

Top

 Display posts from previous: All posts1 day7 days2 weeks1 month3 months6 months1 year Sort by AuthorPost timeSubject AscendingDescending
 Page 1 of 1 [ 4 posts ]

 All times are UTC + 1 hour

#### Who is online

Users browsing this forum: No registered users and 11 guests

 You cannot post new topics in this forumYou cannot reply to topics in this forumYou cannot edit your posts in this forumYou cannot delete your posts in this forum

Search for:
 Jump to:  Select a forum ------------------ PureBasic    Coding Questions    Game Programming    3D Programming    Assembly Programming    The PureBasic Editor    The PureBasic Form Designer    General Discussion    Feature Requests and Wishlists    Tricks 'n' Tips Bug Reports    Bugs - Windows    Bugs - Linux    Bugs - Mac OSX    Bugs - IDE    Bugs - Documentation OS Specific    AmigaOS    Linux    Windows    Mac OSX Miscellaneous    Announcement    Off Topic Showcase    Applications - Feedback and Discussion    PureFORM & JaPBe    TailBite