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
2015-08-20 18:59:01 +00:00
parent bae47dcb21
commit 77c582dda8
5 changed files with 340 additions and 166 deletions
--- 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;
--- a/components/colorpalette/demo/project1.lpi
+++ b/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"/>
--- 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.

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