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:
wp_xxyyzz
2015-08-25 17:13:02 +00:00
parent fc29a13688
commit 7bc0d5fe4f
12 changed files with 538 additions and 14 deletions

View File

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

View File

Before

Width:  |  Height:  |  Size: 134 KiB

After

Width:  |  Height:  |  Size: 134 KiB

View File

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

View 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

View File

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

View File

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

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

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

View 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.

View 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

View 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.