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
This commit is contained in:
wp_xxyyzz
2015-08-22 19:20:50 +00:00
parent 3980f70b8b
commit 4474770b78
4 changed files with 569 additions and 161 deletions

View File

@ -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

View File

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

View File

@ -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 = (

View File

@ -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);