ColorPalette: Add built-in palettes (property "PaletteKind", and "GradientSteps" for GradientPalette)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4284 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/colorpalette/colorpalette.pas

@@ -61,6 +61,10 @@ type
   TPickShiftEnum = (ssLeft, ssRight, ssMiddle);
   TPickShift = set of TPickShiftEnum;
 
+  TPaletteKind = (pkStandardPalette, pkExtendedPalette, pkSystemPalette,
+    pkStandardAndSystemPalette, pkExtendedAndSystemPalette,
+    pkGradientPalette, pkWebSafePalette, pkWebSafePalette2);
+
   TColorMouseEvent = procedure (Sender: TObject; AColor: TColor; Shift: TShiftState) of object;
   TColorPaletteEvent = procedure (Sender: TObject; AColor: TColor) of object;
 
@@ -89,6 +93,8 @@ type
     FSavedHint: String;
     FBorderColor: TColor;
     FBorderWidth: Integer;
+    FPaletteKind: TPaletteKind;
+    FGradientSteps: Byte;
     function GetColorCount: Integer;
     function GetColors(AIndex: Integer): TColor;
     function GetPickedColor: TColor;
@@ -98,9 +104,13 @@ type
     procedure SetButtonWidth(const AValue: Integer);
     procedure SetColors(AIndex: Integer; const AValue: TColor);
     procedure SetCols(AValue: Integer);
+    procedure SetGradientSteps(AValue: Byte);
+    procedure SetPaletteKind(AValue: TPaletteKind);
     procedure SetSelectedIndex(AValue: Integer);
     procedure SetShowSelection(AValue: Boolean);
+
   protected
+    procedure BlendWBColor(AColor: TColor; Steps: Integer);
     procedure ColorPick(AIndex: Integer; Shift: TShiftState); dynamic;
     procedure ColorMouseMove(AColor: TColor; Shift: TShiftState); dynamic;
     procedure DoAddColor(AColor: TColor); virtual;
@@ -120,6 +130,8 @@ type
     property ButtonWidth: Integer read FButtonWidth write SetButtonWidth;
     property ButtonHeight: Integer read FButtonHeight write SetButtonHeight;
     property ColumnCount: Integer read FCols write SetCols;
+    property GradientSteps: Byte read FGradientSteps write SetGradientSteps default 3;
+    property PaletteKind: TPaletteKind read FPaletteKind write SetPaletteKind default pkStandardPalette;
     property PickMode: TPickMode read FPickMode write FPickMode default pmDefault;
     property PickShift: TPickShift read FPickShift write FPickShift default [ssLeft];
     property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex default 0;
@@ -132,6 +144,7 @@ type
     procedure Paint; override;
 
     procedure AddColor(AColor: TColor);
+    procedure ClearColors;
     procedure DeleteColor(AIndex: Integer);
     procedure LoadPalette(const FileName: String);
     procedure SavePalette(const FileName: String);
@@ -157,6 +170,8 @@ type
     property ButtonWidth;
     property ButtonHeight;
     property ColumnCount;
+    property GradientSteps;
+    property PaletteKind;
     property PickMode;
     property PickShift;
     property SelectedIndex;
@@ -224,26 +239,10 @@ begin
   FPrevMouseIndex := -1;
   FPickShift := [ssLeft];
   FShowColorHint := true;
+  FGradientSteps := 3;
 
   FCols := 8;
-
+  SetPaletteKind(pkStandardPalette);
-  DoAddColor(clBlack);
-  DoAddColor(clGray);
-  DoAddColor(clMaroon);
-  DoAddColor(clOlive);
-  DoAddColor(clGreen);
-  DoAddColor(clTeal);
-  DoAddColor(clNavy);
-  DoAddColor(clPurple);
-
-  DoAddColor(clWhite);
-  DoAddColor(clSilver);
-  DoAddColor(clRed);
-  DoAddColor(clYellow);
-  DoAddColor(clLime);
-  DoAddColor(clAqua);
-  DoAddColor(clBlue);
-  DoAddColor(clFuchsia);
 
   UpdateSize;
 end;
@@ -261,6 +260,37 @@ begin
   Invalidate;
 end;
 
+procedure TCustomColorPalette.BlendWBColor(AColor: TColor; Steps: Integer);
+var
+  I: Integer;
+  R, G, B, NR, NG, NB: Byte;
+begin
+  RedGreenBlue(AColor, R, G, B);
+
+  for I := 1 to Steps do
+  begin
+    NR := Round((R * I + 255 * (Steps + 1 - I)) / (Steps + 1));
+    NG := Round((G * I + 255 * (Steps + 1 - I)) / (Steps + 1));
+    NB := Round((B * I + 255 * (Steps + 1 - I)) / (Steps + 1));
+    DoAddColor(RGBToColor(NR, NG, NB));
+  end;
+
+  DoAddColor(AColor);
+
+  for I := Steps downto 1 do
+  begin
+    NR := Round(R * I / (Steps + 1));
+    NG := Round(G * I / (Steps + 1));
+    NB := Round(B * I / (Steps + 1));
+    DoAddColor(RGBToColor(NR, NG, NB));
+  end;
+end;
+
+procedure TCustomColorPalette.ClearColors;
+begin
+  FColors.Clear;
+end;
+
 procedure TCustomColorPalette.ColorPick(AIndex: Integer; Shift: TShiftState);
 var
   c: TColor;
