TColorPalette: Add method "SavePalette" and property "ColumnCount"

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4275 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2015-08-19 15:08:19 +00:00
parent 94124c6bb7
commit 4ffb9185c2
4 changed files with 103 additions and 8 deletions
--- a/components/colorpalette/colorpalette.pas
+++ b/components/colorpalette/colorpalette.pas
@ -71,6 +71,7 @@ type
    procedure SetButtonHeight(const AValue: Integer);
    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;
@ -89,11 +90,13 @@ type
    procedure AddColor(AColor: TColor);
    procedure DeleteColor(AIndex: Integer);
    procedure LoadPalette(const FileName: String);
+    procedure SavePalette(const FileName: String);
  
    property ButtonWidth: Integer read FButtonWidth write SetButtonWidth;
    property ButtonHeight: Integer read FButtonHeight write SetButtonHeight;
    property Colors[Index: Integer]: TColor read GetColors write SetColors;
    property ColorCount: Integer read GetColorCount;
+    property ColumnCount: Integer read FCols write SetCols;
    
    property OnColorPick: TColorMouseEvent read FOnColorPick write FOnColorPick;
    property OnColorMouseMove: TColorMouseEvent read FOnColorMouseMove write FOnColorMouseMove;
@ -110,6 +113,7 @@ type
    property ButtonWidth;
    property ButtonHeight;
    property Color;
+    property ColumnCount;
    property Constraints;
    property DragCursor;
    property DragKind;
@ -177,6 +181,15 @@ begin
  FColors.Items[Index] := Pointer(AValue);
 end;

+procedure TCustomColorPalette.SetCols(AValue: Integer);
+begin
+  if AValue = FCols then
+    exit;
+  FCols := AValue;
+  UpdateSize;
+  Invalidate;
+end;
+
 procedure TCustomColorPalette.UpdateSize;
 begin
  if (FCols = 0) or (FColors.Count = 0) then FRows := 0
@ -410,6 +423,32 @@ begin
  Invalidate;
 end;

+procedure TCustomColorPalette.SavePalette(const Filename: String);
+var
+  i: Integer;
+  L: TStringList;
+  clr: TColor;
+  r,g,b: Byte;
+begin
+  L := TStringList.Create;
+  try
+    L.Add(Format('$COLS %d', [FCols]));
+    for i:=0 to FColors.Count-1 do begin
+      clr := Colors[i];
+      if clr = clNone then
+        L.Add('$NONE')
+      else begin
+        RedGreenBlue(clr, r,g,b);
+        L.Add(Format('%d, %d, %d',[r, g, b]));
+      end;
+    end;
+    L.SaveToFile(FileName);
+  finally
+    L.Free;
+  end;
+end;
+
+
 initialization
 {$I colorpalette.lrs}

--- a/components/colorpalette/demo/project1.lpi
+++ b/components/colorpalette/demo/project1.lpi
@ -45,6 +45,7 @@
        <Filename Value="unit1.pas"/>
        <IsPartOfProject Value="True"/>
        <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>
        <UnitName Value="Unit1"/>
      </Unit1>
--- a/components/colorpalette/demo/unit1.lfm
+++ b/components/colorpalette/demo/unit1.lfm
@ -14,12 +14,13 @@ object Form1: TForm1
    Width = 129
    ButtonWidth = 16
    ButtonHeight = 16
+    ColumnCount = 8
    OnColorPick = ColorPalette1ColorPick
  end
  object BtnLoadRndPalette: TButton
    Left = 176
    Height = 25
-    Top = 344
+    Top = 280
    Width = 139
    Caption = 'Load random palette'
    Enabled = False
@ -29,7 +30,7 @@ object Form1: TForm1
  object BtnCreateRndPalette: TButton
    Left = 176
    Height = 25
-    Top = 312
+    Top = 248
    Width = 139
    Caption = 'Create random palette'
    OnClick = BtnCreateRndPaletteClick
@ -38,16 +39,16 @@ object Form1: TForm1
  object BtnAddColor: TButton
    Left = 176
    Height = 25
-    Top = 400
+    Top = 336
    Width = 139
-    Caption = 'Add color'
+    Caption = 'Add color...'
    OnClick = BtnAddColorClick
    TabOrder = 2
  end
  object BtnLoadDefaultPal: TButton
    Left = 176
    Height = 25
-    Top = 264
+    Top = 200
    Width = 139
    Caption = 'Load Default.pal'
    OnClick = BtnLoadDefaultPalClick
@ -56,7 +57,7 @@ object Form1: TForm1
  object Label1: TLabel
    Left = 176
    Height = 15
-    Top = 464
+    Top = 472
    Width = 34
    Caption = 'Label1'
    ParentColor = False
@ -64,12 +65,38 @@ object Form1: TForm1
  object BtnDeleteColor0: TButton
    Left = 176
    Height = 25
-    Top = 432
+    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 = (
@ -97,4 +124,11 @@ object Form1: TForm1
    left = 163
    top = 51
  end
+  object SaveDialog1: TSaveDialog
+    Title = 'Save palette as'
+    DefaultExt = '.pal'
+    Filter = 'Palette files (*.pal)|*.pal'
+    left = 121
+    top = 147
+  end
 end
--- a/components/colorpalette/demo/unit1.pas
+++ b/components/colorpalette/demo/unit1.pas
@ -6,7 +6,7 @@ interface

 uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  ColorPalette;
+  Spin, ColorPalette;

 type

@ -14,6 +14,7 @@ type

  TForm1 = class(TForm)
    BtnDeleteColor0: TButton;
+    BtnLoadDefaultPal1: TButton;
    BtnLoadRndPalette: TButton;
    BtnCreateRndPalette: TButton;
    BtnAddColor: TButton;
@ -21,7 +22,11 @@ type
    ColorDialog1: TColorDialog;
    ColorPalette1: TColorPalette;
    Label1: TLabel;
+    EdColCount: TSpinEdit;
+    Label2: TLabel;
+    SaveDialog1: TSaveDialog;
    procedure BtnDeleteColor0Click(Sender: TObject);
+    procedure BtnLoadDefaultPal1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BtnLoadRndPaletteClick(Sender: TObject);
    procedure BtnCreateRndPaletteClick(Sender: TObject);
@ -29,6 +34,7 @@ type
    procedure BtnLoadDefaultPalClick(Sender: TObject);
    procedure ColorPalette1ColorPick(Sender: TObject; AColor: TColor;
      Shift: TShiftState);
+    procedure EdColCountChange(Sender: TObject);
  private
    { private declarations }
  public
@ -54,6 +60,11 @@ begin
    '  blue = %d', [ColorToString(AColor), Red(AColor), Green(AColor), Blue(AColor)]));
 end;

+procedure TForm1.EdColCountChange(Sender: TObject);
+begin
+  ColorPalette1.ColumnCount := EdColCount.Value;
+end;
+
 procedure TForm1.Button1Click(Sender: TObject);
 begin
  ColorPalette1.LoadPalette('palette1.txt');
@ -69,10 +80,19 @@ begin
  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);
@ -115,6 +135,7 @@ begin
  end;
  ColorPalette1.LoadPalette('..\default.pal');
  Label1.caption := IntToStr(ColorPalette1.ColorCount) + ' colors available';
+  EdColCount.Value := ColorPalette1.ColumnCount;
 end;

 end.