You've already forked lazarus-ccr
ColorPalette: Add new property Vertical (Note: In vertical orientation, "ColumnCount" defines the number of ROWS !!!). New demo ToolbarDemo showing application of ColorPalette in toolbar. Old demo moved to folder demo/GeneralDemo
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4294 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -103,6 +103,7 @@ type
|
||||
FGradientSteps: Byte;
|
||||
FUseSpacers: Boolean;
|
||||
FMargin: Integer;
|
||||
FVertical: Boolean;
|
||||
function GetColorCount: Integer;
|
||||
function GetColors(AIndex: Integer): TColor;
|
||||
function GetColorNames(AIndex: Integer): String;
|
||||
@ -121,6 +122,7 @@ type
|
||||
procedure SetSelectionColor(AValue: TColor);
|
||||
procedure SetSelectionKind(AValue: TPaletteSelectionKind);
|
||||
procedure SetUseSpacers(AValue: Boolean);
|
||||
procedure SetVertical(AValue: Boolean);
|
||||
|
||||
protected
|
||||
procedure BlendWBColor(AColor: TColor; Steps: Integer);
|
||||
@ -129,6 +131,7 @@ type
|
||||
procedure DoAddColor(AColor: TColor; AColorName: String = ''); virtual;
|
||||
procedure DoColorPick(AColor: TColor; AShift: TShiftState); virtual;
|
||||
procedure DoDeleteColor(AIndex: Integer); virtual;
|
||||
procedure DoInsertColor(AIndex: Integer; AColor: TColor; AColorName: String = ''); virtual;
|
||||
procedure DoSelectColor(AColor: TColor); virtual;
|
||||
function GetCellHeight: Integer; inline;
|
||||
function GetCellWidth: Integer; inline;
|
||||
@ -156,6 +159,7 @@ type
|
||||
property SelectionKind: TPaletteSelectionKind read FSelectionKind write SetSelectionKind default pskNone;
|
||||
property ShowColorHint: Boolean read FShowColorHint write FShowColorHint 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;
|
||||
|
||||
public
|
||||
@ -166,6 +170,7 @@ type
|
||||
procedure AddColor(AColor: TColor; AColorName: String = '');
|
||||
procedure ClearColors;
|
||||
procedure DeleteColor(AIndex: Integer);
|
||||
procedure InsertColor(AIndex: Integer; AColor: TColor; AColorName: String = '');
|
||||
procedure LoadPalette(const FileName: String);
|
||||
procedure SavePalette(const FileName: String);
|
||||
|
||||
@ -202,6 +207,7 @@ type
|
||||
property SelectionKind;
|
||||
property ShowColorHint;
|
||||
property UseSpacers;
|
||||
property Vertical;
|
||||
|
||||
property OnColorMouseMove;
|
||||
property OnColorPick;
|
||||
@ -361,6 +367,12 @@ begin
|
||||
FColors.Delete(AIndex);
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.DoInsertColor(AIndex: Integer; AColor: TColor;
|
||||
AColorName: String = '');
|
||||
begin
|
||||
FColors.InsertObject(AIndex, AColorName, TObject(AColor));
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.DoSelectColor(AColor: TColor);
|
||||
begin
|
||||
FSelectedColor := AColor;
|
||||
@ -426,13 +438,24 @@ begin
|
||||
begin
|
||||
dec(W);
|
||||
dec(H);
|
||||
Result := X div W + Y div H * FCols;
|
||||
if FVertical then
|
||||
Result := Y div H + X div W * FCols else
|
||||
Result := X div W + Y div H * FCols;
|
||||
end else
|
||||
begin
|
||||
Result := X div W + Y div H * FCols;
|
||||
// Do not consider the space between the buttons
|
||||
if (X mod W > FButtonWidth) or (Y mod H > FButtonWidth) then
|
||||
Result := -1
|
||||
if FVertical then
|
||||
begin
|
||||
Result := Y div H + X div W * FCols;
|
||||
// Do not consider the space between the buttons
|
||||
if (Y mod H > FButtonWidth) or (X mod W > FButtonWidth) then
|
||||
Result := -1;
|
||||
end else
|
||||
begin
|
||||
Result := X div W + Y div H * FCols;
|
||||
// Do not consider the space between the buttons
|
||||
if (X mod W > FButtonWidth) or (Y mod H > FButtonWidth) then
|
||||
Result := -1
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -468,6 +491,12 @@ begin
|
||||
Result := GetColors(FMouseIndex);
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.InsertColor(AIndex: Integer; AColor: TColor;
|
||||
AColorName: String = '');
|
||||
begin
|
||||
DoInsertColor(AIndex, AColor, AColorName);
|
||||
end;
|
||||
|
||||
function TCustomColorPalette.IsCorrectShift(Shift: TShiftState): Boolean;
|
||||
begin
|
||||
Result := True;
|
||||
@ -712,7 +741,7 @@ procedure TCustomColorPalette.Paint;
|
||||
var
|
||||
I, X, Y: Integer;
|
||||
Rsel: TRect;
|
||||
xmax: Integer;
|
||||
max: Integer;
|
||||
begin
|
||||
// Paint background color
|
||||
if Color <> clNone then begin
|
||||
@ -726,20 +755,35 @@ begin
|
||||
// Paint color boxes
|
||||
X := FMargin;
|
||||
Y := FMargin;
|
||||
xmax := Width - FMargin;
|
||||
if (FButtonDistance = 0) and (FButtonBordercolor <> clNone) then dec(xmax);
|
||||
max := IfThen(FVertical, Height, Width) - FMargin;
|
||||
if (FButtonDistance = 0) and (FButtonBordercolor <> clNone) then
|
||||
dec(max);
|
||||
|
||||
for I := 0 to pred(FColors.Count) do
|
||||
begin
|
||||
if I = FSelectedIndex then // Selected rect of box with selected color
|
||||
Rsel := Bounds(X, Y, FButtonWidth, FButtonHeight);
|
||||
PaintBox(X, Y, X + FButtonWidth, Y + FButtonHeight, GetColors(I));
|
||||
inc(X, GetCellWidth);
|
||||
if (FButtonDistance = 0) and (FButtonBorderColor <> clNone) then dec(X);
|
||||
if X >= xmax then
|
||||
if FVertical then
|
||||
begin
|
||||
inc(Y, GetCellHeight);
|
||||
if (FButtonDistance = 0) and (FButtonBorderColor <> clNone) then dec(Y);
|
||||
X := FMargin;
|
||||
if Y >= max then
|
||||
begin
|
||||
inc(X, GetCellWidth);
|
||||
if (FButtonDistance = 0) and (FButtonBorderColor <> clNone) then dec(X);
|
||||
Y := FMargin;
|
||||
end;
|
||||
end else
|
||||
begin
|
||||
inc(X, GetCellWidth);
|
||||
if (FButtonDistance = 0) and (FButtonBorderColor <> clNone) then dec(X);
|
||||
if X >= max then
|
||||
begin
|
||||
inc(Y, GetCellHeight);
|
||||
if (FButtonDistance = 0) and (FButtonBorderColor <> clNone) then dec(Y);
|
||||
X := FMargin;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -867,6 +911,14 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.SetVertical(AValue: Boolean);
|
||||
begin
|
||||
if FVertical = AValue then exit;
|
||||
FVertical := AValue;
|
||||
UpdateSize;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.SetPaletteKind(AValue: TPaletteKind);
|
||||
const
|
||||
STEPS: array[0..4] of byte = (0, 64, 128, 192, 255);
|
||||
@ -1334,7 +1386,11 @@ begin
|
||||
dec(dy);
|
||||
d := -1; // Correct for button frame line width
|
||||
end;
|
||||
SetBounds(Left, Top, FCols * dx - d + 2*FMargin, FRows * dy - d + 2*FMargin);
|
||||
|
||||
if FVertical then // Rows and columns are interchanged here !!!
|
||||
SetBounds(Left, Top, FRows * dx - d + 2*FMargin, FCols * dy - d + 2*FMargin)
|
||||
else
|
||||
SetBounds(Left, Top, FCols * dx - d + 2*FMargin, FRows * dy - d + 2*FMargin);
|
||||
end;
|
||||
|
||||
|
||||
|
Before Width: | Height: | Size: 134 KiB After Width: | Height: | Size: 134 KiB |
@ -7,7 +7,7 @@ uses
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, Unit1, lazcolorpalette
|
||||
Unit1, Forms, lazcolorpalette
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
65
components/colorpalette/demo/GeneralDemo/random_palette.pal
Normal file
65
components/colorpalette/demo/GeneralDemo/random_palette.pal
Normal file
@ -0,0 +1,65 @@
|
||||
$COLS 16
|
||||
140, 151, 183
|
||||
216, 154, 219
|
||||
139, 216, 108
|
||||
159, 165, 98
|
||||
112, 76, 228
|
||||
14, 246, 69
|
||||
98, 122, 202
|
||||
207, 135, 122
|
||||
145, 100, 236
|
||||
214, 18, 86
|
||||
22, 165, 5
|
||||
94, 213, 245
|
||||
199, 35, 222
|
||||
222, 250, 121
|
||||
204, 205, 118
|
||||
133, 199, 173
|
||||
30, 184, 163
|
||||
148, 36, 137
|
||||
241, 194, 133
|
||||
27, 106, 121
|
||||
67, 47, 198
|
||||
188, 116, 55
|
||||
145, 34, 4
|
||||
82, 158, 38
|
||||
156, 56, 157
|
||||
98, 241, 231
|
||||
174, 115, 92
|
||||
156, 111, 231
|
||||
178, 25, 15
|
||||
248, 170, 167
|
||||
171, 43, 53
|
||||
91, 33, 192
|
||||
80, 155, 93
|
||||
83, 145, 9
|
||||
112, 162, 253
|
||||
245, 26, 167
|
||||
53, 162, 41
|
||||
254, 167, 148
|
||||
64, 106, 119
|
||||
121, 62, 159
|
||||
40, 86, 28
|
||||
172, 168, 81
|
||||
35, 199, 50
|
||||
243, 94, 169
|
||||
210, 3, 24
|
||||
159, 214, 172
|
||||
24, 248, 249
|
||||
224, 119, 130
|
||||
250, 14, 154
|
||||
115, 189, 5
|
||||
10, 113, 72
|
||||
250, 30, 92
|
||||
75, 123, 30
|
||||
176, 81, 225
|
||||
106, 235, 16
|
||||
55, 177, 144
|
||||
145, 221, 67
|
||||
130, 133, 234
|
||||
24, 235, 147
|
||||
21, 237, 71
|
||||
81, 2, 170
|
||||
215, 33, 165
|
||||
183, 215, 74
|
||||
67, 46, 101
|
@ -404,6 +404,15 @@ object MainForm: TMainForm
|
||||
OnSelect = CbSelColorSelect
|
||||
TabOrder = 10
|
||||
end
|
||||
object CbVertical: TCheckBox
|
||||
Left = 10
|
||||
Height = 19
|
||||
Top = 465
|
||||
Width = 59
|
||||
Caption = 'Vertical'
|
||||
OnChange = CbVerticalChange
|
||||
TabOrder = 11
|
||||
end
|
||||
end
|
||||
object Bevel2: TBevel
|
||||
Left = 462
|
@ -30,6 +30,7 @@ type
|
||||
CbButtonBorderColor: TColorBox;
|
||||
CbCustomHintText: TCheckBox;
|
||||
CbUseSpacers: TCheckBox;
|
||||
CbVertical: TCheckBox;
|
||||
ColorDialog: TColorDialog;
|
||||
ColorPalette: TColorPalette;
|
||||
CbPickMode: TComboBox;
|
||||
@ -74,6 +75,7 @@ type
|
||||
procedure CbShowColorHintsChange(Sender: TObject);
|
||||
procedure CbButtonBorderColorSelect(Sender: TObject);
|
||||
procedure CbUseSpacersChange(Sender: TObject);
|
||||
procedure CbVerticalChange(Sender: TObject);
|
||||
procedure ColorPaletteDblClick(Sender: TObject);
|
||||
procedure ColorPaletteGetHintText(Sender: TObject; AColor: TColor;
|
||||
var AText: String);
|
||||
@ -243,6 +245,11 @@ begin
|
||||
ColorPalette.UseSpacers := CbUseSpacers.Checked;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbVerticalChange(Sender: TObject);
|
||||
begin
|
||||
ColorPalette.Vertical := CbVertical.Checked;
|
||||
end;
|
||||
|
||||
procedure TMainForm.ColorPaletteDblClick(Sender: TObject);
|
||||
begin
|
||||
with ColorDialog do
|
BIN
components/colorpalette/demo/ToolbarDemo/project1.ico
Normal file
BIN
components/colorpalette/demo/ToolbarDemo/project1.ico
Normal file
Binary file not shown.
After Width: | Height: | Size: 134 KiB |
85
components/colorpalette/demo/ToolbarDemo/project1.lpi
Normal file
85
components/colorpalette/demo/ToolbarDemo/project1.lpi
Normal file
@ -0,0 +1,85 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="project1"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="LazColorPalette"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="project1"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
21
components/colorpalette/demo/ToolbarDemo/project1.lpr
Normal file
21
components/colorpalette/demo/ToolbarDemo/project1.lpr
Normal file
@ -0,0 +1,21 @@
|
||||
program project1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, Unit1, lazcolorpalette
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:=True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
169
components/colorpalette/demo/ToolbarDemo/unit1.lfm
Normal file
169
components/colorpalette/demo/ToolbarDemo/unit1.lfm
Normal file
@ -0,0 +1,169 @@
|
||||
object Form1: TForm1
|
||||
Left = 290
|
||||
Height = 491
|
||||
Top = 160
|
||||
Width = 584
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 491
|
||||
ClientWidth = 584
|
||||
OnCreate = FormCreate
|
||||
ShowHint = True
|
||||
LCLVersion = '1.5'
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 459
|
||||
Top = 32
|
||||
Width = 584
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 459
|
||||
ClientWidth = 584
|
||||
TabOrder = 0
|
||||
OnPaint = Panel1Paint
|
||||
object Shape1: TShape
|
||||
Left = 56
|
||||
Height = 120
|
||||
Top = 64
|
||||
Width = 146
|
||||
BorderSpacing.Around = 8
|
||||
Brush.Style = bsClear
|
||||
end
|
||||
object Shape2: TShape
|
||||
Left = 216
|
||||
Height = 120
|
||||
Top = 64
|
||||
Width = 146
|
||||
BorderSpacing.Around = 8
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 56
|
||||
Height = 56
|
||||
Top = 192
|
||||
Width = 146
|
||||
AutoSize = False
|
||||
Caption = 'Selected color:'
|
||||
Font.Color = clWhite
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 216
|
||||
Height = 56
|
||||
Top = 192
|
||||
Width = 146
|
||||
AutoSize = False
|
||||
Caption = 'Mouse color:'
|
||||
Font.Color = clWhite
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
end
|
||||
end
|
||||
object CoolBar: TCoolBar
|
||||
Left = 0
|
||||
Height = 32
|
||||
Top = 0
|
||||
Width = 584
|
||||
AutoSize = True
|
||||
Bands = <
|
||||
item
|
||||
Control = ToolBar
|
||||
MinWidth = 25
|
||||
Width = 599
|
||||
end>
|
||||
GrabStyle = gsGripper
|
||||
object ToolBar: TToolBar
|
||||
AnchorSideLeft.Control = CoolBar
|
||||
AnchorSideTop.Control = CoolBar
|
||||
Left = 24
|
||||
Height = 22
|
||||
Top = 5
|
||||
Width = 353
|
||||
Align = alNone
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 22
|
||||
BorderSpacing.Top = 3
|
||||
ButtonWidth = 22
|
||||
Caption = 'ToolBar'
|
||||
EdgeBorders = []
|
||||
Images = ImageList1
|
||||
List = True
|
||||
TabOrder = 0
|
||||
Transparent = True
|
||||
Wrapable = False
|
||||
object ColorPalette: TColorPalette
|
||||
Left = 30
|
||||
Height = 22
|
||||
Top = 0
|
||||
Width = 323
|
||||
ButtonHeight = 21
|
||||
ButtonWidth = 21
|
||||
ColumnCount = 16
|
||||
SelectionColor = clWhite
|
||||
SelectionKind = pskThinInverted
|
||||
ShowColorHint = False
|
||||
UseSpacers = False
|
||||
OnSelectColor = ColorPaletteSelectColor
|
||||
ParentColor = False
|
||||
OnMouseMove = ColorPaletteMouseMove
|
||||
end
|
||||
object TbChangeOrientation: TToolButton
|
||||
Left = 1
|
||||
Hint = 'Change orientation of toolbar'
|
||||
Top = 0
|
||||
AllowAllUp = True
|
||||
Caption = 'TbChangeOrientation'
|
||||
Grouped = True
|
||||
ImageIndex = 0
|
||||
OnClick = TbChangeOrientationClick
|
||||
Style = tbsCheck
|
||||
end
|
||||
object TbSpacer: TToolButton
|
||||
Left = 23
|
||||
Height = 22
|
||||
Top = 0
|
||||
Width = 7
|
||||
Caption = 'TbSpacer'
|
||||
Style = tbsDivider
|
||||
end
|
||||
end
|
||||
end
|
||||
object ImageList1: TImageList
|
||||
left = 432
|
||||
top = 168
|
||||
Bitmap = {
|
||||
4C69010000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
|
||||
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
|
||||
FF00FFFFFF00FFFFFF00FFFFFF00
|
||||
}
|
||||
end
|
||||
end
|
112
components/colorpalette/demo/ToolbarDemo/unit1.pas
Normal file
112
components/colorpalette/demo/ToolbarDemo/unit1.pas
Normal file
@ -0,0 +1,112 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
|
||||
ExtCtrls, StdCtrls, ColorPalette;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
ColorPalette: TColorPalette;
|
||||
CoolBar: TCoolBar;
|
||||
ImageList1: TImageList;
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
Panel1: TPanel;
|
||||
Shape1: TShape;
|
||||
Shape2: TShape;
|
||||
ToolBar: TToolBar;
|
||||
TbChangeOrientation: TToolButton;
|
||||
TbSpacer: TToolButton;
|
||||
procedure ColorPaletteMouseMove(Sender: TObject; Shift: TShiftState; X,
|
||||
Y: Integer);
|
||||
procedure ColorPaletteSelectColor(Sender: TObject; AColor: TColor);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure Panel1Paint(Sender: TObject);
|
||||
procedure TbChangeOrientationClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.ColorPaletteSelectColor(Sender: TObject; AColor: TColor);
|
||||
begin
|
||||
if ColorPalette.SelectedColor = clNone then
|
||||
Shape1.Brush.Style := bsClear
|
||||
else
|
||||
begin
|
||||
Shape1.Brush.Style := bsSolid;
|
||||
Shape1.Brush.Color := ColorPalette.SelectedColor;
|
||||
end;
|
||||
Label1.Caption := Format('Selected color:'#13'%s', [
|
||||
ColorPalette.ColorNames[ColorPalette.SelectedIndex]
|
||||
]);
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
begin
|
||||
ColorPalette.InsertColor(0, clNone);
|
||||
ColorPalette.ColumnCount := ColorPalette.ColorCount;
|
||||
ColorPalette.SelectedIndex := -1;
|
||||
Toolbar.BorderSpacing.Left := 0;
|
||||
Toolbar.AutoSize := true;
|
||||
Coolbar.AutoSize := true;
|
||||
end;
|
||||
|
||||
procedure TForm1.Panel1Paint(Sender: TObject);
|
||||
begin
|
||||
Panel1.Canvas.GradientFill(Panel1.ClientRect, clSkyBlue, clNavy, gdVertical);
|
||||
end;
|
||||
|
||||
procedure TForm1.TbChangeOrientationClick(Sender: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
// Vertical orientation
|
||||
CoolBar.AutoSize := false;
|
||||
if TbChangeOrientation.Down then
|
||||
begin
|
||||
CoolBar.Vertical := true;
|
||||
CoolBar.Align := alLeft;
|
||||
ToolBar.Align := alLeft;
|
||||
ColorPalette.Vertical := true;
|
||||
ColorPalette.Top := 9999;
|
||||
end else
|
||||
// Horizontal orientation
|
||||
begin
|
||||
CoolBar.Vertical := false;
|
||||
CoolBar.Align := alTop;
|
||||
ToolBar.Align := alTop;
|
||||
ColorPalette.Vertical := false;
|
||||
ColorPalette.Left := 9999;
|
||||
end;
|
||||
CoolBar.AutoSize := true;
|
||||
end;
|
||||
|
||||
procedure TForm1.ColorPaletteMouseMove(Sender: TObject; Shift: TShiftState; X,
|
||||
Y: Integer);
|
||||
begin
|
||||
Shape2.Brush.Color := ColorPalette.MouseColor;
|
||||
Label2.Caption := Format('Mouse color:'#13'%s', [
|
||||
ColorPalette.ColorNames[ColorPalette.MouseIndex]
|
||||
]);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
Reference in New Issue
Block a user