@@ -382,32 +412,6 @@ var
     Result := RGBToColor(Max(0, Min(R, 255)), Max(0, Min(G, 255)), Max(0, Min(B, 255)));
   end;
 
-  procedure BlendWBColor(Color: TColor; Steps: Integer);
-  var
-    I: Integer;
-    R, G, B, NR, NG, NB: Byte;
-  begin
-    RedGreenBlue(Color, R, G, B);
-
-    for I := 1 to Steps do
-    begin
-      NR := Round((R * I + 255 * (Steps + 1 - I)) / (Steps + 1));
-      NG := Round((G * I + 255 * (Steps + 1 - I)) / (Steps + 1));
-      NB := Round((B * I + 255 * (Steps + 1 - I)) / (Steps + 1));
-      DoAddColor(RGBToColor(NR, NG, NB));
-    end;
-
-    DoAddColor(Color);
-
-    for I := Steps downto 1 do
-    begin
-      NR := Round(R * I / (Steps + 1));
-      NG := Round(G * I / (Steps + 1));
-      NB := Round(B * I / (Steps + 1));
-      DoAddColor(RGBToColor(NR, NG, NB));
-    end;
-  end;
-
 begin
   if not FileExists(FileName) then
     raise Exception.Create(Format('[TCustomColorPalette.LoadPalette] File not found: %s', [FileName]));
@@ -677,22 +681,299 @@ begin
   UpdateSize;
   Invalidate;
 end;
-{
+
-procedure TCustomColorPalette.SetShowColorHint(AValue: Boolean);
+procedure TCustomColorPalette.SetGradientSteps(AValue: Byte);
 begin
-  if FShowColorHint = AValue then exit;
+  if FGradientSteps = AValue then
-  if AValue then
+    exit;
-    FSavedHint := Hint
+  FGradientSteps := AValue;
-  else
+  if FPaletteKind = pkGradientPalette then
-    Hint := FSavedHint;
+  begin
-  FShowColorHint := AValue;
+    FColors.Clear;
+    SetPaletteKind(FPaletteKind);
   end;
- }
+end;
-procedure TCustomColorPalette.SetShowSelection(AValue: Boolean);
+
+procedure TCustomColorPalette.SetPaletteKind(AValue: TPaletteKind);
+
+  function FixHex(hx: String): TColor;
+  var
+    r, g, b, color: string;
   begin
