PureBasic Forums - English

Posted: **Mon Jul 17, 2006 12:45 am**

Code updated for 5.20+ (same as ColorRequester())

The following little library allows the developer to easily create a popup menu with a selection of colour cells to choose from. Such a menu can easily be attached to a drop down toolbar button etc. (like MS Word).

[ img]http://www.rodriguz.freeserve.co.uk/menucolour.jpg[/img]

Include file

Code: Select all

;Menu Colour picker . 
;Stephen Rodriguez 2006. 
;Purebasic 4 for Windows. 

;This small 'include' file allows the developer to show a pop-up menu which contains a selection 
;of 'standard colour' cells for the simple selection of colours. 
;Now includes the option of adding 12 custom colours by passing an optional address for the first
;element of the array of colours. 

;Such a menu can easily be attached to a drop down toolbar button. 


EnableExplicit 

Declare.l PopupColorMenu(hWnd, customarray=0, x=-1,y=-1) 
Declare.l MenuColour_MouseProc(nCode, wParam, lParam)  


;The following enumeration lists the two menu items which we use. 
;You must ensure that these do not clash with any in your program. 
Enumeration 
  #MCP_colours=100 
  #MCP_morecolours 
EndEnumeration 


;The following structure wraps up the global variables required and some used to 
;avoid repetetive calculations when drawing colour cells etc. 
Structure _MC 
  oldproc.l 
  menuhwnd.l 
  hook.l 
  selecteditem.l 
  blackpen.l 
  whitepen.l 
  menuwindowhwnd.l  
  customcolors.l ;Optional pointer to an array(11) of custom colours. 
  ;Used for calculations. 
  leftbase.l ;x-coord of left most colour cell. 
  topbase.l ;y-coord of left most colour cell. 
EndStructure 
Global _mcg._MC 

#MC_colorwidth=14 ;The width of each colour cell. 


