ColorPalette: Improved demo by forum user "polpero"

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4278 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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;

components/colorpalette/demo/project1.lpi

@@ -9,7 +9,6 @@
       <Title Value="project1"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
-      <Icon Value="0"/>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>
@@ -44,7 +43,7 @@
       <Unit1>
         <Filename Value="unit1.pas"/>
         <IsPartOfProject Value="True"/>
-        <ComponentName Value="Form1"/>
+        <ComponentName Value="MainForm"/>
         <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="Unit1"/>
@@ -61,7 +60,16 @@
       <IncludeFiles Value="$(ProjOutDir)"/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
+    <CodeGeneration>
+      <SmartLinkUnit Value="True"/>
+      <SmallerCode Value="True"/>
+    </CodeGeneration>
     <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="False"/>
+        <StripSymbols Value="True"/>
+      </Debugging>
+      <LinkSmart Value="True"/>
       <Options>
         <Win32>
           <GraphicApplication Value="True"/>

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.
 

components/colorpalette/demo/unit1.lfm

@@ -1,103 +1,157 @@
-object Form1: TForm1
+object MainForm: TMainForm
-  Left = 290
+  Left = 522
   Height = 502
-  Top = 157
+  Top = 211
-  Width = 331
+  Width = 455
-  Caption = 'Form1'
+  Caption = 'MainForm'
   ClientHeight = 502
-  ClientWidth = 331
+  ClientWidth = 455
+  OnCreate = FormCreate
+  ShowHint = True
   LCLVersion = '1.5'
-  object ColorPalette1: TColorPalette
+  object ColorPalette: TColorPalette
-    Left = 22
+    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
+  object Panel1: TPanel
-    Left = 176
+    Left = 0
-    Height = 25
+    Height = 502
-    Top = 280
+    Top = 0
-    Width = 139
+    Width = 160
-    Caption = 'Load random palette'
+    Align = alLeft
-    Enabled = False
+    BevelOuter = bvNone
-    OnClick = BtnLoadRndPaletteClick
+    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
+  object Bevel1: TBevel
-    Left = 176
+    Left = 160
-    Height = 25
+    Height = 486
-    Top = 248
+    Top = 8
-    Width = 139
+    Width = 3
-    Caption = 'Create random palette'
+    Align = alLeft
-    OnClick = BtnCreateRndPaletteClick
+    BorderSpacing.Top = 8
-    TabOrder = 1
+    BorderSpacing.Bottom = 8
+    Shape = bsLeftLine
   end
-  object BtnAddColor: TButton
+  object ColorDialog: TColorDialog
-    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
     Color = clBlack
     CustomColors.Strings = (
       'ColorA=000000'
@@ -121,14 +175,26 @@ object Form1: TForm1
       'ColorS=F0FBFF'
       'ColorT=A4A0A0'
     )
-    left = 163
+    left = 384
-    top = 51
+    top = 76
   end
-  object SaveDialog1: TSaveDialog
+  object SaveDialog: TSaveDialog
     Title = 'Save palette as'
     DefaultExt = '.pal'
     Filter = 'Palette files (*.pal)|*.pal'
-    left = 121
+    left = 384
-    top = 147
+    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

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)
+  TMainForm = class(TForm)
-    BtnDeleteColor0: TButton;
+    Bevel1: TBevel;
+    BtnDeleteCurrent: TButton;
     BtnLoadDefaultPal1: TButton;
     BtnLoadRndPalette: TButton;
     BtnCreateRndPalette: TButton;
     BtnAddColor: TButton;
     BtnLoadDefaultPal: TButton;
-    ColorDialog1: TColorDialog;
+    BtnEditColor: TButton;
-    ColorPalette1: TColorPalette;
+    ColorDialog: TColorDialog;
-    Label1: TLabel;
+    ColorPalette: TColorPalette;
+    LblPaletteSize: TLabel;
     EdColCount: TSpinEdit;
     Label2: TLabel;
-    SaveDialog1: TSaveDialog;
+    LblInfo: TLabel;
-    procedure BtnDeleteColor0Click(Sender: TObject);
+    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(
+  if ColorDialog.Execute then
-    'Color %s picked.'+#13+
+    ColorPalette.AddColor(ColorDialog.Color);
-    '  red = %d'#13+
+  LblPaletteSize.caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
-    '  green = %d'#13+
-    '  blue = %d', [ColorToString(AColor), Red(AColor), Green(AColor), Blue(AColor)]));
 end;
 
-procedure TForm1.EdColCountChange(Sender: TObject);
+procedure TMainForm.BtnCreateRndPaletteClick(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);
 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
+  with ColorPalette do
-    ColorPalette1.AddColor(ColorDialog1.Color);
+  begin
-  Label1.caption := IntToStr(ColorPalette1.ColorCount) + ' colors available';
+    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');
+  ColorPalette.LoadPalette('..\default.pal');
-  Label1.caption := IntToStr(ColorPalette1.ColorCount) + ' colors available';
+  LblPaletteSize.caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
-  EdColCount.Value := ColorPalette1.ColumnCount;
+  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.