-  if FShowSelection = AValue then exit;
+    r := copy(hx,1,2);
-  FShowSelection := AValue;
+    g := copy(hx,3,2);
-  Invalidate;
+    b := copy(hx,5,2);
+    Result := StringToColor('$0' + b + g + r);
+  end;
+
+const
+  STEPS: array[0..4] of byte = (0, 64, 128, 192, 255);
+  COLCOUNT: array[TPaletteKind] of Integer = (
+     8,  // StandardPalette = 16 standard colors
+     4,  // ExtendedPalette = 16 standard colors + 4 extra colors
+     5,  // SystemPalette = 25 system colors
+     8,  // StandardAndSystemPalette = 16 standard + 25 system colors = 41 colors
+     5,  // ExtendedAndSystemPalette = 16 std + 4 extra + 25 system colors = 45 colors
+    -1,  // Gradient palette - color count depends on PaletteStep
+     6,  // Websafe palette
+    14   // Websafe palette #2
+  );
+var
+  i, n: Integer;
+  r,g,b: Integer;
+begin
+  if (FPaletteKind = AValue) and (FColors.Count > 0) then
+    exit;
+
+  FPaletteKind := AValue;
+  FColors.Clear;
+
+  if FPaletteKind in [pkStandardPalette, pkExtendedPalette,
+    pkStandardAndSystemPalette, pkExtendedAndSystemPalette] then
+  begin
+    DoAddColor(clBlack);       // 16
+    DoAddColor(clGray);
+    DoAddColor(clMaroon);
+    DoAddColor(clOlive);
+    DoAddColor(clGreen);
+    DoAddColor(clTeal);
+    DoAddColor(clNavy);
+    DoAddColor(clPurple);
+    DoAddColor(clWhite);
+    DoAddColor(clSilver);
+    DoAddColor(clRed);
+    DoAddColor(clYellow);
+    DoAddColor(clLime);
+    DoAddColor(clAqua);
+    DoAddColor(clBlue);
+    DoAddColor(clFuchsia);
+  end;
+
+  if FPaletteKind in [pkExtendedPalette, pkExtendedAndSystemPalette] then
+  begin
+    DoAddColor(clMoneyGreen);     // 4
+    DoAddColor(clSkyBlue);
+    DoAddColor(clCream);
+    DoAddColor(clMedGray);
+  end;
+
+  if FPaletteKind in [pkSystemPalette, pkStandardAndSystemPalette, pkExtendedAndSystemPalette] then
+  begin
+    DoAddColor(clScrollBar);            // 25
+    DoAddColor(clBackground);
+    DoAddColor(clActiveCaption);
+    DoAddColor(clInactiveCaption);
+    DoAddColor(clMenu);
+    DoAddColor(clWindow);
+    DoAddColor(clWindowFrame);
+    DoAddColor(clMenuText);
+    DoAddColor(clWindowText);
+    DoAddColor(clCaptionText);
+    DoAddColor(clActiveBorder);
+    DoAddColor(clInactiveBorder);
+    DoAddColor(clAppWorkspace);
+    DoAddColor(clHighlight);
+    DoAddColor(clHighlightText);
+    DoAddColor(clBtnFace);
+    DoAddColor(clBtnShadow);
+    DoAddColor(clGrayText);
+    DoAddColor(clBtnText);
+    DoAddColor(clInactiveCaptionText);
+    DoAddColor(clBtnHighlight);
+    DoAddColor(cl3DDkShadow);
+    DoAddColor(cl3DLight);
+    DoAddColor(clInfoText);
+    DoAddColor(clInfoBk);
+  end;
+
+  if FPaletteKind = pkGradientPalette then
+  begin
+    if FGradientSteps = 0 then n := 1 else n := FGradientSteps;
+    for i:= Low(STEPS) to High(STEPS) do BlendWBColor((RGBToColor(255, STEPS[i], 0)), n);
+    for i:= High(STEPS) downto Low(STEPS) do BlendWBColor((RGBToColor(STEPS[i], 255, 0)), n);
+    for i:= Low(STEPS) to High(STEPS) do BlendWBColor((RGBToColor(0, 255, STEPS[i])), n);
+    for i:= High(STEPS) downto Low(STEPS) do BlendWBColor((RGBToColor(0, STEPS[i], 255)), n);
+    for i:= Low(STEPS) to High(STEPS) do BlendWBColor((RGBToColor(STEPS[i], 0, 255)), n);
+    for i:= Low(STEPS) downto High(STEPS) do BlendWBColor((RGBToColor(0, 255, STEPS[i])), n);
+    SetCols(n*2 + 1);
+  end;
+
+  if FPaletteKind = pkWebSafePalette then
+    // https://en.wikipedia.org/wiki/Web_colors
+    for g := 0 to 5 do
+      for b:= 0 to 5 do
+        for r:=0 to 5 do
+          DoAddColor(RGBToColor(r*$33, g*$33, b*$33));
+
+  if FPaletteKind = pkWebSafePalette2 then
+  begin
+    DoAddColor(FixHex('f0f8ff'));       // 140
+    DoAddColor(FixHex('faebd7'));
+    DoAddColor(FixHex('00ffff'));
+    DoAddColor(FixHex('7fffd4'));
+    DoAddColor(FixHex('f0ffff'));
+    DoAddColor(FixHex('f5f5dc'));
+
+    DoAddColor(FixHex('ffe4c4'));
+    DoAddColor(FixHex('000000'));
+    DoAddColor(FixHex('ffebcd'));
+    DoAddColor(FixHex('0000ff'));
+    DoAddColor(FixHex('8a2be2'));
+    DoAddColor(FixHex('a52a2a'));
+
+    DoAddColor(FixHex('deb887'));
+    DoAddColor(FixHex('5f9ea0'));
+    DoAddColor(FixHex('7fff00'));
+    DoAddColor(FixHex('d2691e'));
+    DoAddColor(FixHex('ff7f50'));
+    DoAddColor(FixHex('6495ed'));
+
+    DoAddColor(FixHex('fff8dc'));
+    DoAddColor(FixHex('dc143c'));
+    DoAddColor(FixHex('00ffff'));
+    DoAddColor(FixHex('00008b'));
+    DoAddColor(FixHex('008b8b'));
+    DoAddColor(FixHex('b8860b'));
+
+    DoAddColor(FixHex('a9a9a9'));
+    DoAddColor(FixHex('006400'));
+    DoAddColor(FixHex('bdb76b'));
+    DoAddColor(FixHex('8b008b'));
+    DoAddColor(FixHex('556b2f'));
+    DoAddColor(FixHex('ff8c00'));
+
+    DoAddColor(FixHex('9932cc'));
+    DoAddColor(FixHex('8b0000'));
+    DoAddColor(FixHex('e9967a'));
+    DoAddColor(FixHex('8fbc8f'));
+    DoAddColor(FixHex('483d8b'));
+    DoAddColor(FixHex('2f4f4f'));
+
+    DoAddColor(FixHex('00ced1'));
+    DoAddColor(FixHex('9400d3'));
+    DoAddColor(FixHex('ff1493'));
+    DoAddColor(FixHex('00bfff'));
+    DoAddColor(FixHex('696969'));
+    DoAddColor(FixHex('1e90ff'));
+
+    DoAddColor(FixHex('b22222'));
+    DoAddColor(FixHex('fffaf0'));
+    DoAddColor(FixHex('228b22'));
+    DoAddColor(FixHex('ff00ff'));
+    DoAddColor(FixHex('dcdcdc'));
+    DoAddColor(FixHex('f8f8ff'));
+
+    DoAddColor(FixHex('ffd700'));
+    DoAddColor(FixHex('daa520'));
+    DoAddColor(FixHex('808080'));
+    DoAddColor(FixHex('008000'));
+    DoAddColor(FixHex('adff2f'));
+    DoAddColor(FixHex('f0fff0'));
+
+    DoAddColor(FixHex('ff69b4'));
+    DoAddColor(FixHex('cd5c5c'));
+    DoAddColor(FixHex('4b0082'));
+    DoAddColor(FixHex('fffff0'));
+    DoAddColor(FixHex('f0e68c'));
+    DoAddColor(FixHex('e6e6fa'));
+
+    DoAddColor(FixHex('fff0f5'));
+    DoAddColor(FixHex('7cfc00'));
+    DoAddColor(FixHex('fffacd'));
+    DoAddColor(FixHex('add8e6'));
+    DoAddColor(FixHex('f08080'));
+    DoAddColor(FixHex('e0ffff'));
+
+    DoAddColor(FixHex('fafad2'));
+    DoAddColor(FixHex('90ee90'));
+    DoAddColor(FixHex('d3d3d3'));
+    DoAddColor(FixHex('ffb6c1'));
+    DoAddColor(FixHex('ffa07a'));
+    DoAddColor(FixHex('20b2aa'));
+
+    DoAddColor(FixHex('87cefa'));
+    DoAddColor(FixHex('778899'));
+    DoAddColor(FixHex('b0c4de'));
+    DoAddColor(FixHex('ffffe0'));
+    DoAddColor(FixHex('00ff00'));
+    DoAddColor(FixHex('32cd32'));
+
+    DoAddColor(FixHex('faf0e6'));
+    DoAddColor(FixHex('ff00ff'));
+    DoAddColor(FixHex('800000'));
+    DoAddColor(FixHex('66cdaa'));
+    DoAddColor(FixHex('0000cd'));
+    DoAddColor(FixHex('ba55d3'));
+
+    DoAddColor(FixHex('9370db'));
+    DoAddColor(FixHex('3cb371'));
+    DoAddColor(FixHex('7b68ee'));
+    DoAddColor(FixHex('00fa9a'));
+    DoAddColor(FixHex('48d1cc'));
+    DoAddColor(FixHex('c71585'));
+
+    DoAddColor(FixHex('191970'));
+    DoAddColor(FixHex('f5fffa'));
+    DoAddColor(FixHex('ffe4e1'));
+    DoAddColor(FixHex('ffe4b5'));
+    DoAddColor(FixHex('ffdead'));
+    DoAddColor(FixHex('000080'));
+
+    DoAddColor(FixHex('fdf5e6'));
+    DoAddColor(FixHex('808000'));
+    DoAddColor(FixHex('6b8e23'));
+    DoAddColor(FixHex('ffa500'));
+    DoAddColor(FixHex('ff4500'));
+    DoAddColor(FixHex('da70d6'));
+
+    DoAddColor(FixHex('eee8aa'));
+    DoAddColor(FixHex('98fb98'));
+    DoAddColor(FixHex('afeeee'));
+    DoAddColor(FixHex('db7093'));
+    DoAddColor(FixHex('ffefd5'));
+    DoAddColor(FixHex('ffdab9'));
+
+    DoAddColor(FixHex('cd853f'));
+    DoAddColor(FixHex('ffc0cb'));
+    DoAddColor(FixHex('dda0dd'));
+    DoAddColor(FixHex('b0e0e6'));
+    DoAddColor(FixHex('800080'));
+    DoAddColor(FixHex('ff0000'));
+
+    DoAddColor(FixHex('bc8f8f'));
+    DoAddColor(FixHex('4169e1'));
+    DoAddColor(FixHex('8b4513'));
+    DoAddColor(FixHex('fa8072'));
+    DoAddColor(FixHex('f4a460'));
+    DoAddColor(FixHex('2e8b57'));
+
+    DoAddColor(FixHex('fff5ee'));
+    DoAddColor(FixHex('a0522d'));
+    DoAddColor(FixHex('c0c0c0'));
+    DoAddColor(FixHex('87ceeb'));
+    DoAddColor(FixHex('6a5acd'));
+    DoAddColor(FixHex('708090'));
+
+    DoAddColor(FixHex('fffafa'));
+    DoAddColor(FixHex('00ff7f'));
+    DoAddColor(FixHex('4682b4'));
+    DoAddColor(FixHex('d2b48c'));
+    DoAddColor(FixHex('008080'));
+    DoAddColor(FixHex('d8bfd8'));
+
+    DoAddColor(FixHex('ff6347'));
+    DoAddColor(FixHex('40e0d0'));
+    DoAddColor(FixHex('ee82ee'));
+    DoAddColor(FixHex('f5deb3'));
+    DoAddColor(FixHex('ffffff'));
+    DoAddColor(FixHex('f5f5f5'));
+
+    DoAddColor(FixHex('ffff00'));
+    DoAddColor(FixHex('9acd32'));
+  end;
+
+  if FPaletteKind <> pkGradientPalette then
+    SetCols(COLCOUNT[FPaletteKind]);
 end;
 
 procedure TCustomColorPalette.SetSelectedIndex(AValue: Integer);
