ColorPalette: Fix fpc3.1.1/x64 compilation error (issue #28568). Avoid duplicate colors in built-in gradient palette. Modifications in Toolbar demo (not complete yet). Rename property "Vertical" to "Flipped".

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4295 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-08-26 09:15:35 +00:00
parent 7bc0d5fe4f
commit 754d1f376e
5 changed files with 238 additions and 104 deletions

View File

@@ -103,7 +103,7 @@ type
FGradientSteps: Byte; FGradientSteps: Byte;
FUseSpacers: Boolean; FUseSpacers: Boolean;
FMargin: Integer; FMargin: Integer;
FVertical: Boolean; FFlipped: Boolean;
function GetColorCount: Integer; function GetColorCount: Integer;
function GetColors(AIndex: Integer): TColor; function GetColors(AIndex: Integer): TColor;
function GetColorNames(AIndex: Integer): String; function GetColorNames(AIndex: Integer): String;
@@ -122,7 +122,7 @@ type
procedure SetSelectionColor(AValue: TColor); procedure SetSelectionColor(AValue: TColor);
procedure SetSelectionKind(AValue: TPaletteSelectionKind); procedure SetSelectionKind(AValue: TPaletteSelectionKind);
procedure SetUseSpacers(AValue: Boolean); procedure SetUseSpacers(AValue: Boolean);
procedure SetVertical(AValue: Boolean); procedure SetFlipped(AValue: Boolean);
protected protected
procedure BlendWBColor(AColor: TColor; Steps: Integer); procedure BlendWBColor(AColor: TColor; Steps: Integer);
@@ -150,6 +150,7 @@ type
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth; property ButtonWidth: Integer read FButtonWidth write SetButtonWidth;
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight; property ButtonHeight: Integer read FButtonHeight write SetButtonHeight;
property ColumnCount: Integer read FCols write SetCols; property ColumnCount: Integer read FCols write SetCols;
property Flipped: Boolean read FFlipped write SetFlipped default false;
property GradientSteps: Byte read FGradientSteps write SetGradientSteps default 3; property GradientSteps: Byte read FGradientSteps write SetGradientSteps default 3;
property PaletteKind: TPaletteKind read FPaletteKind write SetPaletteKind default pkStandardPalette; property PaletteKind: TPaletteKind read FPaletteKind write SetPaletteKind default pkStandardPalette;
property PickMode: TPickMode read FPickMode write FPickMode default pmImmediate; property PickMode: TPickMode read FPickMode write FPickMode default pmImmediate;
@@ -159,7 +160,6 @@ type
property SelectionKind: TPaletteSelectionKind read FSelectionKind write SetSelectionKind default pskNone; property SelectionKind: TPaletteSelectionKind read FSelectionKind write SetSelectionKind default pskNone;
property ShowColorHint: Boolean read FShowColorHint write FShowColorHint default true; property ShowColorHint: Boolean read FShowColorHint write FShowColorHint default true;
property UseSpacers: Boolean read FUseSpacers write SetUseSpacers default true; property UseSpacers: Boolean read FUseSpacers write SetUseSpacers default true;
property Vertical: Boolean read FVertical write SetVertical default false;
property OnGetHintText: TColorPaletteHintEvent read FOnGetHintText write FOnGetHintText; property OnGetHintText: TColorPaletteHintEvent read FOnGetHintText write FOnGetHintText;
public public
@@ -198,6 +198,7 @@ type
property ButtonHeight; property ButtonHeight;
property ButtonWidth; property ButtonWidth;
property ColumnCount; property ColumnCount;
property Flipped;
property GradientSteps; property GradientSteps;
property PaletteKind; property PaletteKind;
property PickMode; property PickMode;
@@ -207,7 +208,6 @@ type
property SelectionKind; property SelectionKind;
property ShowColorHint; property ShowColorHint;
property UseSpacers; property UseSpacers;
property Vertical;
property OnColorMouseMove; property OnColorMouseMove;
property OnColorPick; property OnColorPick;
@@ -351,7 +351,7 @@ end;
procedure TCustomColorPalette.DoAddColor(AColor: TColor; AColorName: String = ''); procedure TCustomColorPalette.DoAddColor(AColor: TColor; AColorName: String = '');
begin begin
FColors.AddObject(AColorName, TObject(AColor)); FColors.AddObject(AColorName, TObject(PtrInt(AColor)));
end; end;
procedure TCustomColorPalette.DoColorPick(AColor: TColor; AShift: TShiftState); procedure TCustomColorPalette.DoColorPick(AColor: TColor; AShift: TShiftState);
@@ -370,7 +370,7 @@ end;
procedure TCustomColorPalette.DoInsertColor(AIndex: Integer; AColor: TColor; procedure TCustomColorPalette.DoInsertColor(AIndex: Integer; AColor: TColor;
AColorName: String = ''); AColorName: String = '');
begin begin
FColors.InsertObject(AIndex, AColorName, TObject(AColor)); FColors.InsertObject(AIndex, AColorName, TObject(PtrInt(AColor)));
end; end;
procedure TCustomColorPalette.DoSelectColor(AColor: TColor); procedure TCustomColorPalette.DoSelectColor(AColor: TColor);
@@ -438,12 +438,12 @@ begin
begin begin
dec(W); dec(W);
dec(H); dec(H);
if FVertical then if FFlipped then
Result := Y div H + X div W * FCols else Result := Y div H + X div W * FCols else
Result := X div W + Y div H * FCols; Result := X div W + Y div H * FCols;
end else end else
begin begin
if FVertical then if FFlipped then
begin begin
Result := Y div H + X div W * FCols; Result := Y div H + X div W * FCols;
// Do not consider the space between the buttons // Do not consider the space between the buttons
@@ -755,7 +755,7 @@ begin
// Paint color boxes // Paint color boxes
X := FMargin; X := FMargin;
Y := FMargin; Y := FMargin;
max := IfThen(FVertical, Height, Width) - FMargin; max := IfThen(FFlipped, Height, Width) - FMargin;
if (FButtonDistance = 0) and (FButtonBordercolor <> clNone) then if (FButtonDistance = 0) and (FButtonBordercolor <> clNone) then
dec(max); dec(max);
@@ -764,7 +764,7 @@ begin
if I = FSelectedIndex then // Selected rect of box with selected color if I = FSelectedIndex then // Selected rect of box with selected color
Rsel := Bounds(X, Y, FButtonWidth, FButtonHeight); Rsel := Bounds(X, Y, FButtonWidth, FButtonHeight);
PaintBox(X, Y, X + FButtonWidth, Y + FButtonHeight, GetColors(I)); PaintBox(X, Y, X + FButtonWidth, Y + FButtonHeight, GetColors(I));
if FVertical then if FFlipped then
begin begin
inc(Y, GetCellHeight); inc(Y, GetCellHeight);
if (FButtonDistance = 0) and (FButtonBorderColor <> clNone) then dec(Y); if (FButtonDistance = 0) and (FButtonBorderColor <> clNone) then dec(Y);
@@ -886,7 +886,7 @@ end;
procedure TCustomColorPalette.SetColors(AIndex: Integer; const AValue: TColor); procedure TCustomColorPalette.SetColors(AIndex: Integer; const AValue: TColor);
begin begin
FColors.Objects[AIndex] := TObject(AValue); FColors.Objects[AIndex] := TObject(PtrInt(AValue));
Invalidate; Invalidate;
end; end;
@@ -899,6 +899,14 @@ begin
Invalidate; Invalidate;
end; end;
procedure TCustomColorPalette.SetFlipped(AValue: Boolean);
begin
if FFlipped = AValue then exit;
FFlipped := AValue;
UpdateSize;
Invalidate;
end;
procedure TCustomColorPalette.SetGradientSteps(AValue: Byte); procedure TCustomColorPalette.SetGradientSteps(AValue: Byte);
begin begin
if FGradientSteps = AValue then if FGradientSteps = AValue then
@@ -911,14 +919,6 @@ begin
end; end;
end; end;
procedure TCustomColorPalette.SetVertical(AValue: Boolean);
begin
if FVertical = AValue then exit;
FVertical := AValue;
UpdateSize;
Invalidate;
end;
procedure TCustomColorPalette.SetPaletteKind(AValue: TPaletteKind); procedure TCustomColorPalette.SetPaletteKind(AValue: TPaletteKind);
const const
STEPS: array[0..4] of byte = (0, 64, 128, 192, 255); STEPS: array[0..4] of byte = (0, 64, 128, 192, 255);
@@ -1004,12 +1004,12 @@ begin
if FPaletteKind = pkGradientPalette then if FPaletteKind = pkGradientPalette then
begin begin
if FGradientSteps = 0 then n := 1 else n := FGradientSteps; if FGradientSteps < 0 then n := 0 else n := FGradientSteps;
for i:= Low(STEPS) to High(STEPS) do BlendWBColor((RGBToColor(255, STEPS[i], 0)), n); for i:= Low(STEPS) to High(STEPS)-1 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:= High(STEPS) downto Low(STEPS)+1 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:= Low(STEPS) to High(STEPS)-1 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:= High(STEPS) downto Low(STEPS)+1 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) to High(STEPS)-1 do BlendWBColor((RGBToColor(STEPS[i], 0, 255)), n);
for i:= Low(STEPS) downto High(STEPS) do BlendWBColor((RGBToColor(0, 255, STEPS[i])), n); for i:= Low(STEPS) downto High(STEPS) do BlendWBColor((RGBToColor(0, 255, STEPS[i])), n);
SetCols(n*2 + 1); SetCols(n*2 + 1);
end; end;
@@ -1387,7 +1387,7 @@ begin
d := -1; // Correct for button frame line width d := -1; // Correct for button frame line width
end; end;
if FVertical then // Rows and columns are interchanged here !!! if FFlipped then // Rows and columns are interchanged here !!!
SetBounds(Left, Top, FRows * dx - d + 2*FMargin, FCols * dy - d + 2*FMargin) SetBounds(Left, Top, FRows * dx - d + 2*FMargin, FCols * dy - d + 2*FMargin)
else else
SetBounds(Left, Top, FCols * dx - d + 2*FMargin, FRows * dy - d + 2*FMargin); SetBounds(Left, Top, FCols * dx - d + 2*FMargin, FRows * dy - d + 2*FMargin);

