diff --git a/components/colorpalette/colorpalette.pas b/components/colorpalette/colorpalette.pas index 39f220e88..1061f1776 100644 --- a/components/colorpalette/colorpalette.pas +++ b/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; - - 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); + SetPaletteKind(pkStandardPalette); 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 AValue then - FSavedHint := Hint - else - Hint := FSavedHint; - FShowColorHint := AValue; + if FGradientSteps = AValue then + exit; + FGradientSteps := AValue; + if FPaletteKind = pkGradientPalette then + begin + 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 + r := copy(hx,1,2); + g := copy(hx,3,2); + 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 FShowSelection = AValue then exit; - FShowSelection := AValue; - Invalidate; + 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 diff --git a/components/colorpalette/demo/project1.lpi b/components/colorpalette/demo/project1.lpi index 3e7a00f72..e32cb0895 100644 --- a/components/colorpalette/demo/project1.lpi +++ b/components/colorpalette/demo/project1.lpi @@ -67,7 +67,6 @@ - diff --git a/components/colorpalette/demo/unit1.lfm b/components/colorpalette/demo/unit1.lfm index 4d066f3b9..9a1331d30 100644 --- a/components/colorpalette/demo/unit1.lfm +++ b/components/colorpalette/demo/unit1.lfm @@ -1,36 +1,22 @@ object MainForm: TMainForm - Left = 358 - Height = 622 - Top = 179 - Width = 455 + Left = 374 + Height = 535 + Top = 222 + Width = 625 Caption = 'MainForm' - ClientHeight = 622 - ClientWidth = 455 + ClientHeight = 535 + 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 - Left = 9 + object LblGradientSteps: TLabel + 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 - Left = 9 + object LblPickMode2: TLabel + Left = 10 Height = 15 - Top = 561 - Width = 48 - Caption = 'Columns' + Top = 124 + Width = 83 + 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 - Left = 10 - 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 + object EdColCount: TSpinEdit + Left = 9 Height = 23 - Top = 525 - Width = 58 - 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 + Top = 259 + Width = 59 Alignment = taRightJustify MinValue = 1 - OnChange = EdBoxSizeChange - TabOrder = 13 - Value = 16 + OnChange = EdColCountChange + TabOrder = 6 + Value = 8 + end + object Label2: TLabel + Left = 9 + Height = 15 + Top = 239 + Width = 48 + Caption = 'Columns' + ParentColor = False end end - object Bevel1: TBevel - Left = 160 - Height = 606 + object Bevel2: TBevel + Left = 462 + 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 = ( diff --git a/components/colorpalette/demo/unit1.pas b/components/colorpalette/demo/unit1.pas index a74ae4d29..0bb5cfa0c 100644 --- a/components/colorpalette/demo/unit1.pas +++ b/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);