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

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}
 

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>

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

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.