View File

@@ -404,13 +404,13 @@ object MainForm: TMainForm
OnSelect = CbSelColorSelect OnSelect = CbSelColorSelect
TabOrder = 10 TabOrder = 10
end end
object CbVertical: TCheckBox object CbFlipped: TCheckBox
Left = 10 Left = 10
Height = 19 Height = 19
Top = 465 Top = 465
Width = 59 Width = 59
Caption = 'Vertical' Caption = 'Flipped'
OnChange = CbVerticalChange OnChange = CbFlippedChange
TabOrder = 11 TabOrder = 11
end end
end end

View File

@@ -30,7 +30,7 @@ type
CbButtonBorderColor: TColorBox; CbButtonBorderColor: TColorBox;
CbCustomHintText: TCheckBox; CbCustomHintText: TCheckBox;
CbUseSpacers: TCheckBox; CbUseSpacers: TCheckBox;
CbVertical: TCheckBox; CbFlipped: TCheckBox;
ColorDialog: TColorDialog; ColorDialog: TColorDialog;
ColorPalette: TColorPalette; ColorPalette: TColorPalette;
CbPickMode: TComboBox; CbPickMode: TComboBox;
@@ -75,7 +75,7 @@ type
procedure CbShowColorHintsChange(Sender: TObject); procedure CbShowColorHintsChange(Sender: TObject);
procedure CbButtonBorderColorSelect(Sender: TObject); procedure CbButtonBorderColorSelect(Sender: TObject);
procedure CbUseSpacersChange(Sender: TObject); procedure CbUseSpacersChange(Sender: TObject);
procedure CbVerticalChange(Sender: TObject); procedure CbFlippedChange(Sender: TObject);
procedure ColorPaletteDblClick(Sender: TObject); procedure ColorPaletteDblClick(Sender: TObject);
procedure ColorPaletteGetHintText(Sender: TObject; AColor: TColor; procedure ColorPaletteGetHintText(Sender: TObject; AColor: TColor;
var AText: String); var AText: String);
@@ -245,9 +245,9 @@ begin
ColorPalette.UseSpacers := CbUseSpacers.Checked; ColorPalette.UseSpacers := CbUseSpacers.Checked;
end; end;
procedure TMainForm.CbVerticalChange(Sender: TObject); procedure TMainForm.CbFlippedChange(Sender: TObject);
begin begin
ColorPalette.Vertical := CbVertical.Checked; ColorPalette.Flipped := CbFlipped.Checked;
end; end;
procedure TMainForm.ColorPaletteDblClick(Sender: TObject); procedure TMainForm.ColorPaletteDblClick(Sender: TObject);