@@ -708,6 +989,13 @@ begin
   DoSelectColor(GetColors(FSelectedIndex));
 end;
 
+procedure TCustomColorPalette.SetShowSelection(AValue: Boolean);
+begin
+  if FShowSelection = AValue then exit;
+  FShowSelection := AValue;
+  Invalidate;
+end;
+
 procedure TCustomColorPalette.UpdateSize;
 begin
   if (FCols = 0) or (FColors.Count = 0) then FRows := 0

components/colorpalette/demo/project1.lpi

@@ -67,7 +67,6 @@
     </CodeGeneration>
     <Linking>
       <Debugging>
-        <GenerateDebugInfo Value="False"/>
         <StripSymbols Value="True"/>
       </Debugging>
       <LinkSmart Value="True"/>

components/colorpalette/demo/unit1.lfm

@@ -1,36 +1,22 @@
 object MainForm: TMainForm
-  Left = 358
+  Left = 374
-  Height = 622
+  Height = 535
-  Top = 179
+  Top = 222
-  Width = 455
+  Width = 625
   Caption = 'MainForm'
-  ClientHeight = 622
+  ClientHeight = 535
-  ClientWidth = 455
+  ClientWidth = 625
   OnCreate = FormCreate
   ShowHint = True
   LCLVersion = '1.5'