;The following procedure takes responsibility for drawing the colour cells. 
Procedure MenuColour_CallbackProc(hWnd, uMsg, wParam, lParam) 
  Protected result, *lpmis.MEASUREITEMSTRUCT, *lpdis.DRAWITEMSTRUCT 
  Protected hdc, brush, oldbrush, borderpen, oldpen 
  Protected col, row, color 
  
  Select uMsg 
    Case #WM_COMMAND 
      ;Check if the user selected the 'More colours...' option. 
      If wParam>>16 & $ffff=0 And wParam&$ffff=#MCP_morecolours 
        _mcg\selecteditem=ColorRequester() 
      EndIf 
      
    Case #WM_MEASUREITEM ;This message is called when the menu / submenu is first created and is used to size the menu items. 
      *lpmis = lParam 
      If *lpmis\CtlType = #ODT_MENU   ;Don't want this to run for an owner drawn button etc! 
        Select *lpmis\itemid 
          Case #MCP_colours ;The item with the colours. 
            *lpmis\itemWidth = 120 ;Width of menu. 
            If _mcg\customcolors 
              *lpmis\itemHeight = 30+51*#MC_colorwidth/4 ;Height of menuitem with the colour cells. 
            Else 
              *lpmis\itemHeight = 30+6*#MC_colorwidth ;Height of menuitem with the colour cells. 
            EndIf 
          Case #MCP_morecolours 
            *lpmis\itemWidth = 120 ;Width of menu. 
            *lpmis\itemHeight = 25 ;Height of menuitem with the colour cells. 
        EndSelect 
        result = #True 
      EndIf 
      
    Case #WM_DRAWITEM  
      *lpdis = lParam 
      If *lpdis\CtlType = #ODT_MENU   ;Don't want this to run for an owner drawn button etc! 
        hdc = *lpdis\hDC 
        SetBkMode_(hdc,#TRANSPARENT) 
        Select *lpdis\itemid 
          Case #MCP_colours ;The item with the colours. 
            _mcg\leftbase = (*lpdis\rcItem\right-17*#MC_colorwidth/2)/2 
            _mcg\topbase = 30 
            *lpdis\rcItem\left+10 : *lpdis\rcItem\top+5 
            DrawText_(hdc, @"Standard colors:", 16, *lpdis\rcItem,#DT_SINGLELINE|#DT_LEFT|#DT_TOP) 
            *lpdis\rcItem\left-10 : *lpdis\rcItem\top-5 
            For row = 0 To 3 
              For col = 0 To 5 
                brush=CreateSolidBrush_(RGB(row/2*$ff,col*$33,$ff*row%2)) 
                oldbrush=SelectObject_(hdc,brush) 
                Rectangle_(hdc, _mcg\leftbase+col*3*#MC_colorwidth/2, _mcg\topbase+row*3*#MC_colorwidth/2, _mcg\leftbase+col*3*#MC_colorwidth/2+#MC_colorwidth-1,_mcg\topbase+row*3*#MC_colorwidth/2+#MC_colorwidth-1) 
                SelectObject_(hdc,oldbrush) 
                DeleteObject_(brush) 
              Next 
            Next 
            If _mcg\customcolors 
              *lpdis\rcItem\left+10 : *lpdis\rcItem\top=_mcg\topbase+27*#MC_colorwidth/4 
              MoveToEx_(hdc,_mcg\leftbase, *lpdis\rcItem\top,0) 
              LineTo_(hdc, _mcg\leftbase+17*#MC_colorwidth/2,*lpdis\rcItem\top) 
              *lpdis\rcItem\top=_mcg\topbase+15*#MC_colorwidth/2
              DrawText_(hdc, @"Custom colors:", 14, *lpdis\rcItem,#DT_SINGLELINE|#DT_LEFT|#DT_TOP) 
              For row = 6 To 7 
                For col = 0 To 5 
                  color=PeekL(_mcg\customcolors+SizeOf(long)*((row-6)*6+col)) 
                  If color = -1 : color = 0 : EndIf ;Show undefined colours in black. 
                  brush=CreateSolidBrush_(color) 
                  oldbrush=SelectObject_(hdc,brush) 
                  Rectangle_(hdc, _mcg\leftbase+col*3*#MC_colorwidth/2, _mcg\topbase+row*3*#MC_colorwidth/2, _mcg\leftbase+col*3*#MC_colorwidth/2+#MC_colorwidth-1,_mcg\topbase+row*3*#MC_colorwidth/2+#MC_colorwidth-1) 
                  SelectObject_(hdc,oldbrush) 
                  DeleteObject_(brush) 
                Next 
              Next 
            EndIf 
          Case #MCP_morecolours ;The 'more colours' item. 
            SetBkMode_(hdc,#TRANSPARENT) 
            If *lpdis\itemState & #ODS_SELECTED 
              borderpen=CreatePen_(#PS_SOLID, 1, 0) 
              oldpen=SelectObject_(hdc,borderpen) 
              Rectangle_(hdc, *lpdis\rcItem\left, *lpdis\rcItem\top, *lpdis\rcItem\right, *lpdis\rcItem\bottom) 
            Else 
              borderpen=GetStockObject_(#NULL_PEN) 
              oldpen=SelectObject_(hdc,borderpen) 
              Rectangle_(hdc, *lpdis\rcItem\left, *lpdis\rcItem\top, *lpdis\rcItem\right+1, *lpdis\rcItem\bottom+1) 
            EndIf 
            SelectObject_(hdc,oldpen) 
            DeleteObject_(borderpen) 
            *lpdis\rcItem\left+10 
            DrawText_(hdc, @"More colors...", 14, *lpdis\rcItem,#DT_SINGLELINE|#DT_LEFT|#DT_VCENTER) 
        EndSelect 
        result = #True 
      EndIf 
    Default 
      If _mcg\oldproc : ProcedureReturn CallWindowProc_(_mcg\oldproc, hWnd, uMsg, wParam, lParam) : EndIf 
  EndSelect      
  ProcedureReturn result 
EndProcedure 


;The following hook procedure follows the mouse whilst the MenuColour is visible, displaying selection 
;borders as appropriate. 
Procedure.l MenuColour_MouseProc(nCode, wParam, lParam)  
  Protected *mp.MOUSEHOOKSTRUCT, rc.RECT, leftdis, topdis, selecteditem, row, col 
  Protected hdc, i, j, oldpen, oldbrush, flag, color 
  If nCode >=0 And wParam = #WM_MOUSEMOVE 
    selecteditem=-1 
    *mp =lParam 
    GetMenuItemRect_(0,_mcg\menuhwnd,0,rc) ;Bounding rectangle of the menucolour item. 
    ;Calculations required for determining the coordinates of individual colour cells. 
    leftdis=(*mp\pt\x-_mcg\leftbase-rc\left) 
    topdis=(*mp\pt\y-_mcg\topbase-rc\top) 
    row=topdis/(3*#MC_colorwidth/2) : col = leftdis/(3*#MC_colorwidth/2) 
    ;Redraw the colour borders in the cases where the cursor is within the colour menu item or 
    ;there is an item left selected because of the speed of the cursor movement. 
    If PtInRect_(rc,*mp\pt\x | *mp\pt\y << 32) Or _mcg\selecteditem>-1 
      ;Determine if the cursor is over a colour item. 
      If leftdis%(3*#MC_colorwidth/2)<#MC_colorwidth And leftdis%(3*#MC_colorwidth/2)>=0 And topdis%(3*#MC_colorwidth/2)<#MC_colorwidth And topdis%(3*#MC_colorwidth/2)>=0 And row<8 And col <6 
        selecteditem= row*6 + col  
      EndIf 
      If Not(_mcg\menuwindowhwnd) 
        _mcg\menuwindowhwnd=WindowFromPoint_(*mp\pt\x | *mp\pt\y << 32) 
      EndIf 
      hdc=GetDC_(_mcg\menuwindowhwnd) 
      If hdc 
        oldbrush=SelectObject_(hdc,GetStockObject_(#NULL_BRUSH)) 
        oldpen=SelectObject_(hdc, _mcg\whitepen) 
        For i = 0 To 7 
          For j = 0 To 5 
            If selecteditem=i*6+j 
              If (i = 6 Or i = 7) And _mcg\customcolors ;Custom colors. 
                color=PeekL(_mcg\customcolors+SizeOf(long)*((i-6)*6+j)) 
                If color<> - 1 
                  _mcg\selecteditem=color 
                  Goto MCP_highlight 
                Else ;Draw a white border. 
                  Rectangle_(hdc, _mcg\leftbase+j*3*#MC_colorwidth/2-2, _mcg\topbase+i*3*#MC_colorwidth/2-2, _mcg\leftbase+j*3*#MC_colorwidth/2+#MC_colorwidth+2,_mcg\topbase+i*3*#MC_colorwidth/2+#MC_colorwidth+2) 
                EndIf 
              Else 
                _mcg\selecteditem=RGB(row/2*$ff,col*$33,$ff*row%2) 
MCP_highlight:
                flag=1 
                SelectObject_(hdc, _mcg\blackpen) 
                Rectangle_(hdc, _mcg\leftbase+j*3*#MC_colorwidth/2-2, _mcg\topbase+i*3*#MC_colorwidth/2-2, _mcg\leftbase+j*3*#MC_colorwidth/2+#MC_colorwidth+2,_mcg\topbase+i*3*#MC_colorwidth/2+#MC_colorwidth+2) 
                SelectObject_(hdc,_mcg\whitepen) 
              EndIf 
            Else ;Draw a white border. 
              Rectangle_(hdc, _mcg\leftbase+j*3*#MC_colorwidth/2-2, _mcg\topbase+i*3*#MC_colorwidth/2-2, _mcg\leftbase+j*3*#MC_colorwidth/2+#MC_colorwidth+2,_mcg\topbase+i*3*#MC_colorwidth/2+#MC_colorwidth+2) 
            EndIf 
          Next 
          If i = 3 : i = 5 : EndIf 
        Next 
        SelectObject_(hdc, oldpen) 
        SelectObject_(hdc, oldbrush) 
        ReleaseDC_(_mcg\menuwindowhwnd, hdc) 
        If Not(flag) 
          _mcg\selecteditem=-1 
        EndIf 
      EndIf 
    EndIf  
  EndIf 
  ProcedureReturn CallNextHookEx_(_mcg\hook, nCode, wParam, lParam) 
EndProcedure 


;Display the MenuColourPicker menu. 
;Returns the selected colour or -1. 
;Note that the optional 'customcolors' points to a colour array of 12 elements. 
;e.g. PopupColorMenu(WindowID(0), @colors(0)) 
;Dim this array by:  Dim colors(11). 
;Declare undefined colours with a value of -1. See the demo program for details. 
Procedure.l PopupColorMenu(hWnd, customcolors=0, x=-1,y=-1) 
  Protected menu, hInstance, lpdwProcessId 
  menu=CreatePopupMenu(#PB_Any) 
  ;Set globals. 
  _mcg\menuhwnd=MenuID(menu) 
  _mcg\blackpen=CreatePen_(#PS_SOLID, 2, 0) 
  _mcg\whitepen=CreatePen_(#PS_SOLID, 2, GetSysColor_(#COLOR_MENU)) 
  _mcg\selecteditem =-1 
  _mcg\menuwindowhwnd=0 
  _mcg\leftbase=-1 
  _mcg\topbase=-1 
  _mcg\customcolors=customcolors 
  MenuItem(#MCP_colours, "") 
  ModifyMenu_(_mcg\menuhwnd,#MCP_colours,#MF_BYCOMMAND|#MF_OWNERDRAW,#MCP_colours,_mcg\menuhwnd) 
  MenuBar() 
  MenuItem(#MCP_morecolours, "") 
  ModifyMenu_(_mcg\menuhwnd,#MCP_morecolours,#MF_BYCOMMAND|#MF_OWNERDRAW,#MCP_morecolours,_mcg\menuhwnd) 
  _mcg\oldproc=SetWindowLong_(hWnd, #GWL_WNDPROC, @MenuColour_CallbackProc()) 
  hInstance = GetModuleHandle_(0) 
  lpdwProcessId = GetWindowThreadProcessId_(hWnd, 0) 
  _mcg\hook= SetWindowsHookEx_(#WH_MOUSE, @MenuColour_MouseProc(), hInstance, lpdwProcessId) 
  If x=-1 Or y = -1 
    DisplayPopupMenu(menu, hWnd) 
  Else 
    DisplayPopupMenu(menu, hWnd,x,y) 
  EndIf 
  FreeMenu(menu) 
  DeleteObject_(_mcg\blackpen) 
  DeleteObject_(_mcg\whitepen) 
  UnhookWindowsHookEx_(_mcg\hook) 
  WindowEvent() ;Just in case the 'More colors...' option was clicked. 
  SetWindowLong_(hWnd, #GWL_WNDPROC, _mcg\oldproc) 
  ProcedureReturn _mcg\selecteditem 
EndProcedure

Example:

Code: Select all

XIncludeFile "MenuColourPicker.pbi" 

Define Quit, i

;Define a color array. This is optional and consists of 12 elements, not all of which have to be defined.
Dim colors(11)
;In this example we define 4 custom colors and mark the remaining 8 as undefined by setting them to -1. 
;(The user will not be able to select these undefined colours.)
colors(0)=#Green
colors(1)=#Blue
colors(2)=#Gray
colors(3)=#Red
For i = 4 To 11 : colors(i)=-1 : Next

If OpenWindow(0, 200, 200, 400, 400, "MenuColourPicker Example")
  Repeat
    Select WaitWindowEvent()     ; check for window events
      Case #WM_RBUTTONDOWN       ; right mouse button was clicked =>
        CompilerIf #PB_Compiler_Debugger = 1
          Debug "Selected colour = " + Str(PopupColorMenu(WindowID(0),@colors(0)))
        CompilerElse
          MessageRequester("Selected colour", Str(PopupColorMenu(WindowID(0),@colors(0))))
        CompilerEndIf 
        
      Case #PB_Event_CloseWindow
        Quit = 1
    EndSelect
  Until Quit = 1
EndIf

Tested on Win XP only.

Regards.

Posted: **Mon Jul 17, 2006 1:14 pm**

This is exactly what I needed for a window color routine in a program I'm finishing up now.

Very nice indeed!

Many thanks srod

cheers

Posted: **Mon Jul 17, 2006 1:41 pm**

i love it - so sweet.

Posted: **Mon Jul 17, 2006 2:46 pm**

You're welcome.

I needed something like this to pop down from a toolbar and, being unable to find an example, rolled the old sleeves up...

I won't be able to extend it tonight, but I'll have a look at adding custom colors etc. in a couple of days.

Posted: **Mon Jul 17, 2006 3:56 pm**

Nice, very nice! Propably it can help me in some other projects! Thank you.

Posted: **Wed Jul 19, 2006 10:23 pm**

**Update**
Have streamlined the code and added the option of including an array of up to 12 custom colours. (This array is optional.)

The screenshot shown in the first post shows 4 custom colours and the remaining 8 are undefined (the user is unable to select the undefined colours). If the array of custom colours is not included, then the entire section is removed.

The code is still not threadsafe as I presently see no need to make it so. Threadsafe will slow the code quite markedly in my opinion.

The updated code is part of the first post above.

Posted: **Thu Jul 20, 2006 8:08 am**

well done! verys nice piece of code.

Posted: **Sun Jul 23, 2006 2:45 pm**

i updated your so nice code in order to implement
a user-callback function for dynamic color retrieving.

sample code demonstrating the user-callback add-on :

Code: Select all

XIncludeFile "MenuColourPicker.pbi" 

Dim colors(11) 

colors(0) = #Green 
colors(1) = #Blue 
colors(2) = #Gray 
colors(3) = #Red 

For i = 4 To 11
  colors(i) = -1
Next

Procedure.l PopupColorMenuCallback(row.l, column.l, index.l, color.l)
  
  SetGadgetColor(0, #PB_Gadget_BackColor, color)
  SetGadgetColor(0, #PB_Gadget_FrontColor, #White)
  
  SetGadgetColor(1, #PB_Gadget_BackColor, #Gray)
  SetGadgetColor(1, #PB_Gadget_FrontColor, color)
  
  info.s
  info + "Row:    " + Str(row) + #lf$
  info + "Column: " + Str(column) + #lf$
  info + "Index:  " + Str(index) + #lf$
  info + "Color: $" + RSet(Hex(color), 6, "0")
  
  SetGadgetText(1, info)
  
  Debug ElapsedMilliseconds()
  
EndProcedure

color.l = 0

If OpenWindow(0, 200, 200, 400, 400, "MenuColourPicker Example") 
  If CreateGadgetList(WindowID(0))
    TextGadget(0, 5,  5, 390, 32, "MenuColourPicker Callback Example", #PB_Text_Center|#PB_Text_Border)
    TextGadget(1, 5, 55, 390,130, "Callback Values", #PB_Text_Center|#PB_Text_Border)
    If LoadFont(0, "Arial", 18, #PB_Font_Bold)
      SetGadgetFont(0, FontID(0))
      SetGadgetFont(1, FontID(0))
    EndIf
  EndIf
  Repeat 
    Select WaitWindowEvent()
      Case #WM_RBUTTONDOWN
        SetPopupColorMenuCallBack(@PopupColorMenuCallback())
        color = PopupColorMenu(WindowID(0), colors())
        SetWindowTitle(0, "Selected colour = $" + RSet(Hex(color),8,"0"))
      Case #PB_Event_CloseWindow 
        Break
    EndSelect 
  ForEver
EndIf

the modified include
look at ; ****** USER CALLBACK ******* to see the changes.

Code: Select all

;Menu Colour picker . 
;Stephen Rodriguez 2006. 
;Purebasic 4 for Windows. 

;This small 'include' file allows the developer to show a pop-up menu which contains a selection 
;of 'standard colour' cells for the simple selection of colours. 
;Now includes the option of adding 12 custom colours by passing an optional array of colours. 

;Such a menu can easily be attached to a drop down toolbar button. 


EnableExplicit 

Declare.l SetPopupColorMenuCallBack(hProc.l)
Declare.l PopupColorMenu(hwnd, customarray=0, x=-1,y=-1) 
Declare.l MenuColour_MouseProc(nCode, wParam, lParam)  


;The following enumeration lists the two menu items which we use. 
;You must ensure that these do not clash with any in your program. 
Enumeration 
  #MCP_colours=100 
  #MCP_morecolours 
EndEnumeration 


;The following structure wraps up the global variables required and some used to 
;avoid repetetive calculations when drawing colour cells etc. 
Structure _MC 
  oldproc.l 
  userProc.l ; ******* USER CALLBACK *******
  menuhwnd.l 
  hook.l 
  selecteditem.l 
  oldselecteditem.l ; ******* USER CALLBACK *******
  blackpen.l 
  whitepen.l 
  menuwindowhwnd.l  
  customcolors.l ;Optional pointer to an array(11) of custom colours. 
  ;Used for calculations. 
  leftbase.l ;x-coord of left most colour cell. 
  topbase.l ;y-coord of left most colour cell. 
EndStructure 
Global _mcg._MC 

#MC_colorwidth=14 ;The width of each colour cell. 

;******* USER CALLBACK ******* 
Procedure SetPopupColorMenuCallBack(hProc.l)
  _mcg\userProc = hProc
EndProcedure
; ******* USER CALLBACK *******

;The following procedure takes responsibility for drawing the colour cells. 
Procedure MenuColour_CallbackProc(hwnd, uMsg, wParam, lParam) 
  Protected result, *lpmis.MEASUREITEMSTRUCT, *lpdis.DRAWITEMSTRUCT 
  Protected hdc, brush, oldbrush, borderpen, oldpen 
  Protected Col, row, color 
  
  Select uMsg 
    Case #WM_COMMAND 
      ;Check if the user selected the 'More colours...' option. 
      If wParam>>16 & $FFFF=0 And wParam&$FFFF=#MCP_morecolours 
        _mcg\selecteditem=ColorRequester() 
      EndIf 
      
    Case #WM_MEASUREITEM ;This message is called when the menu / submenu is first created and is used to size the menu items. 
      *lpmis = lParam 
      If *lpmis\CtlType = #ODT_MENU   ;Don't want this to run for an owner drawn button etc! 
        Select *lpmis\itemID 
          Case #MCP_colours ;The item with the colours. 
            *lpmis\itemWidth = 120 ;Width of menu. 
            If _mcg\customcolors 
              *lpmis\itemHeight = 30+51*#MC_colorwidth/4 ;Height of menuitem with the colour cells. 
            Else 
              *lpmis\itemHeight = 30+6*#MC_colorwidth ;Height of menuitem with the colour cells. 
            EndIf 
          Case #MCP_morecolours 
            *lpmis\itemWidth = 120 ;Width of menu. 
            *lpmis\itemHeight = 25 ;Height of menuitem with the colour cells. 
        EndSelect 
        result = #True 
      EndIf 
      
    Case #WM_DRAWITEM  
      *lpdis = lParam 
      If *lpdis\CtlType = #ODT_MENU   ;Don't want this to run for an owner drawn button etc! 
        hdc = *lpdis\hdc 
        SetBkMode_(hdc,#TRANSPARENT) 
        Select *lpdis\itemID 
          Case #MCP_colours ;The item with the colours. 
            _mcg\leftbase = (*lpdis\rcItem\right-17*#MC_colorwidth/2)/2 
            _mcg\topbase = 30 
            *lpdis\rcItem\left+10 : *lpdis\rcItem\top+5 
            DrawText_(hdc, @"Standard colors:", 16, *lpdis\rcItem,#DT_SINGLELINE|#DT_LEFT|#DT_TOP) 
            *lpdis\rcItem\left-10 : *lpdis\rcItem\top-5 
            For row = 0 To 3 
              For Col = 0 To 5 
                brush=CreateSolidBrush_(RGB(row/2*$FF,Col*$33,$FF*row%2)) 
                oldbrush=SelectObject_(hdc,brush) 
                Rectangle_(hdc, _mcg\leftbase+Col*3*#MC_colorwidth/2, _mcg\topbase+row*3*#MC_colorwidth/2, _mcg\leftbase+Col*3*#MC_colorwidth/2+#MC_colorwidth-1,_mcg\topbase+row*3*#MC_colorwidth/2+#MC_colorwidth-1) 
                SelectObject_(hdc,oldbrush) 
                DeleteObject_(brush) 
              Next 
            Next 
            If _mcg\customcolors 
              *lpdis\rcItem\left+10 : *lpdis\rcItem\top=_mcg\topbase+27*#MC_colorwidth/4 
              MoveToEx_(hdc,_mcg\leftbase, *lpdis\rcItem\top,0) 
              LineTo_(hdc, _mcg\leftbase+17*#MC_colorwidth/2,*lpdis\rcItem\top) 
              *lpdis\rcItem\top=_mcg\topbase+15*#MC_colorwidth/2 
              DrawText_(hdc, @"Custom colors:", 14, *lpdis\rcItem,#DT_SINGLELINE|#DT_LEFT|#DT_TOP) 
              For row = 6 To 7 
                For Col = 0 To 5 
                  color=PeekL(_mcg\customcolors+SizeOf(Long)*((row-6)*6+Col)) 
                  If color = -1 : color = 0 : EndIf ;Show undefined colours in black. 
                  brush=CreateSolidBrush_(color) 
                  oldbrush=SelectObject_(hdc,brush) 
                  Rectangle_(hdc, _mcg\leftbase+Col*3*#MC_colorwidth/2, _mcg\topbase+row*3*#MC_colorwidth/2, _mcg\leftbase+Col*3*#MC_colorwidth/2+#MC_colorwidth-1,_mcg\topbase+row*3*#MC_colorwidth/2+#MC_colorwidth-1) 
                  SelectObject_(hdc,oldbrush) 
                  DeleteObject_(brush) 
                Next 
              Next 
            EndIf 
          Case #MCP_morecolours ;The 'more colours' item. 
            SetBkMode_(hdc,#TRANSPARENT) 
            If *lpdis\itemState & #ODS_SELECTED 
              borderpen=CreatePen_(#PS_SOLID, 1, 0) 
              oldpen=SelectObject_(hdc,borderpen) 
              Rectangle_(hdc, *lpdis\rcItem\left, *lpdis\rcItem\top, *lpdis\rcItem\right, *lpdis\rcItem\bottom) 
            Else 
              borderpen=GetStockObject_(#NULL_PEN) 
              oldpen=SelectObject_(hdc,borderpen) 
              Rectangle_(hdc, *lpdis\rcItem\left, *lpdis\rcItem\top, *lpdis\rcItem\right+1, *lpdis\rcItem\bottom+1) 
            EndIf 
            SelectObject_(hdc,oldpen) 
            DeleteObject_(borderpen) 
            *lpdis\rcItem\left+10 
            DrawText_(hdc, @"More colors...", 14, *lpdis\rcItem,#DT_SINGLELINE|#DT_LEFT|#DT_VCENTER) 
        EndSelect 
        result = #True 
      EndIf 
    Default 
      If _mcg\oldproc
        ProcedureReturn CallWindowProc_(_mcg\oldproc, hwnd, uMsg, wParam, lParam)
      EndIf
  EndSelect 
  ProcedureReturn result 
EndProcedure 


;The following hook procedure follows the mouse whilst the MenuColour is visible, displaying selection 
;borders as appropriate. 
Procedure.l MenuColour_MouseProc(nCode, wParam, lParam)  
  Protected *mp.MOUSEHOOKSTRUCT, rc.RECT, leftdis, topdis, selecteditem, row, Col 
  Protected hdc, i, j, oldpen, oldbrush, flag, color
  If nCode >=0 And wParam = #WM_MOUSEMOVE 
    selecteditem=-1 
    *mp =lParam 
    GetMenuItemRect_(0,_mcg\menuhwnd,0,rc) ;Bounding rectangle of the menucolour item. 
    ;Calculations required for determining the coordinates of individual colour cells. 
    leftdis=(*mp\pt\x-_mcg\leftbase-rc\left) 
    topdis=(*mp\pt\y-_mcg\topbase-rc\top) 
    row=topdis/(3*#MC_colorwidth/2) : Col = leftdis/(3*#MC_colorwidth/2) 
    ;Redraw the colour borders in the cases where the cursor is within the colour menu item or 
    ;there is an item left selected because of the speed of the cursor movement. 
    If PtInRect_(rc,*mp\pt\x,*mp\pt\y) Or _mcg\selecteditem>-1 
      ;Determine if the cursor is over a colour item. 
      If leftdis%(3*#MC_colorwidth/2)<MC_colorwidth>=0 And topdis%(3*#MC_colorwidth/2)<MC_colorwidth>=0 And row<8 And Col <6 
        selecteditem= row*6 + Col  
      EndIf 
      If Not(_mcg\menuwindowhwnd) 
        _mcg\menuwindowhwnd=WindowFromPoint_(*mp\pt\x,*mp\pt\y) 
      EndIf 
      hdc=GetDC_(_mcg\menuwindowhwnd) 
      If hdc 
        oldbrush=SelectObject_(hdc,GetStockObject_(#NULL_BRUSH)) 
        oldpen=SelectObject_(hdc, _mcg\whitepen) 
        For i = 0 To 7 
          For j = 0 To 5 
            If selecteditem=i*6+j 
              If (i = 6 Or i = 7) And _mcg\customcolors ;Custom colors. 
                color=PeekL(_mcg\customcolors+SizeOf(Long)*((i-6)*6+j)) 
                If color<> - 1 
                  _mcg\selecteditem=color 
                  Goto MCP_highlight 
                Else ;Draw a white border. 
                  Rectangle_(hdc, _mcg\leftbase+j*3*#MC_colorwidth/2-2, _mcg\topbase+i*3*#MC_colorwidth/2-2, _mcg\leftbase+j*3*#MC_colorwidth/2+#MC_colorwidth+2,_mcg\topbase+i*3*#MC_colorwidth/2+#MC_colorwidth+2) 
                EndIf 
              Else 
                _mcg\selecteditem=RGB(row/2*$FF,Col*$33,$FF*row%2) 
                MCP_highlight:  flag=1 
                ; ******* USER CALLBACK *******
                If _mcg\userProc
                  If _mcg\selecteditem <> _mcg\oldselecteditem
                    CallFunctionFast(_mcg\userProc, row+1, Col+1, selecteditem+1, _mcg\selecteditem)
                  EndIf
                  _mcg\oldselecteditem = _mcg\selecteditem
                EndIf
                ; ******* USER CALLBACK *******
                SelectObject_(hdc, _mcg\blackpen) 
                Rectangle_(hdc, _mcg\leftbase+j*3*#MC_colorwidth/2-2, _mcg\topbase+i*3*#MC_colorwidth/2-2, _mcg\leftbase+j*3*#MC_colorwidth/2+#MC_colorwidth+2,_mcg\topbase+i*3*#MC_colorwidth/2+#MC_colorwidth+2) 
                SelectObject_(hdc,_mcg\whitepen) 
              EndIf 
            Else ;Draw a white border. 
              Rectangle_(hdc, _mcg\leftbase+j*3*#MC_colorwidth/2-2, _mcg\topbase+i*3*#MC_colorwidth/2-2, _mcg\leftbase+j*3*#MC_colorwidth/2+#MC_colorwidth+2,_mcg\topbase+i*3*#MC_colorwidth/2+#MC_colorwidth+2) 
            EndIf 
          Next 
          If i = 3 : i = 5 : EndIf 
        Next 
        SelectObject_(hdc, oldpen) 
        SelectObject_(hdc, oldbrush) 
        ReleaseDC_(_mcg\menuwindowhwnd, hdc) 
        If Not(flag) 
          _mcg\selecteditem=-1 
        EndIf 
      EndIf 
    EndIf  
  EndIf 
  ProcedureReturn CallNextHookEx_(_mcg\hook, nCode, wParam, lParam) 
EndProcedure 


;Display the MenuColourPicker menu. 
;Returns the selected colour or -1. 
;Note that the optional 'customcolors' points to a colour array of 12 elements. 
;e.g. PopupColorMenu(WindowID(0), colors()) 
;Dim this array by:  Dim colors(11). 
;Declare undefined colours with a value of -1. See the demo program for details. 
Procedure.l PopupColorMenu(hwnd, customcolors=0, x=-1,y=-1) 
  Protected menu, hInstance, lpdwProcessId 
  menu=CreatePopupMenu(#PB_Any) 
  ;Set globals. 
  _mcg\menuhwnd=MenuID(menu) 
  _mcg\blackpen=CreatePen_(#PS_SOLID, 2, 0) 
  _mcg\whitepen=CreatePen_(#PS_SOLID, 2, GetSysColor_(#COLOR_MENU)) 
  _mcg\selecteditem =-1 
  _mcg\oldselecteditem = -1
  _mcg\menuwindowhwnd=0 
  _mcg\leftbase=-1 
  _mcg\topbase=-1 
  _mcg\customcolors=customcolors 
  MenuItem(#MCP_colours, "") 
  ModifyMenu_(_mcg\menuhwnd,#MCP_colours,#MF_BYCOMMAND|#MF_OWNERDRAW,#MCP_colours,_mcg\menuhwnd) 
  MenuBar() 
  MenuItem(#MCP_morecolours, "") 
  ModifyMenu_(_mcg\menuhwnd,#MCP_morecolours,#MF_BYCOMMAND|#MF_OWNERDRAW,#MCP_morecolours,_mcg\menuhwnd) 
  _mcg\oldproc=SetWindowLong_(hwnd, #GWL_WNDPROC, @MenuColour_CallbackProc()) 
  hInstance = GetModuleHandle_(0) 
  lpdwProcessId = GetWindowThreadProcessId_(hwnd, 0) 
  _mcg\hook= SetWindowsHookEx_(#WH_MOUSE, @MenuColour_MouseProc(), hInstance, lpdwProcessId) 
  If x=-1 Or y = -1 
    DisplayPopupMenu(menu, hwnd) 
  Else 
    DisplayPopupMenu(menu, hwnd,x,y) 
  EndIf 
  FreeMenu(menu) 
  DeleteObject_(_mcg\blackpen) 
  DeleteObject_(_mcg\whitepen) 
  UnhookWindowsHookEx_(_mcg\hook) 
  WindowEvent() ;Just in case the 'More colors...' option was clicked. 
  SetWindowLong_(hwnd, #GWL_WNDPROC, _mcg\oldproc) 
  ProcedureReturn _mcg\selecteditem 
EndProcedure

DisableExplicit

Posted: **Sun Jul 23, 2006 5:09 pm**

Wow!

Very nice!
Thx for sharing

Posted: **Mon Jul 24, 2006 7:28 am**

Hi,
shouldn't the SetPopupColorMenuCallBack(@PopupColorMenuCallback()) replaced by SetWindowCallback(@PopupColorMenuCallback()) ?

Posted: **Mon Jul 24, 2006 9:27 pm**

Flype, your code seems to have been mangled by the forums (not your fault) and so it will not run on my machine.

Any chance you can disable html in your profile and then upload the code again?

It's a nice idea you've got there - if only I could run it!

**EDIT: got it running after a bit of chopping and churning. Nice, that could be useful. Well done.

Michael Vogel: no, Flype has not enacted a proper Windows callback as such. He has modified the code so that it calls a procedure specified by the developer to inform the application which menu color the cursor is hovering over etc. For this you do not want to use SetWindowCallback().

Posted: **Tue Jul 25, 2006 7:32 am**

srod wrote:[1] Flype, your code [...] will not run on my machine. [...]
[2] Michael Vogel: no, Flype has not enacted a proper Windows callback[...]

I thought so (line 2) because the code didn't work on my machine either (line 1) - and the code (at least seems to) work when replacing the Callback as I wrote...

Michael

PureBasic Forums - English

Pop up menu colour selector (upgraded).

Pop up menu colour selector (upgraded).