PureBasic Forum

; 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

 ; 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

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

; 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