-  object ColorPalette: TColorPalette
-    Left = 176
-    Height = 33
-    Hint = 'Click to select a color'
-    Top = 15
-    Width = 129
-    ButtonWidth = 16
-    ButtonHeight = 16
-    ColumnCount = 8
-    PickShift = [ssLeft, ssMiddle]
-    OnSelectColor = ColorPaletteSelectColor
-    PopupMenu = PalettePopupMenu
-    OnDblClick = ColorPaletteDblClick
-  end
   object Panel1: TPanel
     Left = 0
-    Height = 622
+    Height = 535
     Top = 0
     Width = 160
     Align = alLeft
     BevelOuter = bvNone
-    ClientHeight = 622
+    ClientHeight = 535
     ClientWidth = 160
     TabOrder = 0
     object ColorSample: TShape
@@ -40,7 +26,7 @@ object MainForm: TMainForm
       Width = 63
     end
     object LblColorInfo: TLabel
-      Left = 9
+      Left = 10
       Height = 65
       Top = 45
       Width = 146
@@ -64,7 +50,7 @@ object MainForm: TMainForm
     object BtnLoadRndPalette: TButton
       Left = 10
       Height = 25
-      Top = 181
+      Top = 308
       Width = 137
       Caption = 'Load random palette'
       Enabled = False
@@ -74,7 +60,7 @@ object MainForm: TMainForm
     object BtnCreateRndPalette: TButton
       Left = 10
       Height = 25
-      Top = 152
+      Top = 279
       Width = 137
       Caption = 'Create random palette'
       OnClick = BtnCreateRndPaletteClick
@@ -83,7 +69,7 @@ object MainForm: TMainForm
     object BtnAddColor: TButton
       Left = 10
       Height = 25
-      Top = 264
+      Top = 385
       Width = 137
       Caption = 'Add color...'
       OnClick = BtnAddColorClick
@@ -92,7 +78,7 @@ object MainForm: TMainForm
     object BtnLoadDefaultPal: TButton
       Left = 10
       Height = 25
