[Windows] ColorPicker gadget

[pablov]

Number one


ColorOptionDlg.res

Code: Select all

; ColorPicker2
 ; Author Pablov 
 ; 01\05\2012 
 ; Win XP SP3; Win7 
 ; PB 4.3 - 4.6
Enumeration
  #Main
EndEnumeration
Enumeration
  #String_0 = 0
  #String_1 = 1
  #String_2 = 2
  #String_3 = 3
  #String_4 = 4
  #String_5 = 5
  #String_6 = 6
  #String_7 = 7
  #Button_4 = 8
EndEnumeration

;****************************************
 Import "ColorOptionDlg.res" : EndImport
;****************************************

#IDD_DLGOPTIONCOLOR = 3300                   ; Dialog
#IDC_LSTCOLOR       = 3301                   ; ListView
#IDOK               = 1                      ; Button ОК
#IDCANCEL           = 2                      ; Button Cancel

Global Dim color.l(11)
        Restore col 
        For i=1 To 11
           Read.l color(i)
        Next i

Procedure OpenWindow_Window_0()
  If OpenWindow(#Main, 450, 200, 250, 240, "Main", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar)
    StringGadget(#String_0, 10, 15, 230, 20, "")
    StringGadget(#String_1, 10, 40, 230, 20, "")
    StringGadget(#String_2, 10, 65, 230, 20, "")
    StringGadget(#String_3, 10, 90, 230, 20, "")
    StringGadget(#String_4, 10, 115, 230, 20, "")
    StringGadget(#String_5, 10, 140, 230, 20, "")
    StringGadget(#String_6, 10, 165, 230, 20, "")
    StringGadget(#String_7, 10, 190, 230, 20, "")
    ButtonGadget(#Button_4, 140, 215, 100, 20, "Color")
  EndIf
EndProcedure

Procedure DlgProc(hDlg, uMsg, wParam, lParam)
  hBr.l
  colorSB.l
   rect.RECT
   Dim   buffer.b(32)
   cc.CHOOSECOLOR
   cc\lStructSize = SizeOf(CHOOSECOLOR)
   color.l
   Dim nameColor$(11)
  Select uMsg
    Case #WM_INITDIALOG
       Restore stringnames
       For i=1 To 11
          Read$ nameColor$(i)
       Next i
       For i=1 To 11
           num = SendDlgItemMessage_(hDlg, #IDC_LSTCOLOR, #LB_ADDSTRING, 0, @nameColor$(i))
           SendDlgItemMessage_(hDlg, #IDC_LSTCOLOR, #LB_SETITEMDATA, num, color(i))
       Next i
    Case #WM_DRAWITEM 
       *drawitem.DRAWITEMSTRUCT = lParam 
       If   *drawitem\itemState <> #ODS_SELECTED
             cw  =   #COLOR_WINDOW
               cwt = #COLOR_WINDOWTEXT
          Else
             cw  =   #COLOR_HIGHLIGHT
               cwt = #COLOR_HIGHLIGHTTEXT
       EndIf   
       syscolor = GetSysColor_(cwt)
       SetTextColor_(*drawitem\hDC, syscolor)
       syscolor = GetSysColor_(cw)
       SetBkColor_(*drawitem\hDC, syscolor)
       ExtTextOut_(*drawitem\hDC, 0, 0, #ETO_OPAQUE, *drawitem\rcItem, #Null, 0, #Null)
            rect\left   = *drawitem\rcItem\left + 1
            rect\right  = *drawitem\rcItem\left + 1 + 25
            rect\top    = *drawitem\rcItem\top + 1
            rect\bottom = *drawitem\rcItem\bottom - 1
            colorSB     = *drawitem\itemData & $FFFFFF 
        hBr = CreateSolidBrush_(colorSB) 
        FillRect_(*drawitem\hdc, rect, hBr)
        DeleteObject_(hBr)
        gso = GetStockObject_(#BLACK_BRUSH)
        FrameRect_(*drawitem\hdc, rect, gso)   
        len = SendMessage_(*drawitem\hwndItem, #LB_GETTEXT,*drawitem\itemID, @buffer(0))    
         str$ =  PeekS(@buffer(0))   
         ots = *drawitem\rcItem\left + 30
         TextOut_(*drawitem\hdc,ots,*drawitem\rcItem\top, @str$,len)  
    Case #WM_CLOSE
       EndDialog_(hDlg, wParam & $FFFF)
    Case #WM_COMMAND
       IDEvent = wParam 
       IDEvent >> 16
       ID = wParam & $FFFF
       If IDEvent = #BN_CLICKED
          Select ID
            Case #IDOK
              For i = 1 To 8
                SetGadgetColor(i-1,  #PB_Gadget_BackColor, color(i))
              Next i
              SetWindowColor(#Main, color(9))
              EndDialog_(hDlg, wParam & $FFFF)
            Case #IDCANCEL
              EndDialog_(hDlg, wParam & $FFFF)
          EndSelect
       ElseIf IDEvent = #LBN_DBLCLK  
          n  = SendDlgItemMessage_(hDlg, #IDC_LSTCOLOR, #LB_GETCURSEL, 0, 0)
          cl = ColorRequester(SendDlgItemMessage_(hDlg, #IDC_LSTCOLOR, #LB_GETITEMDATA, n,0))
          If cl <> -1
             num = SendDlgItemMessage_(hDlg, #IDC_LSTCOLOR, #LB_GETCURSEL, 0, 0)
             color(num+1) = cl                         ; Записываем цвет в массив
             SendDlgItemMessage_(hDlg, #IDC_LSTCOLOR, #LB_SETITEMDATA, num, cl)
             InvalidateRect_(GetDlgItem_(hDlg, #IDC_LSTCOLOR), #Null, #False)
          EndIf
       EndIf
  EndSelect
EndProcedure

Procedure GetResDialog(DialogId, *DialogProcedure)
  ProcedureReturn DialogBoxParam_(GetModuleHandle_(0), DialogId, WindowID(#Main), *DialogProcedure, 0)
EndProcedure

OpenWindow_Window_0()

Repeat
  Event = WaitWindowEvent()
  Select Event
    Case #PB_Event_Gadget
      EventGadget = EventGadget()
      EventType = EventType()
      If EventGadget = #String_0
      ElseIf EventGadget = #String_1
      ElseIf EventGadget = #String_2
      ElseIf EventGadget = #String_3
      ElseIf EventGadget = #Button_4
        GetResDialog(#IDD_DLGOPTIONCOLOR, @DlgProc()) 
      EndIf
    Case #PB_Event_CloseWindow
      EventWindow = EventWindow()
      If EventWindow = #Main
        CloseWindow(#Main)
        Break
      EndIf
  EndSelect
ForEver
DataSection 
  stringnames:
  Data.s "Selection bar", "Address text", "Data text"
  Data.s "Number & text", "Selected focus back", "Selected lost focus back"
  Data.s "Selected number", "Selected ascii text", "Back"
  Data.s "Selection bar pen", "Line numbers"
  col:
  Data.l $ACFBB0, $EEC8D3, $87BECB, $00008000, $00FF0000, $000000FF, $A5BEFC, $00C0C0C0, $00C0F0F0, $00808080, $00800000 
EndDataSection

;************************************************************************************************************************************************
;************************************************************************************************************************************************
Number two and three




ColorPicker.res

Code: Select all

 ; ColorPicker
 ; Author Pablov 
 ; 02\05\2012 
 ; Win XP SP3; Win7 
 ; PB 4.3 - 4.6
 Enumeration 
   #Window_0 
 EndEnumeration 
 Enumeration 
   #Menu_Window_0 
 EndEnumeration 
 Enumeration 
   #MenuExit 
   #MenuForegroundColor 
   #MenuBackgroundColor 
   #MenuAbout 
   #txt 
 EndEnumeration 
 ;****************************************
   Import "ColorPicker.res" : EndImport 
 ;****************************************
 #IDD_DLGBackground    = 129 
 #IDD_DLGForeground    = 130 
 #IDC_FOREGROUND       = 1000          
 #IDC_BACKGROUND       = 1001 
 #IDOK_FOREGROUND      = 3 
 #IDCANCEL_FOREGROUND  = 4 
 #IDOK_BACKGROUND      = 1 
 #IDCANCEL_BACKGROUND  = 2 

 ; Foreground And background colors 
 Global g_fgColor = $C0C0C0 
 Global g_bgColor = $C08000 
 ; In array load collection a colour 48 pieces 
 Global Dim g_crItems.l(47) 
         Restore col 
         For i=0 To 47 
            Read.l g_crItems(i) 
         Next i 
 ;** Callback function of "Foreground color" dialog box.        
 Procedure DlgForeground(hdlg.l, message.l, wParam.l, lparam.l)        
         
   Select message 
       Case #WM_INITDIALOG 
           nColor.l 
           For nColor = 0 To 47        
               num = SendDlgItemMessage_(hDlg, #IDC_FOREGROUND, #CB_ADDSTRING, 0, g_crItems(nColor)) 
               If g_fgColor = g_crItems(nColor)                       ; Set position ComboBox 
                 SendDlgItemMessage_(hdlg, #IDC_FOREGROUND, #CB_SETCURSEL, nColor, 0) 
               EndIf  
           Next nColor 
       Case #WM_MEASUREITEM 
           *lpmis.MEASUREITEMSTRUCT 
           *lpmis = lparam 
           *lpmis\itemWidth  = 10 
           *lpmis\itemHeight = 18 
       Case #WM_DRAWITEM 
           hdc.l 
           rc.RECT 
           cr.l 
           hbrush.l : hbrHighlight.l : hbrBackground.l 
           *pdis.DRAWITEMSTRUCT 
           *pdis = lparam 
           hdc = *pdis\hDC 
             rc = *pdis\rcItem 
             If *pdis\itemID = -1 : ProcedureReturn 0 : EndIf 
             hbrHighlight = CreateSolidBrush_($FFFFFF - g_bgColor) 
             hbrBackground = CreateSolidBrush_($C0C0C0)            
             Select *pdis\itemAction 
                Case #ODA_DRAWENTIRE  
                  Select *pdis\CtlID 
                    Case #IDC_FOREGROUND 
                      rc = *pdis\rcItem 
                      cr = *pdis\itemData 
                      FillRect_(hdc, rc, hbrBackground) 
                      InflateRect_(rc, -1, -1) 
                      hbrush = CreateSolidBrush_(cr) 
                      FillRect_(hdc, rc, hbrush) 
                      DeleteObject_(hbrush) 
                      FrameRect_(hdc, rc, GetStockObject_(#WHITE_BRUSH)) 
                      i = SendDlgItemMessage_(hdlg, #IDC_FOREGROUND, #CB_GETCURSEL, 0, 0) 
                      temp_fgColor = SendDlgItemMessage_(hdlg, #IDC_FOREGROUND, #CB_GETITEMDATA, i, 0) 
                      dc = GetDC_(hdlg)
                      hbrush    = CreateSolidBrush_(temp_fgColor) 
                      hbrushOld = SelectObject_(dc, hbrush) 
                      Rectangle_(dc, 200, 70, 265, 130)
                      SelectObject_(dc, hbrushOld)
                      DeleteObject_(hbrush)
                  EndSelect 
                Case #ODA_SELECT  
                  rc = *pdis\rcItem 
                If *pdis\itemState & #ODS_SELECTED 
                           hbrush = hbrHighlight 
                   Else 
                           hbrush = hbrBackground                  
                  EndIf 
                  FrameRect_(hdc, @rc, hbrush) 
                Case #ODA_FOCUS  
             EndSelect  
             DeleteObject_(hbrHighlight) 
             DeleteObject_(hbrBackground) 
        Case #WM_CLOSE 
           EndDialog_(hDlg, wParam & $FFFF) 
        Case #WM_PAINT
             i = SendDlgItemMessage_(hdlg, #IDC_FOREGROUND, #CB_GETCURSEL, 0, 0) 
             temp_fgColor = SendDlgItemMessage_(hdlg, #IDC_FOREGROUND, #CB_GETITEMDATA, i, 0) 
             dc = GetDC_(hdlg)
             hbrush    = CreateSolidBrush_(temp_fgColor) 
             hbrushOld = SelectObject_(dc, hbrush) 
             Rectangle_(dc, 200, 70, 265, 130)
             SelectObject_(dc, hbrushOld)
             DeleteObject_(hbrush)
        Case #WM_COMMAND 
           IDEvent = wParam 
           IDEvent >> 16 
           ID = wParam & $FFFF 
           If IDEvent = #BN_CLICKED 
             Select ID                                          
               Case  #IDOK_FOREGROUND                      ; Кнопка ОК 
                      i = SendDlgItemMessage_(hdlg, #IDC_FOREGROUND, #CB_GETCURSEL, 0, 0) 
                      g_fgColor = SendDlgItemMessage_(hdlg, #IDC_FOREGROUND, #CB_GETITEMDATA, i, 0) 
                      EndDialog_(hdlg, wParam & $FFFF) 
                      InvalidateRect_(GetParent_(hdlg), #Null, #True) 
                      SetGadgetColor(#txt, #PB_Gadget_FrontColor, g_fgColor) 
                   SetGadgetColor(#txt, #PB_Gadget_BackColor, g_bgColor) 
               Case #IDCANCEL_FOREGROUND                   ; Кнопка CANCEL 
                  EndDialog_(hdlg, wParam & $FFFF) 
                EndSelect 
              EndIf    
   EndSelect    
         
 EndProcedure    
 ;** Callback function of "Background color" dialog box. 
 Procedure DlgBackground(hdlg.l, message.l, wParam.l, lparam.l)        
   
   Select message 
       Case #WM_INITDIALOG 
             nColor.l 
           For nColor = 0 To 47        
                SendDlgItemMessage_(hdlg, #IDC_BACKGROUND, #LB_ADDSTRING, nColor, "") 
                SendDlgItemMessage_(hdlg, #IDC_BACKGROUND, #LB_SETITEMDATA , nColor, g_crItems(nColor)) 
                If g_bgColor = g_crItems(nColor) 
                  SendDlgItemMessage_(hdlg, #IDC_BACKGROUND, #LB_SETCURSEL, nColor, 0) 
                EndIf 
             Next nColor    
        Case #WM_MEASUREITEM 
             rc.RECT 
             *lpmis.MEASUREITEMSTRUCT 
             *lpmis = lparam 
             GetWindowRect_(GetDlgItem_(hdlg, *lpmis\CtlID), rc) 
             *lpmis\itemHeight = (rc\bottom - rc\top) / 6 
             *lpmis\itemWidth  = (rc\right - rc\left) / 8             
        Case #WM_CTLCOLORLISTBOX 
             CreateSolidBrush_(GetSysColor_(#COLOR_3DFACE))          
       Case #WM_DRAWITEM 
             hdc.l : cr.l : hbrush.l 
             *pdis.DRAWITEMSTRUCT          
             *pdis = lparam 
             hdc = *pdis\hDC; 
             rc = *pdis\rcItem; 
             ; Transparent. 
             SetBkMode_(hdc,#TRANSPARENT);            
             ; NULL object ?
             If *pdis\itemID = -1 : ProcedureReturn 0 : EndIf 
             Select *pdis\itemAction            
                Case #ODA_DRAWENTIRE            
                     If *pdis\CtlID = #IDC_BACKGROUND    
                          rc = *pdis\rcItem 
                          cr = *pdis\itemData 
                          InflateRect_(rc, -3, -3) 
                          hbrush = CreateSolidBrush_(cr) 
                          FillRect_(hdc, rc, hbrush) 
                          DeleteObject_(hbrush) 
                          FrameRect_(hdc, rc, GetStockObject_(#GRAY_BRUSH))    
                     EndIf      
                   ; *** FALL THROUGH *** 
                Case #ODA_SELECT                  
                     rc = *pdis\rcItem; 
                     If *pdis\itemState & #ODS_SELECTED                  
                          rc\bottom - 2 
                          rc\right - 2 
                          ; Draw the lighted side. 
                          hpen.l    = CreatePen_(#PS_SOLID, 1, GetSysColor_(#COLOR_BTNSHADOW)) 
                          holdPen.l = SelectObject_(hdc, hpen) 
                          MoveToEx_(hdc, rc\left, rc\bottom, #Null) 
                          LineTo_(hdc, rc\left, rc\top) 
                          LineTo_(hdc, rc\right, rc\top) 
                          SelectObject_(hdc, holdPen) 
                          DeleteObject_(hpen); 
                          ; Draw the darkened side. 
                          hpen = CreatePen_(#PS_SOLID, 1, GetSysColor_(#COLOR_BTNHIGHLIGHT)) 
                          holdPen = SelectObject_(hdc, hpen) 
                          LineTo_(hdc, rc\right, rc\bottom) 
                          LineTo_(hdc, rc\left, rc\bottom) 
                          SelectObject_(hdc, holdPen) 
                          DeleteObject_(hpen)
                          nItem   = SendDlgItemMessage_(hdlg, #IDC_BACKGROUND, #LB_GETCURSEL, 0, 0) 
                          temp_bgColor = SendDlgItemMessage_(hdlg, #IDC_BACKGROUND, #LB_GETITEMDATA, nItem, 0) 
                          dc = GetDC_(hdlg)
                          hbrush    = CreateSolidBrush_(temp_bgColor) 
                          hbrushOld = SelectObject_(dc, hbrush) 
                          Rectangle_(dc, 200, 68, 270, 130)
                          SelectObject_(dc, hbrushOld)
                          DeleteObject_(hbrush)
                    Else 
                          hbrush = CreateSolidBrush_(GetSysColor_(#COLOR_3DFACE)) 
                          FrameRect_(hdc, rc, hbrush) 
                          DeleteObject_(hbrush) 
                        EndIf 
                Case #ODA_FOCUS 
                     rc = *pdis\rcItem; 
                     InflateRect_(rc, -2, -2) 
                     DrawFocusRect_(hdc, rc) 
             EndSelect 
          Case #WM_PAINT
             nItem   = SendDlgItemMessage_(hdlg, #IDC_BACKGROUND, #LB_GETCURSEL, 0, 0) 
             temp_bgColor = SendDlgItemMessage_(hdlg, #IDC_BACKGROUND, #LB_GETITEMDATA, nItem, 0) 
             dc = GetDC_(hdlg)
             hbrush    = CreateSolidBrush_(temp_bgColor) 
             hbrushOld = SelectObject_(dc, hbrush) 
             Rectangle_(dc, 200, 68, 270, 130)
             SelectObject_(dc, hbrushOld)
             DeleteObject_(hbrush)
          Case #WM_COMMAND 
             IDEvent = wParam 
             IDEvent >> 16 
             ID = wParam & $FFFF 
             If IDEvent = #BN_CLICKED 
               Select ID                                          
                 Case  #IDOK_BACKGROUND                       ; Button ОК 
                    nItem = SendDlgItemMessage_(hdlg, #IDC_BACKGROUND, #LB_GETCURSEL, 0, 0) 
                    g_bgColor = SendDlgItemMessage_(hdlg, #IDC_BACKGROUND, #LB_GETITEMDATA, nItem, 0) 
                    EndDialog_(hdlg, wParam & $FFFF) 
                    InvalidateRect_(GetParent_(hdlg), #Null, #True)  
                    SetWindowColor(#Window_0, g_bgColor) 
                    SetGadgetColor(#txt, #PB_Gadget_BackColor, g_bgColor) 
                 Case  #IDCANCEL_BACKGROUND                   ; Button CANCEL 
                    EndDialog_(hdlg, wParam & $FFFF) 
                EndSelect 
              EndIf 
          Case #WM_CLOSE 
             EndDialog_(hDlg, wParam & $FFFF) 
   EndSelect  
 EndProcedure 

 Procedure OpenWindow_Window_0() 
   If OpenWindow(#Window_0, 467, 184, 510, 321, "Main", #PB_Window_SystemMenu|#PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_TitleBar) 
     SetWindowColor(#Window_0, g_bgColor) 
     TextGadget(#txt, 140, 100, 300, 50, "Hello World!") : HideGadget(#txt, 1) 
     SetGadgetFont(#txt, LoadFont(0, "Arial", 32, #PB_Font_Bold)) 
     SetGadgetColor(#txt, #PB_Gadget_FrontColor, g_fgColor) 
     SetGadgetColor(#txt, #PB_Gadget_BackColor, g_bgColor) 
     HideGadget(#txt, 0) 
     If CreateMenu(#Menu_Window_0, WindowID(#Window_0)) 
       MenuTitle("File") 
       MenuItem(#MenuExit, "Exit") 
       MenuTitle("Color") 
       MenuItem(#MenuForegroundColor, "Foreground Color") 
       MenuItem(#MenuBackgroundColor, "Background Color") 
       MenuTitle("Help") 
       MenuItem(#MenuAbout, "About") 
     EndIf 
   EndIf 
 EndProcedure 

 Procedure GetResDialog(DialogId, *DialogProcedure) 
   ProcedureReturn DialogBoxParam_(GetModuleHandle_(0), DialogId, WindowID(#Window_0), *DialogProcedure, 0) 
 EndProcedure 

 OpenWindow_Window_0() 

 Repeat 
   Event = WaitWindowEvent() 
   Select Event 
     Case #PB_Event_Gadget 
       EventGadget = EventGadget() 
       EventType = EventType() 
     Case #PB_Event_Menu 
       EventMenu = EventMenu() 
       If EventMenu = #MenuExit 
         CloseWindow(#Window_0) 
         Break 
       ElseIf EventMenu = #MenuForegroundColor 
            GetResDialog(#IDD_DLGForeground, @DlgForeground()) 
          ElseIf EventMenu = #MenuBackgroundColor 
            GetResDialog(#IDD_DLGBackground, @DlgBackground()) 
       ElseIf EventMenu = #MenuAbout 
         MessageRequester("About", "   Created by Pablov              " +  Chr(10) + "  Copyright © 2012", #MB_OK|#MB_ICONINFORMATION)    
       EndIf 
     Case #PB_Event_CloseWindow 
       EventWindow = EventWindow() 
       If EventWindow = #Window_0 
         CloseWindow(#Window_0) 
         Break 
       EndIf 
   EndSelect 
 ForEver 
 DataSection 
   col:    ; Colour collection
   Data.l $000000, $000040, $000080, $404080, $80FFFF, $00FFFF, $4080FF, $0080FF 
   Data.l $004080, $008080, $408080, $004000, $008000, $00FF00, $00FF80, $80FF80 
   Data.l $80FF00, $40FF00, $808000, $408000, $404000, $808080, $808040, $800000 
   Data.l $FF0000, $804000, $FFFF00, $FFFF80, $FF8000, $C08000, $FF8080, $A00000 
   Data.l $400000, $C0C0C0, $400040, $600040, $800080, $400080, $C08080, $C080FF 
   Data.l $FF80FF, $FF00FF, $8000FF, $FF0080, $800040, $70E88F, $74BEDF, $BDF6BD 
 EndDataSection

[IdeasVacuum]

Colourful apps!

[electrochrisso]

Nice one,
Thanks

[Kwai chang caine]

Cool and usefull
Thanks

[electrochrisso]

I get Invalid Memory Access Error 16733525 at line 132 with ColorPicker2, when double click in the colour list.
Win 7 Starter.
Otherwise works good.

[pablov]

2electrochrisso
Sorry, I have't tested for win7
try it

Code: Select all

Enumeration
  #Main
EndEnumeration
Enumeration
  #String_0 = 0
  #String_1 = 1
  #String_2 = 2
  #String_3 = 3
  #String_4 = 4
  #String_5 = 5
  #String_6 = 6
  #String_7 = 7
  #Button_4 = 8
EndEnumeration

;****************************************
 Import "ColorOptionDlg.res" : EndImport
;****************************************

#IDD_DLGOPTIONCOLOR = 3300                   ; Dialog
#IDC_LSTCOLOR       = 3301                   ; ListView
#IDOK               = 1                      ; Button ОК
#IDCANCEL           = 2                      ; Button Cancel

Global Dim color.l(11)
        Restore col 
        For i=1 To 11
           Read.l color(i)
        Next i

Procedure OpenWindow_Window_0()
  If OpenWindow(#Main, 450, 200, 250, 240, "Main", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar)
    StringGadget(#String_0, 10, 15, 230, 20, "")
    StringGadget(#String_1, 10, 40, 230, 20, "")
    StringGadget(#String_2, 10, 65, 230, 20, "")
    StringGadget(#String_3, 10, 90, 230, 20, "")
    StringGadget(#String_4, 10, 115, 230, 20, "")
    StringGadget(#String_5, 10, 140, 230, 20, "")
    StringGadget(#String_6, 10, 165, 230, 20, "")
    StringGadget(#String_7, 10, 190, 230, 20, "")
    ButtonGadget(#Button_4, 140, 215, 100, 20, "Color")
  EndIf
EndProcedure

Procedure DlgProc(hDlg, uMsg, wParam, lParam)
  hBr.l
  colorSB.l
	rect.RECT
	Dim	buffer.b(32)
	cc.CHOOSECOLOR
	cc\lStructSize = SizeOf(CHOOSECOLOR)
	color.l
	Dim nameColor$(11)
  Select uMsg
    Case #WM_INITDIALOG
       Restore stringnames
       For i=1 To 11
          Read$ nameColor$(i)
       Next i
       For i=1 To 11
           num = SendDlgItemMessage_(hDlg, #IDC_LSTCOLOR, #LB_ADDSTRING, 0, @nameColor$(i))
           SendDlgItemMessage_(hDlg, #IDC_LSTCOLOR, #LB_SETITEMDATA, num, color(i))
       Next i
    Case #WM_DRAWITEM 
       *drawitem.DRAWITEMSTRUCT = lParam 
       If	*drawitem\itemState <> #ODS_SELECTED
          	cw  =	#COLOR_WINDOW
			      cwt = #COLOR_WINDOWTEXT
			 Else
          	cw  =	#COLOR_HIGHLIGHT
			      cwt = #COLOR_HIGHLIGHTTEXT
       EndIf   
       syscolor = GetSysColor_(cwt)
       SetTextColor_(*drawitem\hDC, syscolor)
       syscolor = GetSysColor_(cw)
       SetBkColor_(*drawitem\hDC, syscolor)
       ExtTextOut_(*drawitem\hDC, 0, 0, #ETO_OPAQUE, *drawitem\rcItem, #Null, 0, #Null)
	      	rect\left   = *drawitem\rcItem\left + 1
	      	rect\right  = *drawitem\rcItem\left + 1 + 25
	      	rect\top    = *drawitem\rcItem\top + 1
	      	rect\bottom = *drawitem\rcItem\bottom - 1
	      	colorSB     = *drawitem\itemData & $FFFFFF 
	     hBr = CreateSolidBrush_(colorSB) 
	     FillRect_(*drawitem\hdc, rect, hBr)
	     DeleteObject_(hBr)
	     gso = GetStockObject_(#BLACK_BRUSH)
	     FrameRect_(*drawitem\hdc, rect, gso)	
	     len = SendMessage_(*drawitem\hwndItem, #LB_GETTEXT,*drawitem\itemID, @buffer(0)) 	
	      str$ =  PeekS(@buffer(0))	
		   ots = *drawitem\rcItem\left + 30
		   TextOut_(*drawitem\hdc,ots,*drawitem\rcItem\top, @str$,len)  
    Case #WM_CLOSE
       EndDialog_(hDlg, wParam & $FFFF)
    Case #WM_COMMAND
       IDEvent = wParam 
       IDEvent >> 16
       ID = wParam & $FFFF
       If IDEvent = #BN_CLICKED
          Select ID
            Case #IDOK
              For i = 1 To 8
                SetGadgetColor(i-1,  #PB_Gadget_BackColor, color(i))
              Next i
              SetWindowColor(#Main, color(9))
              EndDialog_(hDlg, wParam & $FFFF)
            Case #IDCANCEL
              EndDialog_(hDlg, wParam & $FFFF)
          EndSelect
       ElseIf IDEvent = #LBN_DBLCLK  
          n  = SendDlgItemMessage_(hDlg, #IDC_LSTCOLOR, #LB_GETCURSEL, 0, 0)
          cl = ColorRequester(SendDlgItemMessage_(hDlg, #IDC_LSTCOLOR, #LB_GETITEMDATA, n,0))
          If cl <> -1
             num = SendDlgItemMessage_(hDlg, #IDC_LSTCOLOR, #LB_GETCURSEL, 0, 0)
             color(num+1) = cl                         ; Записываем цвет в массив
             SendDlgItemMessage_(hDlg, #IDC_LSTCOLOR, #LB_SETITEMDATA, num, cl)
             InvalidateRect_(GetDlgItem_(hDlg, #IDC_LSTCOLOR), #Null, #False)
          EndIf
       EndIf
  EndSelect
EndProcedure

Procedure GetResDialog(DialogId, *DialogProcedure)
  ProcedureReturn DialogBoxParam_(GetModuleHandle_(0), DialogId, WindowID(#Main), *DialogProcedure, 0)
EndProcedure

OpenWindow_Window_0()

Repeat
  Event = WaitWindowEvent()
  Select Event
    Case #PB_Event_Gadget
      EventGadget = EventGadget()
      EventType = EventType()
      If EventGadget = #String_0
      ElseIf EventGadget = #String_1
      ElseIf EventGadget = #String_2
      ElseIf EventGadget = #String_3
      ElseIf EventGadget = #Button_4
        GetResDialog(#IDD_DLGOPTIONCOLOR, @DlgProc()) 
      EndIf
    Case #PB_Event_CloseWindow
      EventWindow = EventWindow()
      If EventWindow = #Main
        CloseWindow(#Main)
        Break
      EndIf
  EndSelect
ForEver
DataSection 
  stringnames:
  Data.s "Selection bar", "Address text", "Data text"
  Data.s "Number & text", "Selected focus back", "Selected lost focus back"
  Data.s "Selected number", "Selected ascii text", "Back"
  Data.s "Selection bar pen", "Line numbers"
  col:
  Data.l $ACFBB0, $EEC8D3, $87BECB, $00008000, $00FF0000, $000000FF, $A5BEFC, $00C0C0C0, $00C0F0F0, $00808080, $00800000 
EndDataSection

[electrochrisso]

Fixed, Tks.
No need for apologies.

[pablov]

Office XP style Colour Picker control

Code: Select all

; Office XP style Colour Picker control by Pablov
; Win XP SP3; Win7 
; PureBasic ver. => 4.6

Enumeration
  #Window_0
  #Window_1
EndEnumeration
Enumeration
  #rgb
  #text
  #ComboBox_1
EndEnumeration

Structure PALETTE
  index.w
  color.i
  hint.s
  rt.RECT
EndStructure  

Declare OpenWindow_Window_1()

Global NewList col.PALETTE()
Global sel_Color.i = $00CC99 
Global hBrush.i 
Global Callback.i

Restore col
For i = 1 To 40
   AddElement(col()) 
   Read.i col()\color
Next i
 
FirstElement(col()) 
Restore stringnames
For i = 1 To 40
   Read.s col()\hint
   NextElement(col())
Next i

Procedure IsMouseOver(wnd) 
 GetWindowRect_(wnd,re.RECT) 
 GetCursorPos_(pt.POINT) 
 Result.i = PtInRect_(@re, pt\x | (pt\y<<32) )
ProcedureReturn Result 
EndProcedure 

Procedure MainCallback( hwnd.i, msg.i, wparam.i, lparam.i ) 
  Protected result ; 
  result = #PB_ProcessPureBasicEvents
  If msg = #WM_CTLCOLOREDIT And lparam = GadgetID(#ComboBox_1)
      lb.LOGBRUSH
      lb\lbColor = sel_Color 
      lb\lbStyle = #BS_SOLID
      result = CreateBrushIndirect_(@lb)
      hBrush = result
  EndIf 
  ProcedureReturn result 
EndProcedure 

Procedure CBcallback(hwnd, msg, wparam, lparam) 
  result = CallWindowProc_(Callback, hwnd, msg, wparam, lparam)
  Select msg
     Case #WM_LBUTTONDOWN 
       If IsWindow(#Window_1)
          CloseWindow(#Window_1)
       Else  
          OpenWindow_Window_1()
       EndIf
     Case #WM_CTLCOLORLISTBOX
          rc.RECT : lItemHeight.i : lListHeight.i
          Static bIgnore.b
          iListItems.b = 0  ; - amount items ComboBox
          If Not bIgnore
             With rc
               lItemHeight = SendMessage_(lParam, #LB_GETITEMHEIGHT, 0, 0)
               lListHeight = lItemHeight * iListItems + 2
               GetWindowRect_(lParam, rc)
               bIgnore = #True
               MoveWindow_(lParam, \Left, \Top, (\Right - \Left), lListHeight, #True)
               bIgnore = False
             EndWith
           EndIf
  EndSelect
  ProcedureReturn result 
EndProcedure 

Procedure OpenWindow_Window_0()
  If OpenWindow(#Window_0, 450, 200, 200, 100, "ColorGadget", #PB_Window_TitleBar|#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget)
      ComboBoxGadget(#ComboBox_1, 40, 20, 120, 20, #CBS_OWNERDRAWFIXED|#CBS_HASSTRINGS)
      TextGadget(#rgb, 40, 60, 140, 20, "")

      SetGadgetText(#rgb, "Color = RGB(" + Str(Red(sel_Color)) + ", " +Str(Green(sel_Color))+ ", "+Str(Blue(sel_Color)) +")")
  EndIf
EndProcedure

Procedure Lin(x,y,x1,y1,Width,color) 
   hDC=GetDC_(WindowID(#Window_1)) 
   pen=CreatePen_(#PS_SOLID,Width,color)  
   hPenOld=SelectObject_(hDC,pen) 
   MoveToEx_(hDC,x,y,0):LineTo_(hDC,x1,y1) 
   DeleteObject_(pen) 
   DeleteObject_(hPenOld) 
EndProcedure 

Procedure OpenWindow_Window_1()
  If OpenWindow(#Window_1, 0, 0, 176, 133, "Window_1", #PB_Window_BorderLess|#PB_Window_ScreenCentered|#PB_Window_Invisible,WindowID(#Window_0))
       SetWindowColor(#Window_1, #White)
       ClientToScreen_(GadgetID(#ComboBox_1), p.RECT)
       GetWindowRect_(WindowID(#Window_1), r.RECT)
       MoveWindow_(WindowID(#Window_1), p\left,  p\top + GadgetHeight(#ComboBox_1)+1, r\Right - r\Left, r\Bottom - r\Top, #Null)  
      ; **********************************************************************************************    
       If WindowX(#Window_1) < 0
            g = Abs(WindowX(#Window_1))
            MoveWindow_(WindowID(#Window_1), p\left-2 + g,  p\top + GadgetHeight(#ComboBox_1), r\Right - r\Left, r\Bottom - r\Top, #Null)  
       EndIf
       If WindowX(#Window_1) + WindowWidth(#Window_1) > GetDeviceCaps_(GetDC_(0), #HORZRES)
            d = WindowX(#Window_1) + WindowWidth(#Window_1) - GetDeviceCaps_(GetDC_(0), #HORZRES)
            MoveWindow_(WindowID(#Window_1), p\left-2 - d,  p\top + GadgetHeight(#ComboBox_1), r\Right - r\Left, r\Bottom - r\Top, #Null)  
       EndIf
       If WindowY(#Window_1) + WindowHeight(#Window_1) > GetDeviceCaps_(GetDC_(0), #VERTRES)
           MoveWindow_(WindowID(#Window_1), p\left-2 - d + g,  p\top - WindowHeight(#Window_1)-4, r\Right - r\Left, r\Bottom - r\Top, #Null)  
       EndIf  
      ; **********************************************************************************************    
     p1.POINT
     p2.POINT
     lpRect.RECT
     FirstElement(col()) 
     For i = 100 To 139  
          If j = 8 : j = 0 : m + 21 : n = 0 : a + 8 : EndIf
       
          col()\index = i
          CanvasGadget(i, i- 95 - a + n, 5 + m, 20, 20, #PB_Canvas_DrawFocus)
          GadgetToolTip(i, col()\hint)
          GetWindowRect_(GadgetID(i), lpRect)
         
          p1\x = lpRect\left
          p1\y = lpRect\top
          ScreenToClient_(WindowID(#Window_1), p1)
          col()\rt\left = p1\x 
          col()\rt\top  = p1\y 
         
          p2\x = lpRect\right
          p2\y = lpRect\bottom
          ScreenToClient_(WindowID(#Window_1), p2)
          col()\rt\right  = p2\x
          col()\rt\bottom = p2\y
         
          If StartDrawing(CanvasOutput(i))
             Box(3,3,14,14, $C0C0C0)
             Box(4,4,12,12, col()\color)
            StopDrawing()
          EndIf
          j + 1
          n + 20
          NextElement(col())
     Next i 
     
     hWnd = TextGadget(#text,9,113,159, 15,"More colors...",#PB_Text_Center|#SS_NOTIFY) 
     SetClassLong_(hWnd, #GCL_HCURSOR, LoadCursor_(0, #IDC_HAND))      
     SetGadgetColor(#text, #PB_Gadget_BackColor,  $FAE1D0)   ; 
      
     SetClassLongPtr_(WindowID(#Window_1),#GCL_STYLE,$00020000)    ; shadow
     HideWindow(#Window_1,0) 
     
     Lin(GadgetX(#text)-1, GadgetY(#text)-1, GadgetWidth(#text)+9,GadgetY(#text)-1, 1, $FFA000)
     Lin(GadgetX(#text)-1, GadgetY(#text)+GadgetHeight(#text), GadgetWidth(#text)+9,GadgetY(#text)+GadgetHeight(#text), 1, $FFA000)
     Lin(GadgetX(#text)-1, GadgetY(#text)-1, GadgetX(#text)-1, GadgetY(#text)+GadgetHeight(#text)+1, 1, $FFA000)
     Lin(GadgetWidth(#text)+9,GadgetY(#text)-1,GadgetWidth(#text)+9,GadgetY(#text)+GadgetHeight(#text)+1, 1, $FFA000)
     
     Lin(0,0,WindowWidth(#Window_1),0,1,GetSysColor_(#COLOR_BTNSHADOW)) 
     Lin(0,0,0,WindowHeight(#Window_1),1,GetSysColor_(#COLOR_BTNSHADOW)) 
     Lin(0, WindowHeight(#Window_1)-1 ,WindowWidth(#Window_1), WindowHeight(#Window_1)-1,1,GetSysColor_(#COLOR_BTNSHADOW)) 
     Lin(WindowWidth(#Window_1)-1, 0, WindowHeight(#Window_1)+42, WindowWidth(#Window_1),1, GetSysColor_(#COLOR_BTNSHADOW))  

     If sel_Color <> -1
         FirstElement(col())
         ForEach col()
            If col()\color = sel_Color
               hDC=GetDC_(WindowID(#Window_1)) 
               InflateRect_(col()\rt, 1, 1) 
               DrawFocusRect_(hDC, col()\rt)     
               Break
            EndIf      
         Next col()
     EndIf    
  EndIf
EndProcedure

Procedure DrawItem(item, itemcolor, backcolor)
  FirstElement(col())
  ForEach col()
    If col()\index = item
       Break
    EndIf  
  Next col()
  If StartDrawing(CanvasOutput(item))
     Box(0,0,20,20, itemcolor)
     Box(1,1,18,18, backcolor)
     Box(3,3,14,14, $C0C0C0)
     Box(4,4,12,12, col()\color)
     StopDrawing()
  EndIf
EndProcedure

OpenWindow_Window_0()
SetWindowCallback(@MainCallback(), #Window_0)
Callback = SetWindowLongPtr_(GadgetID(#ComboBox_1), #GWL_WNDPROC, @CBcallback())

Repeat
  If IsWindow(#Window_1)
     If GetForegroundWindow_() <> WindowID(#Window_1)
         CloseWindow(#Window_1)
     EndIf 
  EndIf
  If IsGadget(#text)
    If IsMouseOver(GadgetID(#text))
       If n = 0
         SetGadgetColor(#text, #PB_Gadget_BackColor,  $FFA000) 
         SetGadgetColor(#text, #PB_Gadget_FrontColor, $FFFFFF)
         n!1
        EndIf 
     Else
        If n     
          SetGadgetColor(#text, #PB_Gadget_BackColor,  $FAE1D0) 
          SetGadgetColor(#text, #PB_Gadget_FrontColor, $0) 
          n!1
         EndIf 
     EndIf 
  EndIf    
  Event = WaitWindowEvent()
  Select Event
    Case #PB_Event_Gadget
      EventGadget = EventGadget()
      EventType = EventType()
         If EventGadget => 100                            
             DrawItem(EventGadget, $FFA000, $FFFFFF)    
         EndIf
         If EventGadget => 100 And EventType = #PB_EventType_MouseLeave  
             DrawItem(EventGadget, $FFFFFF, $FFFFFF)    
         EndIf
         If EventGadget => 100 And EventType = #PB_EventType_LeftButtonUp  
             FirstElement(col())
             ForEach col()
               If col()\index = EventGadget
                  sel_Color = col()\color
                  Break
               EndIf 
             Next col()
             SetGadgetText(#rgb, "Color = RGB(" + Str(Red(sel_Color)) + ", " +Str(Green(sel_Color))+ ", "+Str(Blue(sel_Color)) +")")
             If hBrush : DeleteObject_(hBrush) : EndIf
             CloseWindow(#Window_1)
             RedrawWindow_(GadgetID(#ComboBox_1),0,0,#RDW_INVALIDATE | #RDW_ERASE)
             UpdateWindow_(GadgetID(#ComboBox_1))
         EndIf
      Select EventGadget
        Case #text
            CloseWindow(#Window_1)
            rescol = ColorRequester()
            If rescol <> -1
              sel_Color = rescol
               If hBrush : DeleteObject_(hBrush) : EndIf
               RedrawWindow_(GadgetID(#ComboBox_1),0,0,#RDW_INVALIDATE | #RDW_ERASE)
               UpdateWindow_(GadgetID(#ComboBox_1))
               SetGadgetText(#rgb, "Color = RGB(" + Str(Red(sel_Color)) + ", " +Str(Green(sel_Color))+ ", "+Str(Blue(sel_Color)) +")")
            EndIf 
      EndSelect
    Case #PB_Event_CloseWindow
      EventWindow = EventWindow()
      If EventWindow = #Window_0
        CloseWindow(#Window_0)
        Break
      EndIf  
  EndSelect
ForEver

DataSection
  col:            ; Color palette
  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:    ; ToolTip
  Data.s "Black","Brown","Dark Olive Green","Dark Green","Dark Teal","Dark blue","Indigo","Dark grey"  
  Data.s "Dark red","Orange","Dark yellow","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
   

[ts-soft]

Great stuff

But you should remove the .l or change to .i from the variables (callbacks, hwnd and so on) to work on 64-Bit!

[pablov]

But you should remove the .l or change to .i from the variables (callbacks, hwnd and so on) to work on 64-Bit!

Corrected