diff --git a/components/colorpalette/colorpalette.pas b/components/colorpalette/colorpalette.pas
index c0ca10a2a..b9977f493 100644
--- a/components/colorpalette/colorpalette.pas
+++ b/components/colorpalette/colorpalette.pas
@@ -52,7 +52,7 @@ uses
type
- TColorMouseEvent = procedure (Sender: TObject; AColor: TColor; Shift: TShiftState) of Object;
+ TColorMouseEvent = procedure (Sender: TObject; AColor: TColor; Shift: TShiftState) of object;
{ TCustomColorPalette }
@@ -72,14 +72,15 @@ type
procedure SetButtonWidth(const AValue: Integer);
procedure SetColors(Index: Integer; const AValue: TColor);
procedure SetCols(AValue: Integer);
- procedure UpdateSize;
protected
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
procedure MouseMove(Shift:TShiftState; X, Y:Integer); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
procedure ColorPick(AColor: TColor; Shift: TShiftState); dynamic;
procedure ColorMouseMove(AColor: TColor; Shift: TShiftState); dynamic;
- procedure DoAddColor(AColor: TColor);
+ procedure DoAddColor(AColor: TColor); virtual;
+ procedure DoDeleteColor(AIndex: Integer); virtual;
+ procedure UpdateSize; virtual;
public
PickedColor: TColor;
PickShift: TShiftState;
@@ -302,16 +303,21 @@ begin
Invalidate;
end;
+procedure TCustomColorPalette.DeleteColor(AIndex: Integer);
+begin
+ DoDeleteColor(AIndex);
+ UpdateSize;
+ Invalidate;
+end;
+
procedure TCustomColorPalette.DoAddColor(AColor: TColor);
begin
FColors.Add(Pointer(AColor));
end;
-procedure TCustomColorPalette.DeleteColor(AIndex: Integer);
+procedure TCustomColorPalette.DoDeleteColor(AIndex: Integer);
begin
FColors.Delete(AIndex);
- UpdateSize;
- Invalidate;
end;
procedure TCustomColorPalette.Paint;
diff --git a/components/colorpalette/demo/project1.lpi b/components/colorpalette/demo/project1.lpi
index 42a8cd9bc..f830ce9c1 100644
--- a/components/colorpalette/demo/project1.lpi
+++ b/components/colorpalette/demo/project1.lpi
@@ -9,7 +9,6 @@
-
@@ -44,7 +43,7 @@
-
+
@@ -61,7 +60,16 @@
+
+
+
+
+
+
+
+
+
diff --git a/components/colorpalette/demo/project1.lpr b/components/colorpalette/demo/project1.lpr
index 11c56ab39..6b4af373b 100644
--- a/components/colorpalette/demo/project1.lpr
+++ b/components/colorpalette/demo/project1.lpr
@@ -15,7 +15,7 @@ uses
begin
RequireDerivedFormResource:=True;
Application.Initialize;
- Application.CreateForm(TForm1, Form1);
+ Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.
diff --git a/components/colorpalette/demo/unit1.lfm b/components/colorpalette/demo/unit1.lfm
index 7d96d90e1..c6d227132 100644
--- a/components/colorpalette/demo/unit1.lfm
+++ b/components/colorpalette/demo/unit1.lfm
@@ -1,103 +1,157 @@
-object Form1: TForm1
- Left = 290
+object MainForm: TMainForm
+ Left = 522
Height = 502
- Top = 157
- Width = 331
- Caption = 'Form1'
+ Top = 211
+ Width = 455
+ Caption = 'MainForm'
ClientHeight = 502
- ClientWidth = 331
+ ClientWidth = 455
+ OnCreate = FormCreate
+ ShowHint = True
LCLVersion = '1.5'
- object ColorPalette1: TColorPalette
- Left = 22
+ object ColorPalette: TColorPalette
+ Left = 176
Height = 33
- Top = 19
+ Top = 15
Width = 129
ButtonWidth = 16
ButtonHeight = 16
ColumnCount = 8
- OnColorPick = ColorPalette1ColorPick
+ PopupMenu = PalettePopupMenu
+ OnColorPick = ColorPaletteColorPick
+ OnMouseDown = ColorPaletteMouseDown
end
- object BtnLoadRndPalette: TButton
- Left = 176
- Height = 25
- Top = 280
- Width = 139
- Caption = 'Load random palette'
- Enabled = False
- OnClick = BtnLoadRndPaletteClick
+ object Panel1: TPanel
+ Left = 0
+ Height = 502
+ Top = 0
+ Width = 160
+ Align = alLeft
+ BevelOuter = bvNone
+ ClientHeight = 502
+ ClientWidth = 160
TabOrder = 0
+ object curColor: TShape
+ Left = 10
+ Height = 29
+ Top = 13
+ Width = 69
+ end
+ object LblInfo: TLabel
+ Left = 12
+ Height = 65
+ Top = 45
+ Width = 135
+ AutoSize = False
+ Caption = 'LblInfo'
+ Font.Color = clGreen
+ ParentColor = False
+ ParentFont = False
+ WordWrap = True
+ end
+ object BtnEditColor: TButton
+ Left = 91
+ Height = 19
+ Hint = 'Edit current color'
+ Top = 13
+ Width = 56
+ Caption = 'Edit'
+ OnClick = BtnEditColorClick
+ TabOrder = 0
+ end
+ object BtnLoadRndPalette: TButton
+ Left = 10
+ Height = 25
+ Top = 188
+ Width = 137
+ Caption = 'Load random palette'
+ Enabled = False
+ OnClick = BtnLoadRndPaletteClick
+ TabOrder = 1
+ end
+ object BtnCreateRndPalette: TButton
+ Left = 10
+ Height = 25
+ Top = 161
+ Width = 137
+ Caption = 'Create random palette'
+ OnClick = BtnCreateRndPaletteClick
+ TabOrder = 2
+ end
+ object BtnAddColor: TButton
+ Left = 10
+ Height = 25
+ Top = 282
+ Width = 137
+ Caption = 'Add color...'
+ OnClick = BtnAddColorClick
+ TabOrder = 3
+ end
+ object BtnLoadDefaultPal: TButton
+ Left = 10
+ Height = 25
+ Top = 121
+ Width = 137
+ Caption = 'Load Default.pal'
+ OnClick = BtnLoadDefaultPalClick
+ TabOrder = 4
+ end
+ object BtnDeleteCurrent: TButton
+ Left = 10
+ Height = 25
+ Top = 314
+ Width = 137
+ Caption = 'Delete color #0'
+ OnClick = BtnDeleteCurrentClick
+ TabOrder = 5
+ end
+ object BtnLoadDefaultPal1: TButton
+ Left = 10
+ Height = 25
+ Top = 227
+ Width = 137
+ Caption = 'Save palette...'
+ OnClick = BtnLoadDefaultPal1Click
+ TabOrder = 6
+ end
+ object LblPaletteSize: TLabel
+ Left = 10
+ Height = 15
+ Top = 466
+ Width = 72
+ Caption = 'LblPaletteSize'
+ ParentColor = False
+ end
+ object EdColCount: TSpinEdit
+ Left = 12
+ Height = 23
+ Top = 432
+ Width = 66
+ MinValue = 1
+ OnChange = EdColCountChange
+ TabOrder = 7
+ Value = 8
+ end
+ object Label2: TLabel
+ Left = 10
+ Height = 15
+ Top = 411
+ Width = 80
+ Caption = 'Column count:'
+ ParentColor = False
+ end
end
- object BtnCreateRndPalette: TButton
- Left = 176
- Height = 25
- Top = 248
- Width = 139
- Caption = 'Create random palette'
- OnClick = BtnCreateRndPaletteClick
- TabOrder = 1
+ object Bevel1: TBevel
+ Left = 160
+ Height = 486
+ Top = 8
+ Width = 3
+ Align = alLeft
+ BorderSpacing.Top = 8
+ BorderSpacing.Bottom = 8
+ Shape = bsLeftLine
end
- object BtnAddColor: TButton
- Left = 176
- Height = 25
- Top = 336
- Width = 139
- Caption = 'Add color...'
- OnClick = BtnAddColorClick
- TabOrder = 2
- end
- object BtnLoadDefaultPal: TButton
- Left = 176
- Height = 25
- Top = 200
- Width = 139
- Caption = 'Load Default.pal'
- OnClick = BtnLoadDefaultPalClick
- TabOrder = 3
- end
- object Label1: TLabel
- Left = 176
- Height = 15
- Top = 472
- Width = 34
- Caption = 'Label1'
- ParentColor = False
- end
- object BtnDeleteColor0: TButton
- Left = 176
- Height = 25
- Top = 368
- Width = 139
- Caption = 'Delete color #0'
- OnClick = BtnDeleteColor0Click
- TabOrder = 4
- end
- object EdColCount: TSpinEdit
- Left = 176
- Height = 23
- Top = 437
- Width = 72
- OnChange = EdColCountChange
- TabOrder = 5
- Value = 8
- end
- object Label2: TLabel
- Left = 176
- Height = 15
- Top = 416
- Width = 80
- Caption = 'Column count:'
- ParentColor = False
- end
- object BtnLoadDefaultPal1: TButton
- Left = 176
- Height = 25
- Top = 152
- Width = 139
- Caption = 'Save palette...'
- OnClick = BtnLoadDefaultPal1Click
- TabOrder = 6
- end
- object ColorDialog1: TColorDialog
+ object ColorDialog: TColorDialog
Color = clBlack
CustomColors.Strings = (
'ColorA=000000'
@@ -121,14 +175,26 @@ object Form1: TForm1
'ColorS=F0FBFF'
'ColorT=A4A0A0'
)
- left = 163
- top = 51
+ left = 384
+ top = 76
end
- object SaveDialog1: TSaveDialog
+ object SaveDialog: TSaveDialog
Title = 'Save palette as'
DefaultExt = '.pal'
Filter = 'Palette files (*.pal)|*.pal'
- left = 121
- top = 147
+ left = 384
+ top = 18
+ end
+ object PalettePopupMenu: TPopupMenu
+ left = 384
+ top = 136
+ object MnuEditPickedColor: TMenuItem
+ Caption = 'Edit picked color...'
+ OnClick = MnuEditPickedClick
+ end
+ object MnuDeletePickedColor: TMenuItem
+ Caption = 'Delete picked color'
+ OnClick = MnuDeletePickedColorClick
+ end
end
end
diff --git a/components/colorpalette/demo/unit1.pas b/components/colorpalette/demo/unit1.pas
index 1eefec5c3..50aac815a 100644
--- a/components/colorpalette/demo/unit1.pas
+++ b/components/colorpalette/demo/unit1.pas
@@ -6,96 +6,76 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
- Spin, ColorPalette;
+ Spin, ExtCtrls, Menus, ColorPalette;
type
- { TForm1 }
+ { TMainForm }
- TForm1 = class(TForm)
- BtnDeleteColor0: TButton;
+ TMainForm = class(TForm)
+ Bevel1: TBevel;
+ BtnDeleteCurrent: TButton;
BtnLoadDefaultPal1: TButton;
BtnLoadRndPalette: TButton;
BtnCreateRndPalette: TButton;
BtnAddColor: TButton;
BtnLoadDefaultPal: TButton;
- ColorDialog1: TColorDialog;
- ColorPalette1: TColorPalette;
- Label1: TLabel;
+ BtnEditColor: TButton;
+ ColorDialog: TColorDialog;
+ ColorPalette: TColorPalette;
+ LblPaletteSize: TLabel;
EdColCount: TSpinEdit;
Label2: TLabel;
- SaveDialog1: TSaveDialog;
- procedure BtnDeleteColor0Click(Sender: TObject);
+ LblInfo: TLabel;
+ MnuEditPickedColor: TMenuItem;
+ MnuDeletePickedColor: TMenuItem;
+ PalettePopupMenu: TPopupMenu;
+ Panel1: TPanel;
+ SaveDialog: TSaveDialog;
+ curColor: TShape;
+ procedure BtnDeleteCurrentClick(Sender: TObject);
procedure BtnLoadDefaultPal1Click(Sender: TObject);
- procedure Button1Click(Sender: TObject);
procedure BtnLoadRndPaletteClick(Sender: TObject);
procedure BtnCreateRndPaletteClick(Sender: TObject);
procedure BtnAddColorClick(Sender: TObject);
procedure BtnLoadDefaultPalClick(Sender: TObject);
- procedure ColorPalette1ColorPick(Sender: TObject; AColor: TColor;
+ procedure ColorPaletteColorPick(Sender: TObject; AColor: TColor;
Shift: TShiftState);
+ procedure ColorPaletteMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
procedure EdColCountChange(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure MnuDeletePickedColorClick(Sender: TObject);
+ procedure MnuEditPickedClick(Sender: TObject);
+ procedure BtnEditColorClick(Sender: TObject);
private
{ private declarations }
+ curIndex: integer;
+ procedure EditCurColor;
+ procedure SetLabel(ATitle: string; AColor: TColor);
+ procedure UpdatePalette;
public
{ public declarations }
end;
var
- Form1: TForm1;
+ MainForm: TMainForm;
implementation
{$R *.lfm}
-{ TForm1 }
+{ TMainForm }
-procedure TForm1.ColorPalette1ColorPick(Sender: TObject; AColor: TColor;
- Shift: TShiftState);
+
+procedure TMainForm.BtnAddColorClick(Sender: TObject);
begin
- ShowMessage(Format(
- 'Color %s picked.'+#13+
- ' red = %d'#13+
- ' green = %d'#13+
- ' blue = %d', [ColorToString(AColor), Red(AColor), Green(AColor), Blue(AColor)]));
+ if ColorDialog.Execute then
+ ColorPalette.AddColor(ColorDialog.Color);
+ LblPaletteSize.caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
end;
-procedure TForm1.EdColCountChange(Sender: TObject);
-begin
- ColorPalette1.ColumnCount := EdColCount.Value;
-end;
-
-procedure TForm1.Button1Click(Sender: TObject);
-begin
- ColorPalette1.LoadPalette('palette1.txt');
- Label1.caption := IntToStr(ColorPalette1.ColorCount) + ' colors available';
-end;
-
-procedure TForm1.BtnDeleteColor0Click(Sender: TObject);
-begin
- if ColorPalette1.ColorCount > 0 then
- begin
- ColorPalette1.DeleteColor(0);
- Label1.Caption := IntToStr(ColorPalette1.ColorCount) + ' colors available';
- end;
-end;
-
-procedure TForm1.BtnLoadDefaultPal1Click(Sender: TObject);
-begin
- SaveDialog1.FileName := 'random_palette.pal';
- SaveDialog1.InitialDir := ExtractFileDir(ParamStr(0));
- if SaveDialog1.Execute then
- ColorPalette1.SavePalette(SaveDialog1.FileName);
-end;
-
-procedure TForm1.BtnLoadRndPaletteClick(Sender: TObject);
-begin
- ColorPalette1.LoadPalette('random_palette.pal');
- Label1.Caption := IntToStr(ColorPalette1.ColorCount) + ' colors available';
- EdColCount.Value := ColorPalette1.ColumnCount;
-end;
-
-procedure TForm1.BtnCreateRndPaletteClick(Sender: TObject);
+procedure TMainForm.BtnCreateRndPaletteClick(Sender: TObject);
const
N = 64;
var
@@ -119,23 +99,137 @@ begin
BtnLoadRndPalette.Enabled := true;
end;
-procedure TForm1.BtnAddColorClick(Sender: TObject);
+procedure TMainForm.BtnDeleteCurrentClick(Sender: TObject);
begin
- if ColorDialog1.Execute then
- ColorPalette1.AddColor(ColorDialog1.Color);
- Label1.caption := IntToStr(ColorPalette1.ColorCount) + ' colors available';
+ with ColorPalette do
+ begin
+ if (curIndex < ColorCount) and (ColorCount > 0) then
+ begin
+ DeleteColor(curIndex);
+ if curIndex = ColorCount then dec(curIndex);
+ curColor.Brush.Color := Colors[curIndex] ;
+ LblPaletteSize.Caption := IntToStr(ColorCount) + ' colors available';
+ SetLabel('Current', ColorPalette.Colors[curIndex]);
+ end;
+ end;
end;
-procedure TForm1.BtnLoadDefaultPalClick(Sender: TObject);
+procedure TMainForm.BtnLoadDefaultPalClick(Sender: TObject);
begin
if not FileExists('..\default.pal') then
begin
ShowMessage('File "default.pal" not found. Copy it from the TColorPalette folder to the current exe folder.');
exit;
end;
- ColorPalette1.LoadPalette('..\default.pal');
- Label1.caption := IntToStr(ColorPalette1.ColorCount) + ' colors available';
- EdColCount.Value := ColorPalette1.ColumnCount;
+ ColorPalette.LoadPalette('..\default.pal');
+ LblPaletteSize.caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
+ EdColCount.Value := ColorPalette.ColumnCount;
+end;
+
+procedure TMainForm.BtnLoadDefaultPal1Click(Sender: TObject);
+begin
+ Showmessage('???');
+ SaveDialog.FileName := 'random_palette.pal';
+ SaveDialog.InitialDir := ExtractFileDir(ParamStr(0));
+ if SaveDialog.Execute then
+ ColorPalette.SavePalette(SaveDialog.FileName);
+end;
+
+procedure TMainForm.BtnLoadRndPaletteClick(Sender: TObject);
+begin
+ ColorPalette.LoadPalette('random_palette.pal');
+ LblPaletteSize.Caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
+ EdColCount.Value := ColorPalette.ColumnCount;
+end;
+
+procedure TMainForm.BtnEditColorClick(Sender: TObject);
+begin
+ if BtnEditColor.caption = 'Edit' then
+ EditCurColor
+ else
+ UpdatePalette;
+end;
+
+procedure TMainForm.ColorPaletteColorPick(Sender: TObject; AColor: TColor;
+ Shift: TShiftState);
+begin
+ curColor.Brush.Color := ColorPalette.PickedColor;
+ SetLabel('PickedColor', ColorPalette.PickedColor);
+end;
+
+procedure TMainForm.ColorPaletteMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+begin
+ with ColorPalette do
+ begin
+ X := X div ButtonWidth;
+ Y := Y div ButtonHeight;
+ curIndex := X + Y * ColumnCount;
+ end;
+ BtnDeleteCurrent.caption := 'Delete color #' + IntToStr(curIndex);
+ Caption := 'CurIndex: ' + IntToStr(curIndex);
+end;
+
+procedure TMainForm.EdColCountChange(Sender: TObject);
+begin
+ ColorPalette.ColumnCount := EdColCount.Value;
+end;
+
+procedure TMainForm.EditCurColor;
+begin
+ with ColorDialog do
+ begin
+ Color := curColor.Brush.color;
+ if Execute then
+ curColor.Brush.Color := Color;
+ end;
+ if curColor.Brush.Color <> ColorPalette.PickedColor then
+ begin
+ BtnEditColor.caption := 'Update';
+ BtnEditColor.hint := 'Update palette';
+ SetLabel('New color', curColor.Brush.Color);
+ end;
+end;
+
+procedure TMainForm.FormCreate(Sender: TObject);
+begin
+ Caption := 'TColorPalette Demo';
+ curIndex := 0;
+ curColor.brush.color := ColorPalette.Colors[0];
+ SetLabel('Current', ColorPalette.Colors[curIndex]);
+ LblPaletteSize.Caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
+end;
+
+procedure TMainForm.MnuDeletePickedColorClick(Sender: TObject);
+begin
+ BtnDeleteCurrentClick(self);
+end;
+
+procedure TMainForm.MnuEditPickedClick(Sender: TObject);
+begin
+ BtnEditColorClick(self);
+end;
+
+procedure TMainForm.SetLabel(ATitle: string; AColor: TColor);
+begin
+ LblInfo.caption := Format(
+ '%s: %s'#13+
+ ' red = %d'#13+
+ ' green = %d'#13+
+ ' blue = %d', [ATitle, ColorToString(AColor), Red(AColor), Green(AColor), Blue(AColor)]
+ );
+end;
+
+procedure TMainForm.UpdatePalette;
+begin
+ ColorPalette.Colors[curIndex] := curColor.Brush.Color;
+ ColorPalette.Refresh;
+ SetLabel('Current', ColorPalette.Colors[curIndex]);
+ with BtnEditColor do
+ begin
+ Caption := 'Edit';
+ Hint := 'Edit current color';
+ end;
end;
end.