-      Top = 112
+      Top = 239
       Width = 137
       Caption = 'Load Default.pal'
       OnClick = BtnLoadDefaultPalClick
@@ -101,7 +87,7 @@ object MainForm: TMainForm
     object BtnDeleteColor: TButton
       Left = 10
       Height = 25
-      Top = 293
+      Top = 414
       Width = 137
       Caption = 'Delete color #0'
       OnClick = BtnDeleteColorClick
@@ -110,35 +96,147 @@ object MainForm: TMainForm
     object BtnLoadDefaultPal1: TButton
       Left = 10
       Height = 25
-      Top = 219
+      Top = 346
       Width = 137
       Caption = 'Save palette...'
       TabOrder = 6
     end
-    object EdColCount: TSpinEdit
+    object LblGradientSteps: TLabel
-      Left = 9
+      Left = 10
+      Height = 15
+      Top = 176
+      Width = 116
+      Caption = 'Built-in gradient steps'
+      Enabled = False
+      ParentColor = False
+    end
+    object EdGradientSteps: TSpinEdit
+      Left = 10
       Height = 23
-      Top = 581
+      Top = 196
       Width = 59
       Alignment = taRightJustify
+      Enabled = False
+      MaxValue = 10
       MinValue = 1
-      OnChange = EdColCountChange
+      OnChange = EdGradientStepsChange
       TabOrder = 7
-      Value = 8
+      Value = 3
     end
-    object Label2: TLabel
+    object LblPickMode2: TLabel
-      Left = 9
+      Left = 10
       Height = 15
-      Top = 561
+      Top = 124
-      Width = 48
+      Width = 83
-      Caption = 'Columns'
+      Caption = 'Built-in palettes'
       ParentColor = False
     end
+    object CbBuiltinPalettes: TComboBox
+      Left = 10
+      Height = 23
+      Hint = 'Defines when the picked color is determined and when the OnPickColor event is generated:'#13#10#13#10'pmDefault: '#13#10'  Color selection at mouse-down, OnPickColor event at mouse-up if at same location'#13#10#13#10'pmImmediate:'#13#10'  Color selection and OnPickColor event at mouse-down'#13#10#13#10'pmContinuous:'#13#10'  Color selection and OnPickColor event while mouse is down'
+      Top = 144
+      Width = 137
+      ItemHeight = 15
+      ItemIndex = 0
+      Items.Strings = (
+        'Standard palette'
+        'Extended palette'
+        'System palette'
+        'Std + system palette'
+        'Ext + system palette'
+        'Gradient palette'
+        'Websafe palette'
+        'Websafe palette #2'
+      )
+      OnSelect = CbBuiltinPalettesSelect
+      Style = csDropDownList
+      TabOrder = 8
+      Text = 'Standard palette'
+    end
+  end
+  object Bevel1: TBevel
+    Left = 160
+    Height = 519
+    Top = 8
+    Width = 3
+    Align = alLeft
+    BorderSpacing.Top = 8
+    BorderSpacing.Bottom = 8
+    Shape = bsLeftLine
+  end
+  object Panel2: TPanel
+    Left = 465
+    Height = 535
+    Top = 0
+    Width = 160
+    Align = alRight
+    BevelOuter = bvNone
+    ClientHeight = 535
+    ClientWidth = 160
+    TabOrder = 1
+    object Label3: TLabel
+      Left = 10
+      Height = 15
+      Top = 183
+      Width = 68
+      Caption = 'Border width'
+      ParentColor = False
+    end
+    object EdBorderWidth: TSpinEdit
+      Left = 10
+      Height = 23
+      Top = 203
+      Width = 58
+      Alignment = taRightJustify
+      MaxValue = 16
+      OnChange = EdBorderWidthChange
+      TabOrder = 0
+      Value = 1
+    end
+    object Label4: TLabel
+      Left = 93
+      Height = 15
+      Top = 239
+      Width = 40
+      Caption = 'Btn size'
+      ParentColor = False
+    end
+    object EdBoxSize: TSpinEdit
+      Left = 93
+      Height = 23
+      Top = 259
+      Width = 54
+      Alignment = taRightJustify
+      MinValue = 1
+      OnChange = EdBoxSizeChange
+      TabOrder = 1
+      Value = 16
+    end
+    object LblPickMode1: TLabel
+      Left = 10
+      Height = 15
+      Top = 129
+      Width = 68
+      Caption = 'Border color:'
+      ParentColor = False
+    end
+    object CbBorderColor: TColorBox
+      Left = 10
+      Height = 22
+      Top = 149
+      Width = 137
+      NoneColorColor = clWindow
+      Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbIncludeNone]
+      ItemHeight = 16
+      OnSelect = CbBorderColorSelect
+      TabOrder = 2
+    end
     object CbPickMode: TComboBox
       Left = 10
       Height = 23
       Hint = 'Defines when the picked color is determined and when the OnPickColor event is generated:'#13#10#13#10'pmDefault: '#13#10'  Color selection at mouse-down, OnPickColor event at mouse-up if at same location'#13#10#13#10'pmImmediate:'#13#10'  Color selection and OnPickColor event at mouse-down'#13#10#13#10'pmContinuous:'#13#10'  Color selection and OnPickColor event while mouse is down'
