Author : uwekel
Current version : 18.02.2014
Date of creation : 2014-02-18 16:46:09
Date of last version : 2014-02-18 16:46:09
Compatible with : Linux, Mac, Windows
Compile on : PureBasic only
Basic version used : PureBasic 5.21 LTS
Category : Custom gadgets,
Description : A color combo gadget to select a color from a list of standard colors. Also possible to select a custom color.
  1.  
  2. EnableExplicit
  3.  
  4. Enumeration ;color set constants
  5.   #ColorComboBase ;16 base colors
  6.   #ColorComboExtended ;more colors
  7.   #ColorComboCustom ;custom color
  8. EndEnumeration
  9.  
  10. #_ColorComboIconSize = 20
  11. #_ColorComboOther = "Custom..."
  12.  
  13. Procedure _ColorComboImage(Color)
  14.   ;create new image
  15.   Protected image = CreateImage(#PB_Any, #_ColorComboIconSize, #_ColorComboIconSize)
  16.   StartDrawing(ImageOutput(image))
  17.   ;black border
  18.   Box(0, 0, #_ColorComboIconSize, #_ColorComboIconSize, 0)
  19.   ;colored background
  20.   Box(1, 1, #_ColorComboIconSize - 2, #_ColorComboIconSize - 2, Color)
  21.   ;draw border
  22.   StopDrawing()
  23.   ProcedureReturn ImageID(image)
  24. EndProcedure
  25. Procedure _ColorComboAdd(Gadget, Name.s, Color)
  26.   ;appends a color to the color combo gadget
  27.   AddGadgetItem(Gadget, -1, Name, _ColorComboImage(Color))
  28.   SetGadgetItemData(Gadget, CountGadgetItems(Gadget) - 1, Color)
  29. EndProcedure
  30. Procedure _ColorComboCustom()
  31.   Protected i, color, shape, g = EventGadget()
  32.   If GetGadgetText(g) = #_ColorComboOther
  33.     i = GetGadgetState(g)
  34.     color = GetGadgetItemData(g, i)
  35.     color = ColorRequester(color)
  36.     If color > -1
  37.       SetGadgetItemImage(g, i, _ColorComboImage(color))
  38.       SetGadgetItemData(g, i, color)
  39.     EndIf
  40.     ProcedureReturn color
  41.   EndIf
  42. EndProcedure
  43. Procedure.l ColorComboGet(Gadget)
  44.   ;returns the selected color value
  45.   Protected i = GetGadgetState(Gadget)
  46.   ProcedureReturn GetGadgetItemData(Gadget, i)
  47. EndProcedure
  48. Procedure ColorComboSet(Gadget, Color.l)
  49.   ;sets a new color value
  50.   Protected i, c.l, delta, mindelta, index, shape
  51.   If GetGadgetData(Gadget) & #ColorComboCustom
  52.     ;try to find color in list
  53.     For i = 0 To CountGadgetItems(Gadget) - 1
  54.       c.l = GetGadgetItemData(Gadget, i)
  55.       If c = Color
  56.         SetGadgetState(Gadget, i)
  57.         ProcedureReturn
  58.       EndIf
  59.     Next
  60.     ;set custom color
  61.     i - 1
  62.     SetGadgetItemImage(Gadget, i, _ColorComboImage(Color))
  63.     SetGadgetItemData(Gadget, i, Color)
  64.     SetGadgetState(Gadget, i)
  65.   Else
  66.     ;get nearest color (because we may not set a custom color)
  67.     mindelta = -1
  68.     For i = 0 To CountGadgetItems(Gadget) - 1
  69.       c.l = GetGadgetItemData(Gadget, i)
  70.       delta = Abs(Red(c) - Red(Color)) + Abs(Green(c) - Green(Color)) + Abs(Blue(c) - Blue(Color))
  71.       If mindelta = -1 Or delta < mindelta
  72.         mindelta = delta
  73.         index = i
  74.       EndIf
  75.     Next
  76.     SetGadgetState(Gadget, index)
  77.   EndIf
  78. EndProcedure
  79. Procedure ColorComboGadget(Gadget, X, Y, W, H, Flags=#ColorComboBase)
  80.   ;create combo box
  81.   Protected r = ComboBoxGadget(Gadget, X, Y, W, H, #PB_ComboBox_Image)
  82.   ;support #PB_Any
  83.   If Gadget = #PB_Any
  84.     Gadget = r
  85.   EndIf
  86.   ;store flags in gadget data
  87.   SetGadgetData(Gadget, Flags)
  88.   ;add colors
  89.   _ColorComboAdd(Gadget, "Black", $000000)
  90.   If Flags & #ColorComboExtended
  91.     _ColorComboAdd(Gadget, "Darkness", $202020)
  92.     _ColorComboAdd(Gadget, "Night", $404040)
  93.     _ColorComboAdd(Gadget, "DarkGrey", $606060)
  94.   EndIf
  95.   _ColorComboAdd(Gadget, "Grey", $808080)
  96.   If Flags & #ColorComboExtended
  97.     _ColorComboAdd(Gadget, "LightGrey", $A0A0A0)
  98.     _ColorComboAdd(Gadget, "Silver", $C0C0C0)
  99.     _ColorComboAdd(Gadget, "Smoke", $E0E0E0)
  100.   EndIf
  101.   _ColorComboAdd(Gadget, "White", $FFFFFF)
  102.   _ColorComboAdd(Gadget, "Maroon", $000080)
  103.   _ColorComboAdd(Gadget, "Red", $0000FF)
  104.   If flags & #ColorComboExtended
  105.     _ColorComboAdd(Gadget, "Brown", $004080)
  106.     _ColorComboAdd(Gadget, "Orange", $0080FF)
  107.   EndIf
  108.   _ColorComboAdd(Gadget, "Olive", $008080)
  109.   _ColorComboAdd(Gadget, "Yellow", $00FFFF)
  110.   If flags & #ColorComboExtended
  111.     _ColorComboAdd(Gadget, "LightYellow", $80FFFF)
  112.   EndIf
  113.   _ColorComboAdd(Gadget, "Green", $008000)
  114.   _ColorComboAdd(Gadget, "Lime", $00FF00)
  115.   If flags & #ColorComboExtended
  116.     _ColorComboAdd(Gadget, "LightGreen", $80FF80)
  117.   EndIf
  118.   _ColorComboAdd(Gadget, "Teal", $808000)
  119.   _ColorComboAdd(Gadget, "Aqua", $FFFF00)
  120.   If flags & #ColorComboExtended
  121.     _ColorComboAdd(Gadget, "LightAqua", $FFFF80)
  122.   EndIf
  123.   _ColorComboAdd(Gadget, "Navy", $800000)
  124.   _ColorComboAdd(Gadget, "Blue", $FF0000)
  125.   If flags & #ColorComboExtended
  126.     _ColorComboAdd(Gadget, "LightBlue", $FF8080)
  127.     _ColorComboAdd(Gadget, "DarkViolet", $800040)
  128.     _ColorComboAdd(Gadget, "Violet", $FF0080)
  129.   EndIf
  130.   _ColorComboAdd(Gadget, "Purple", $800080)
  131.   If flags & #ColorComboExtended
  132.     _ColorComboAdd(Gadget, "LightPurple", $8000FF)
  133.   EndIf
  134.   _ColorComboAdd(Gadget, "Fuchsia", $FF00FF)
  135.   If flags & #ColorComboExtended
  136.     _ColorComboAdd(Gadget, "LightFuchsia", $FF80FF)
  137.   EndIf
  138.   If flags & #ColorComboCustom
  139.     _ColorComboAdd(Gadget, #_ColorComboOther, $000000)
  140.   EndIf
  141.   ;by default set first color
  142.   SetGadgetState(Gadget, 0)
  143.   ;handle custom color
  144.   BindEvent(#PB_Event_Gadget, @_ColorComboCustom(), #PB_All, Gadget, #PB_EventType_Change)
  145.   ;return result
  146.   ProcedureReturn Gadget
  147. EndProcedure
  148.  
  149. DisableExplicit
  150.  
  151. CompilerIf #PB_Compiler_IsMainFile
  152.   If OpenWindow(0, 0, 0, 250, 148, "ColorCombo-Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  153.    
  154.     ;color combo with base color set
  155.     ColorComboGadget(0, 10, 10, 230, 36, #ColorComboBase)
  156.     ColorComboSet(0, $FF)
  157.    
  158.     ;color combo with extended color set
  159.     ColorComboGadget(1, 10, 56, 230, 36, #ColorComboExtended)
  160.     ColorComboSet(1, $FF00)
  161.    
  162.     ;color combo with additional custom color
  163.     ColorComboGadget(2, 10, 102, 230, 36, #ColorComboExtended | #ColorComboCustom)
  164.     ColorComboSet(2, $FF0000)
  165.    
  166.     Repeat
  167.       Select WaitWindowEvent()
  168.       Case #PB_Event_Gadget
  169.         gadget = EventGadget()
  170.         color = ColorComboGet(gadget)
  171.         Debug "ColorCombo " + Str(gadget) + " changed to $" + RSet(Hex(color), 6, "0")
  172.       Case #PB_Event_CloseWindow
  173.         Break
  174.       EndSelect
  175.     ForEver
  176.    
  177.   EndIf
  178. CompilerEndIf

No comments on this source code.