View File

@@ -11,37 +11,41 @@ object Form1: TForm1
LCLVersion = '1.5' LCLVersion = '1.5'
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 459 Height = 436
Top = 32 Top = 55
Width = 584 Width = 584
Align = alClient Align = alClient
Anchors = []
AutoSize = True
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 459 ClientHeight = 436
ClientWidth = 584 ClientWidth = 584
TabOrder = 0 TabOrder = 0
OnPaint = Panel1Paint
object Shape1: TShape object Shape1: TShape
Left = 56 Left = 56
Height = 120 Height = 120
Top = 64 Top = 40
Width = 146 Width = 146
Anchors = []
BorderSpacing.Around = 8 BorderSpacing.Around = 8
Brush.Style = bsClear Brush.Style = bsClear
end end
object Shape2: TShape object Shape2: TShape
Left = 216 Left = 216
Height = 120 Height = 120
Top = 64 Top = 40
Width = 146 Width = 146
Anchors = []
BorderSpacing.Around = 8 BorderSpacing.Around = 8
end end
object Label1: TLabel object Label1: TLabel
Left = 56 Left = 56
Height = 56 Height = 56
Top = 192 Top = 176
Width = 146 Width = 146
Anchors = []
AutoSize = False AutoSize = False
Caption = 'Selected color:' Caption = 'Gradient start'#13#10#13#10'(Left click)'
Font.Color = clWhite Font.Color = clWhite
ParentColor = False ParentColor = False
ParentFont = False ParentFont = False
@@ -49,60 +53,86 @@ object Form1: TForm1
object Label2: TLabel object Label2: TLabel
Left = 216 Left = 216
Height = 56 Height = 56
Top = 192 Top = 176
Width = 146 Width = 146
Anchors = []
AutoSize = False AutoSize = False
Caption = 'Mouse color:' Caption = 'Mouse color:'
Font.Color = clWhite Font.Color = clWhite
ParentColor = False ParentColor = False
ParentFont = False ParentFont = False
end end
object Shape3: TShape
Left = 376
Height = 120
Top = 40
Width = 146
Anchors = []
BorderSpacing.Around = 8
Brush.Style = bsClear
end
object Label3: TLabel
Left = 376
Height = 56
Top = 176
Width = 146
Anchors = []
AutoSize = False
Caption = 'Gradient end'#13#10#13#10'(Right click)'
Font.Color = clWhite
ParentColor = False
ParentFont = False
end
end end
object CoolBar: TCoolBar object CoolBar: TCoolBar
Left = 0 Left = 0
Height = 32 Height = 55
Top = 0 Top = 0
Width = 584 Width = 584
AutoSize = True
Bands = < Bands = <
item item
Control = ToolBar Control = ToolBar
MinWidth = 25 MinHeight = 45
Width = 599 MinWidth = 45
Width = 385
end> end>
GrabStyle = gsGripper GrabStyle = gsGripper
object ToolBar: TToolBar object ToolBar: TToolBar
AnchorSideLeft.Control = CoolBar AnchorSideLeft.Control = CoolBar
AnchorSideTop.Control = CoolBar AnchorSideTop.Control = CoolBar
Left = 24 Left = 24
Height = 22 Height = 45
Top = 5 Top = 5
Width = 353 Width = 356
Align = alNone Align = alNone
AutoSize = True AutoSize = True
BorderSpacing.Left = 22 BorderSpacing.Left = 22
BorderSpacing.Top = 3 BorderSpacing.Top = 3
ButtonWidth = 22 ButtonHeight = 45
ButtonWidth = 45
Caption = 'ToolBar' Caption = 'ToolBar'
EdgeBorders = [] EdgeBorders = []
Images = ImageList1 Images = ImageList
List = True ShowCaptions = True
TabOrder = 0 TabOrder = 0
Transparent = True Transparent = True
Wrapable = False
object ColorPalette: TColorPalette object ColorPalette: TColorPalette
Left = 30 Left = 53
Height = 22 Height = 45
Top = 0 Top = 0
Width = 323 Width = 303
ButtonHeight = 21 ButtonHeight = 15
ButtonWidth = 21 ButtonWidth = 16
ColumnCount = 16 ColumnCount = 3
Flipped = True
GradientSteps = 1
PaletteKind = pkGradientPalette
PickShift = [ssLeft, ssRight]
SelectionColor = clWhite SelectionColor = clWhite
SelectionKind = pskThinInverted SelectionKind = pskThickInverted
ShowColorHint = False ShowColorHint = False
UseSpacers = False UseSpacers = False
OnSelectColor = ColorPaletteSelectColor OnColorPick = ColorPaletteColorPick
ParentColor = False ParentColor = False
OnMouseMove = ColorPaletteMouseMove OnMouseMove = ColorPaletteMouseMove
end end
@@ -111,57 +141,101 @@ object Form1: TForm1
Hint = 'Change orientation of toolbar' Hint = 'Change orientation of toolbar'
Top = 0 Top = 0
AllowAllUp = True AllowAllUp = True
Caption = 'TbChangeOrientation' Caption = 'Flip'
Grouped = True Grouped = True
ImageIndex = 0 ImageIndex = 0
OnClick = TbChangeOrientationClick OnClick = TbChangeOrientationClick
Style = tbsCheck Style = tbsCheck
Wrap = True
end end
object TbSpacer: TToolButton object TbSpacer: TToolButton
Left = 23 Left = 46
Height = 22 Height = 45
Top = 0 Top = 0
Width = 7 Width = 7
Caption = 'TbSpacer' Caption = 'TbSpacer'
ShowCaption = False
Style = tbsDivider Style = tbsDivider
end end
end end
end end
object ImageList1: TImageList object ImageList: TImageList
left = 432 Height = 24
top = 168 Width = 24
left = 433
top = 232
Bitmap = { Bitmap = {
4C69010000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 4C69010000001800000018000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C4792300CA7F2800D0852C00D58A
3000DA8F3400DF943800E3983B00E79C3E00EA9F4066EA9F4099E99E3F00E99E
3F00E99E3F00E1963900D98E3300DA8F3400DB903500DD923600DF943800E79C
3E00E79C3E00E79C3E00FFFFFF00FFFFFF00C4792300CA7F2800D0852C00D58A
3000DA8F3400DF943800E3983B00E79C3E66E79C3ECCE79C3ECCE79C3E00E79C
3E00E4993B00D98E3300D98E3300DA8F3400DB903500DD923600DF943800E499
3C00E69B3D1DE79C3E99FFFFFF00FFFFFF00C4792300CA7F2800D0852C00D58A
3000DA8F3400DF943800E3983B66E3983BCCFFE599FFE3983BCCE3983B00E196
3900D98E3300D98E3300D98E3300DA8F3400DB903500DD923600DF943800E196
3910E3983B8FE3983BCCFFFFFF00FFFFFF00C4792300CA7F2800D0852C00D58A
3000DA8F3400DF943866DF9438CCFFE599FFFFDF93FFDF9438CCDF943800D98E
3300D98E3300D98E3300D98E3300DA8F3400DB903500DD92360BDF94384BE198
3CAFF0BC68E6DF9438CBFFFFFF00FFFFFF00C4792300CA7F2800D0852C00D58A
3000DA8F3466DA8F34CCFFE498FFFBCF83FFFCD68AFFDA8F34CCD88D3200D98E
3303D98E330DD98E331ED98E3336DA8F3456DA8F348CDD943ABDE8AD57DEF8D0
81F5FBD78AFBDA8F34BDFFFFFF00FFFFFF00C4792300CA7F2800D0852C00D58A
3066D58A30CCFEE397FFF8C97DFFF6C175FFFAD185FFD58A30CCD58A30CCD68C
32CDD99138D0DC9941D4E1A24CDAE7AF5BE2F2C474F0FAD487FBFBD488FFF8CB
7FFFF2C173F3D58A309EFFFFFF00FFFFFF00C4792300CA7F2800CF842C66D085
2CCCFEE094FFF5C478FFF2BB6FFFF2BB6FFFF8CC80FFFDDC90FFFCDB8FFFFCDB
8FFFFCD98DFFFAD488FFF8CF83FFF7CB7FFFF5C67AFFF3BE72FFF2BB6FFFF3BD
71FFE3A855E3D0852C68FFFFFF00FFFFFF00C4792300C97E2866CA7F28CCFDDE
92FFF3BF73FFF0B569FFF0B569FFF0B569FFF0B569FFF0B569FFF0B569FFF0B5
69FFF0B569FFF0B569FFF0B569FFF0B569FFF0B569FFF0B569FFF0B569FFF0BA
6EFBCE8631C8CB802920FFFFFF00FFFFFF00C3782366C47923CCFCDB8FFFF2BD
71FFEEB266FFEEB266FFEEB266FFEEB266FFEEB266FFECB063FFE4A85AFFDA9E
4EFFD59949FFD19445FFCE9242FFCE9242FFD19445FFD59949FFDEA354FFD697
45E0C4792373C57A2500FFFFFF00FFFFFF00BF752066BE741FCCFBD88CFFEEB2
66FFEEB266FFEEB266FFEEB266FFEBAE5DFFE1A247FFD99A38FFD79835FFD798
35FFD79835FFD79835FFD79835FFD79835FFD79835FFDA9C3CFFD1933CE7BE74
1FA2C176210FC2772200FFFFFF00FFFFFF00BE741F00BA6F1C66B96E1BCCF9D3
87FFEEB266FFEEB162FFEAA942FFE5A128FFE4A025FFE4A025FFE4A025FFE4A0
25FFE4A025FFE4A025FFE4A025FFE5A329FFE4A636FBCD8A2EE0B96E1BA2BC71
1D16C1762100C2772200FFFFFF00FFFFFF00BE741F00B96E1B00B4691766B368
16CCF8CE7CFFF1AB22FFF1A913FFF1A913FFF3AF22FFF4B530FFF3B42FFFF3B4
2DFFF3B32CFFEFAE2BFBE5A42CF3D18D27E3B96F1AC8B3681673B66B180FBC71
1D00C1762100C2772200FFFFFF00FFFFFF00BE741F00B96E1B00B3681600AE63
1366AD6212CCFDC849FFFBB005FFFBB005FFFCBA22FFAD6212CCAD6212CCAD62
12CCAD6212CBAD6212BDAD62129EAD621268AE631320B1661500B66B1800BC71
1D00C1762100C2772200FFFFFF00FFFFFF00BE741F00B96E1B00B3681600AD62
1200A95E0F66A85D0ECCFFC538FFFFB200FFFFBB19FFA85D0ECCAA5F1000AB60
1100AB601100AB601100AB601100AB601100AE631300B1661500B66B1800BC71
1D00C1762100C2772200FFFFFF00FFFFFF00BE741F00B96E1B00B3681600AD62
1200A85D0E00A4590B66A3580ACCFFC12BFFFFB914FFA3580ACCA3580A00A95E
0F00AB601100AB601100AB601100AB601100AE631300B1661500B66B1800BC71
1D00C1762100C2772200FFFFFF00FFFFFF00BE741F00B96E1B00B3681600AD62
1200A85D0E00A3580A009F5408669E5307CCFFBD1FFF9E5307CC9E5307009E53
0700A85D0F00AB601100AB601100AB601100AE631300B1661500B66B1800BC71
1D00C1762100C2772200FFFFFF00FFFFFF00BE741F00B96E1B00B3681600AD62
1200A85D0E00A3580A009E5307009B5005669A4F04CC9A4F04CC9A4F04009A4F
04009A4F0400A75C0E00AB601100AB601100AE631300B1661500B66B1800BC71
1D00C1762100C2772200FFFFFF00FFFFFF00BE741F00B96E1B00B3681600AD62
1200A85D0E00A3580A009E5307009A4F0400984D0266984D0299984D0200984D
0200984D0200984D0200AB601100AB601100AE631300B1661500B66B1800BC71
1D00C1762100C2772200FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00C2772200CA7F2800D2872E00D98E3300E095
3800E0953800DE933700E89D3F00E89D3F00E89D3F00E99E4099E99E40CCE99E
40CCE99E40CCE99E4099FFFFFF00C2772200CA7F2800D2872E00D98E3300E095
3800E0953800DE933700E2973A00E59A3C00E59A3C00E59A3CCCFFDF93FFFFDA
8EFFFFDE92FFE59A3CCCFFFFFF00C2772200CA7F2800D2872E00D98E3300DF94
385CDF943899DE933700DE933700E0953800E0953800E09538CCFDD68AFFFBCB
7FFFFCD589FFE09538CCFFFFFF00C2772200CA7F2800D2872E00D88D335CD98E
33CCD98E33CCD98E3300D0852C00CE832B00D78C3209DA9036CEF9CE82FFF6C2
76FFF9CD81FFD98E33CCFFFFFF00C2772200CA7F2800D1862D5CD2872ECCFDDD
91FFD2872ECCCE832B00CC812900CE832B09D1862D61D99842D9D8A252FFD397
47FFE2AF60FFD2872ECAFFFFFF00C2772200C97E275CCA7F28CCFBD98DFFF4C4
76FFCA7F28CCCA7F28CCCA7F28CCCC822ACED59239D9E4AD4FF9DA9B34FFDA99
33FFE1A849FCCA7F28C1FFFFFF00C176215CC27722CCFAD68AFFEDAD4AFFEDAF
37FFF1B844FFF0B742FFF0B640FFEFB43CFFECAC30FFE9A421FFE8A31FFFE9A4
21FFE1A336F0C277229AFFFFFF00B96E1CCCF9D387FFF3B03BFFF6AC0EFFF6AC
0CFFF6AC0CFFF6AC0CFFF6AC0CFFF6AC0CFFF6AC0CFFF6AC0CFFF6AD0EFFF2AE
20FBC57D20D5BA6F1D42FFFFFF00B267175CB16616CCFFCC4EFFFFB201FFFFB7
11FFFFBC1EFFFFBB1BFFFFBA19FFFFB917FFFFB815FFFAB415FCE9A319F0BF76
18D5B166166EB3681701FFFFFF00B1661600AB60115CAA5F10CCFFC539FFFFBB
1AFFAA5F10CCAA5F10CCAA5F10CCAA5F10CCAA5F10CAAA5F10C1AA5F109AAB60
1142AE631301B3681700FFFFFF00B1661600AA5F1000A4590C5CA3580BCCFFBF
27FFA3580BCCA75C0D00A85D0E00A85D0E00A85D0E00A85D0E00A85D0E00AA5F
1000AE631300B3681700FFFFFF00B1661600AA5F1000A3580B009E53075C9D52
06CC9D5206CC9D520600A55A0C00A85D0E00A85D0E00A85D0E00A85D0E00AA5F
1000AE631300B3681700FFFFFF00B1661600AA5F1000A3580B009D520600994E
035C994E0399994E0300994E0300A85D0E00A85D0E00A85D0E00A85D0E00AA5F
1000AE631300B3681700FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00 FF00FFFFFF00FFFFFF00FFFFFF00
} }