-      Top = 355
+      Top = 33
       Width = 137
       ItemHeight = 15
       ItemIndex = 0
@@ -149,13 +247,13 @@ object MainForm: TMainForm
       )
       OnSelect = CbPickModeSelect
       Style = csDropDownList
-      TabOrder = 8
+      TabOrder = 3
       Text = 'default'
     end
     object LblPickMode: TLabel
       Left = 10
       Height = 15
-      Top = 335
+      Top = 13
       Width = 56
       Caption = 'Pick mode'
       ParentColor = False
@@ -163,91 +261,87 @@ object MainForm: TMainForm
     object CbShowSelection: TCheckBox
       Left = 10
       Height = 19
-      Top = 395
+      Top = 73
       Width = 99
       Caption = 'Show selection'
       OnChange = CbShowSelectionChange
-      TabOrder = 9
+      TabOrder = 4
     end
     object CbShowColorHints: TCheckBox
       Left = 10
       Height = 19
-      Top = 416
+      Top = 94
       Width = 108
       Caption = 'Show color hints'
       Checked = True
       OnChange = CbShowColorHintsChange
       State = cbChecked
-      TabOrder = 10
+      TabOrder = 5
     end
-    object LblPickMode1: TLabel
+    object EdColCount: TSpinEdit
-      Left = 10
+      Left = 9
-      Height = 15
-      Top = 451
-      Width = 68
-      Caption = 'Border color:'
-      ParentColor = False
-    end
-    object CbBorderColor: TColorBox
-      Left = 10
-      Height = 22
-      Top = 471
-      Width = 137
-      NoneColorColor = clWindow
-      Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbIncludeNone]
-      ItemHeight = 16
-      OnSelect = CbBorderColorSelect
-      TabOrder = 11
-    end
-    object Label3: TLabel
-      Left = 10
-      Height = 15
-      Top = 505
-      Width = 68
-      Caption = 'Border width'
-      ParentColor = False
-    end
-    object EdBorderWidth: TSpinEdit
-      Left = 10
       Height = 23
-      Top = 525
+      Top = 259
-      Width = 58
+      Width = 59
-      Alignment = taRightJustify
-      MaxValue = 16
-      OnChange = EdBorderWidthChange
-      TabOrder = 12
-      Value = 1
-    end
-    object Label4: TLabel
-      Left = 93
-      Height = 15
-      Top = 561
-      Width = 40
-      Caption = 'Btn size'
-      ParentColor = False
-    end
-    object EdBoxSize: TSpinEdit
-      Left = 93
-      Height = 23
-      Top = 581
-      Width = 54
       Alignment = taRightJustify
       MinValue = 1
-      OnChange = EdBoxSizeChange
+      OnChange = EdColCountChange
-      TabOrder = 13
+      TabOrder = 6
-      Value = 16
+      Value = 8
+    end
+    object Label2: TLabel
+      Left = 9
+      Height = 15
+      Top = 239
+      Width = 48
+      Caption = 'Columns'
+      ParentColor = False
     end
   end
-  object Bevel1: TBevel
+  object Bevel2: TBevel
-    Left = 160
+    Left = 462
-    Height = 606
+    Height = 519
     Top = 8
     Width = 3
-    Align = alLeft
+    Align = alRight
     BorderSpacing.Top = 8
     BorderSpacing.Bottom = 8
     Shape = bsLeftLine
   end
+  object ScrollBox1: TScrollBox
+    Left = 168
+    Height = 519
+    Top = 8
+    Width = 287
+    HorzScrollBar.Increment = 14
+    HorzScrollBar.Page = 145
+    HorzScrollBar.Smooth = True
+    HorzScrollBar.Tracking = True
+    VertScrollBar.Increment = 3
+    VertScrollBar.Page = 34
+    VertScrollBar.Smooth = True
+    VertScrollBar.Tracking = True
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    BorderStyle = bsNone
+    ClientHeight = 519
+    ClientWidth = 287
+    TabOrder = 2
+    object ColorPalette: TColorPalette
+      Left = 0
+      Height = 33
+      Hint = 'Click to select a color'
+      Top = 1
+      Width = 145
+      ButtonWidth = 16
+      ButtonHeight = 16
+      ColumnCount = 9
+      GradientSteps = 3
+      PickShift = [ssLeft, ssMiddle]
+      OnSelectColor = ColorPaletteSelectColor
+      PopupMenu = PalettePopupMenu
+      OnDblClick = ColorPaletteDblClick
+    end
+  end
   object ColorDialog: TColorDialog
     Color = clBlack
     CustomColors.Strings = (

components/colorpalette/demo/unit1.pas

@@ -14,6 +14,7 @@ type
 
   TMainForm = class(TForm)
     Bevel1: TBevel;
+    Bevel2: TBevel;
     BtnDeleteColor: TButton;
     BtnLoadDefaultPal1: TButton;
     BtnLoadRndPalette: TButton;
@@ -21,6 +22,7 @@ type
     BtnAddColor: TButton;
     BtnLoadDefaultPal: TButton;
     BtnEditColor: TButton;
+    CbBuiltinPalettes: TComboBox;
     CbShowSelection: TCheckBox;
     CbShowColorHints: TCheckBox;
     CbBorderColor: TColorBox;
@@ -29,25 +31,31 @@ type
     CbPickMode: TComboBox;
     EdBorderWidth: TSpinEdit;
     EdBoxSize: TSpinEdit;
+    EdGradientSteps: TSpinEdit;
     Label3: TLabel;
     Label4: TLabel;
+    LblGradientSteps: TLabel;
     LblPickMode: TLabel;
     EdColCount: TSpinEdit;
     Label2: TLabel;
     LblColorInfo: TLabel;
     LblPickMode1: TLabel;
+    LblPickMode2: TLabel;
     MnuEditPickedColor: TMenuItem;
     MnuDeletePickedColor: TMenuItem;
     PalettePopupMenu: TPopupMenu;
     Panel1: TPanel;
+    Panel2: TPanel;
     SaveDialog: TSaveDialog;
     ColorSample: TShape;
+    ScrollBox1: TScrollBox;
     procedure BtnAddColorClick(Sender: TObject);
     procedure BtnCreateRndPaletteClick(Sender: TObject);
     procedure BtnDeleteColorClick(Sender: TObject);
     procedure BtnEditColorClick(Sender: TObject);
     procedure BtnLoadDefaultPalClick(Sender: TObject);
     procedure BtnLoadRndPaletteClick(Sender: TObject);
+    procedure CbBuiltinPalettesSelect(Sender: TObject);
     procedure CbPickModeSelect(Sender: TObject);
     procedure CbShowColorHintsChange(Sender: TObject);
     procedure CbShowSelectionChange(Sender: TObject);
@@ -57,6 +65,7 @@ type
     procedure EdBorderWidthChange(Sender: TObject);
     procedure EdBoxSizeChange(Sender: TObject);
     procedure EdColCountChange(Sender: TObject);
+    procedure EdGradientStepsChange(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure MnuDeletePickedColorClick(Sender: TObject);
     procedure MnuEditPickedColorClick(Sender: TObject);
@@ -158,6 +167,15 @@ begin
   ColorPalette.BorderColor := CbBorderColor.Selected;
 end;
 
+procedure TMainForm.CbBuiltinPalettesSelect(Sender: TObject);
+begin
+  ColorPalette.PaletteKind := TPaletteKind(CbBuiltinPalettes.ItemIndex);
+  UpdateCaption;
+  EdColCount.Value := ColorPalette.ColumnCount;
+  EdGradientSteps.Enabled := ColorPalette.PaletteKind = pkGradientPalette;
+  LblGradientSteps.Enabled := EdGradientSteps.Enabled;
+end;
+
 procedure TMainForm.CbPickModeSelect(Sender: TObject);
 begin
   ColorPalette.PickMode := TPickMode(CbPickMode.ItemIndex);
@@ -220,6 +238,12 @@ begin
   ColorPalette.ColumnCount := EdColCount.Value;
 end;
 
+procedure TMainForm.EdGradientStepsChange(Sender: TObject);
+begin
+  ColorPalette.GradientSteps := EdGradientSteps.Value;
+  UpdateCaption;
+end;
+
 procedure TMainForm.EditCurColor;
 begin
   with ColorDialog do
@@ -240,6 +264,8 @@ end;
 
 procedure TMainForm.FormCreate(Sender: TObject);
 begin
+  EdColCount.Value := ColorPalette.ColumnCount;
+  EdGradientSteps.Value := ColorPalette.GradientSteps;
   ColorSample.Brush.Color := ColorPalette.SelectedColor;
   SetColorInfo('Current', ColorPalette.SelectedColor);
   UpdateCaption;
@@ -247,6 +273,7 @@ begin
   { ColorPalette.PickShift must contain ssRight in order to be able to select
     colors for the context menu. Use object inspector, or use this code:  }
   ColorPalette.PickShift := [ssLeft, ssRight];
+
 end;
 
 procedure TMainForm.MnuDeletePickedColorClick(Sender: TObject);