View File

@@ -15,23 +15,28 @@ type
TForm1 = class(TForm) TForm1 = class(TForm)
ColorPalette: TColorPalette; ColorPalette: TColorPalette;
CoolBar: TCoolBar; CoolBar: TCoolBar;
ImageList1: TImageList; ImageList: TImageList;
Label1: TLabel; Label1: TLabel;
Label2: TLabel; Label2: TLabel;
Label3: TLabel;
Panel1: TPanel; Panel1: TPanel;
Shape1: TShape; Shape1: TShape;
Shape2: TShape; Shape2: TShape;
Shape3: TShape;
ToolBar: TToolBar; ToolBar: TToolBar;
TbChangeOrientation: TToolButton; TbChangeOrientation: TToolButton;
TbSpacer: TToolButton; TbSpacer: TToolButton;
procedure ColorPaletteColorPick(Sender: TObject; AColor: TColor;
Shift: TShiftState);
procedure ColorPaletteMouseMove(Sender: TObject; Shift: TShiftState; X, procedure ColorPaletteMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer); Y: Integer);
procedure ColorPaletteSelectColor(Sender: TObject; AColor: TColor);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure Panel1Paint(Sender: TObject); procedure Panel1Paint(Sender: TObject);
procedure TbChangeOrientationClick(Sender: TObject); procedure TbChangeOrientationClick(Sender: TObject);
private private
{ private declarations } { private declarations }
FStartColor: TColor;
FEndColor: TColor;
public public
{ public declarations } { public declarations }
end; end;
@@ -44,8 +49,9 @@ implementation
{$R *.lfm} {$R *.lfm}
{ TForm1 } { TForm1 }
(*
procedure TForm1.ColorPaletteSelectColor(Sender: TObject; AColor: TColor); procedure TForm1.ColorPalettePickColorColor(Sender: TObject; AColor: TColor;
AShift: TShiftState);
begin begin
if ColorPalette.SelectedColor = clNone then if ColorPalette.SelectedColor = clNone then
Shape1.Brush.Style := bsClear Shape1.Brush.Style := bsClear
@@ -57,21 +63,41 @@ begin
Label1.Caption := Format('Selected color:'#13'%s', [ Label1.Caption := Format('Selected color:'#13'%s', [
ColorPalette.ColorNames[ColorPalette.SelectedIndex] ColorPalette.ColorNames[ColorPalette.SelectedIndex]
]); ]);
end;
inc(counter);
if odd(counter) then
FStartColor := Colorpalette.SelectedColor else
FEndColor := ColorPalette.SelectedColor;
Panel1.Invalidate;
end;
*)
procedure TForm1.FormCreate(Sender: TObject); procedure TForm1.FormCreate(Sender: TObject);
begin begin
ColorPalette.InsertColor(0, clNone); // ColorPalette.InsertColor(0, clNone);
ColorPalette.ColumnCount := ColorPalette.ColorCount; //ColorPalette.ColumnCount := 3; //ColorPalette.ColorCount div 3;
// ColorPalette.Vertical := true;
//ColorPalette.ColumnCount := 3;
ColorPalette.SelectedIndex := -1; ColorPalette.SelectedIndex := -1;
colorPalette.SelectedIndex := 0;
Toolbar.BorderSpacing.Left := 0; Toolbar.BorderSpacing.Left := 0;
Toolbar.AutoSize := true; Toolbar.AutoSize := true;
Coolbar.AutoSize := true; Coolbar.AutoSize := true;
ColorPaletteColorPick(self, ColorPalette.SelectedColor, [Classes.ssLeft]);
ColorPaletteColorPick(self, ColorPalette.Colors[ColorPalette.ColorCount-1], [Classes.ssRight]);
Panel1.OnPaint := @Panel1Paint;
end; end;
procedure TForm1.Panel1Paint(Sender: TObject); procedure TForm1.Panel1Paint(Sender: TObject);
begin begin
Panel1.Canvas.GradientFill(Panel1.ClientRect, clSkyBlue, clNavy, gdVertical); // Panel1.Canvas.GradientFill(Panel1.ClientRect, clSkyBlue, clNavy, gdVertical);
Panel1.Canvas.GradientFill(Panel1.ClientRect,
FStartColor,
FEndColor,
gdVertical
);
end; end;
procedure TForm1.TbChangeOrientationClick(Sender: TObject); procedure TForm1.TbChangeOrientationClick(Sender: TObject);
@@ -85,7 +111,7 @@ begin
CoolBar.Vertical := true; CoolBar.Vertical := true;
CoolBar.Align := alLeft; CoolBar.Align := alLeft;
ToolBar.Align := alLeft; ToolBar.Align := alLeft;
ColorPalette.Vertical := true; ColorPalette.Flipped := not ColorPalette.Flipped;
ColorPalette.Top := 9999; ColorPalette.Top := 9999;
end else end else
// Horizontal orientation // Horizontal orientation
@@ -93,7 +119,7 @@ begin
CoolBar.Vertical := false; CoolBar.Vertical := false;
CoolBar.Align := alTop; CoolBar.Align := alTop;
ToolBar.Align := alTop; ToolBar.Align := alTop;
ColorPalette.Vertical := false; ColorPalette.Flipped := not ColorPalette.Flipped;
ColorPalette.Left := 9999; ColorPalette.Left := 9999;
end; end;
CoolBar.AutoSize := true; CoolBar.AutoSize := true;
@@ -108,5 +134,39 @@ begin
]); ]);
end; end;
procedure TForm1.ColorPaletteColorPick(Sender: TObject; AColor: TColor;
Shift: TShiftState);
begin
if (Shift * [Classes.ssLeft] <> []) then
begin
FStartColor := AColor;
if FStartColor = clNone then
Shape1.Brush.Style := bsClear
else begin
Shape1.Brush.Style := bsSolid;
Shape1.Brush.Color := FStartColor;
end;
Label1.Caption := 'Gradient start color:'#13 +
ColorPalette.ColorNames[ColorPalette.MouseIndex] +
#13'(Left click)';
end;
if (Shift * [Classes.ssRight] <> []) then
begin
FEndColor := AColor;
if FEndColor = clNone then
Shape3.Brush.Style := bsClear
else begin
Shape3.Brush.Style := bsSolid;
Shape3.Brush.Color := FEndColor;
end;
Label3.Caption := 'Gradient end color:'#13 +
ColorPalette.ColorNames[ColorPalette.MouseIndex] +
#13'(Right click)';
end;
Panel1.Invalidate;
end;
end. end.