Colorpalette: Add some ColorPalette properties to palette file; add TPaletteItems parameter to "LoadFromPalette".

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

components/colorpalette/colorpalette.pas

@@ -22,6 +22,7 @@
     Color palette grid with custom palette support.
     The OnColorPick event is fired when user picks a color.
     The LoadPalette procedure loads custom palette.
+
     Custom palette example:
     
     $COLS 8
@@ -51,7 +52,6 @@ uses
   LCLType;
   
 type
-
   TPickMode = (
     pmDefault,    // Select color at mouse-down, ColorPick event at mouse-up if at same pos
     pmImmediate,  // Select color and ColorPick event at mouse-down
@@ -64,12 +64,27 @@ type
 
   TPaletteSelectionKind = (pskNone, pskThin, pskThinInverted, pskThick, pskThickInverted);
 
-  TColorMouseEvent = procedure (Sender: TObject; AColor: TColor; Shift: TShiftState) of object;
+  TPaletteItem = (
-  TColorPaletteHintEvent = procedure (Sender: TObject; AColor: TColor; var AText: String) of object;
+    piColors, piColumnCount, piFlipped,
+    piButtonBorder, piButtonSize, piButtonDistance,
+    piSelKind, piSelColor
+  );
+  TPaletteItems = set of TPaletteItem;
 
+const
+  piAll = [piColors, piColumnCount, piFlipped,
+    piButtonBorder, piButtonSize, piButtonDistance,
+    piSelKind, piSelColor
+  ];
+
+
+type
 
   { TCustomColorPalette }
 
+  TColorMouseEvent = procedure (Sender: TObject; AColor: TColor; Shift: TShiftState) of object;
+  TColorPaletteHintEvent = procedure (Sender: TObject; AColor: TColor; var AText: String) of object;
+
   TCustomColorPalette = class(TGraphicControl)
   private
     FSizeToLastCol: Integer;
@@ -110,13 +125,13 @@ type
     procedure SetColorNames(AIndex: Integer; const AValue: String);
     procedure SetColors(AIndex: Integer; const AValue: TColor);
     procedure SetCols(AValue: Integer);
+    procedure SetFlipped(AValue: Boolean);
     procedure SetGradientSteps(AValue: Byte);
     procedure SetPaletteKind(AValue: TPaletteKind);
     procedure SetPickedIndex(AValue: Integer);
     procedure SetSelectionColor(AValue: TColor);
     procedure SetSelectionKind(AValue: TPaletteSelectionKind);
     procedure SetUseSpacers(AValue: Boolean);
-    procedure SetFlipped(AValue: Boolean);
 
   protected
     procedure BlendWBColor(AColor: TColor; Steps: Integer);
@@ -165,7 +180,8 @@ type
     procedure ClearColors;
     procedure DeleteColor(AIndex: Integer);
     procedure InsertColor(AIndex: Integer; AColor: TColor; AColorName: String = '');
-    procedure LoadPalette(const FileName: String);
+    procedure LoadPalette(const FileName: String;
+      AItems: TPaletteItems = [piColors, piColumnCount]);
     procedure SavePalette(const FileName: String);
   
     property Colors[Index: Integer]: TColor read GetColors write SetColors;
@@ -237,6 +253,11 @@ implementation
 uses
   LCLIntf, StrUtils;
 
+const
+  SELKIND_NAMES: Array[TPaletteSelectionKind] of String = (
+    'NONE', 'THIN', 'THIN-INV', 'THICK', 'THICK-INV'
+  );
+
 procedure Register;
 begin
   RegisterComponents('Misc', [TColorPalette]);
@@ -486,13 +507,15 @@ begin
   DoInsertColor(AIndex, AColor, AColorName);
 end;
 
-procedure TCustomColorPalette.LoadPalette(const FileName: String);
+procedure TCustomColorPalette.LoadPalette(const FileName: String;
+  AItems: TPaletteItems = [piColors, piColumnCount]);
 var
   F: TextFile;
   Line: String;
   C: TColor;
   clrName: String;
   p, steps: Integer;
+  sk: TPaletteSelectionKind;
 
   procedure ParseColor(S: String; out AColor: TColor; out Steps: Integer;
     out ColorName: String);
@@ -578,10 +601,51 @@ begin
       if Line[1] = '$' then
       begin
         if Copy(Line, 2, 4) = 'NONE' then
-          DoAddColor(clNone);
+          DoAddColor(clNone)
-        if Copy(Line, 2, 4) = 'COLS' then
+        else
-          FCols := StrToIntDef(Copy(Line, 6, MaxInt), 8);
+        if (Copy(Line, 2, 4) = 'COLS') and (piColumnCount in AItems) then
-        if Copy(Line, 2, 7) = 'BLENDWB' then
+          FCols := StrToIntDef(Copy(Line, 6, MaxInt), FCols)
+        else
+        if (Copy(Line, 2, 7) = 'BTNDIST') and (piButtonDistance in AItems) then
+          FButtonDistance := StrToIntDef(Copy(Line, 9, MaxInt), FButtonDistance)
+        else
+        if (Copy(Line, 2, 8) = 'BTNWIDTH') and (piButtonSize in AItems) then
+          FButtonWidth := StrToIntDef(Copy(Line, 10, MaxInt), FButtonWidth)
+        else
+        if (Copy(Line, 2, 9) = 'BTNHEIGHT') and (piButtonSize in AItems) then
+          FButtonHeight := StrToIntDef(Copy(Line, 11, MaxInt), FButtonHeight)
+        else
+        if (Copy(Line, 2, 9) = 'BTNBORDER') and (piButtonBorder in AItems) then
+        begin
+          Delete(Line, 1, 11);
+          ParseColor(Line, C, steps, clrName);
+          FButtonBorderColor := C;
+        end else
+        if (Copy(Line, 2, 7) = 'FLIPPED') and (piFlipped in AItems) then
+        begin
+          Delete(Line, 1, 9);
+          case Line of
+            'TRUE' : FFlipped := true;
+            'FALSE': FFlipped := false;
+          end;
+        end else
+        if (Copy(Line, 2, 7) = 'SELKIND') and (piSelKind in AItems) then
+        begin
+          Delete(Line, 1, 9);
+          for sk in TPaletteSelectionKind do
+            if Line = SELKIND_NAMES[sk] then
+            begin
+              FSelectionKind := sk;
+              break;
+            end;
+        end else
+        if (Copy(Line, 2, 8) = 'SELCOLOR') and (piSelColor in AItems) then
+        begin
+          Delete(Line, 1, 10);
+          ParseColor(Line, C, steps, clrName);
+          FSelectionColor := C;
+        end else
+        if (Copy(Line, 2, 7) = 'BLENDWB') and (piColors in AItems) then
         begin
           Delete(Line, 1, 8);
           ParseColor(Line, C, steps, clrName);
@@ -589,7 +653,7 @@ begin
         end;
       end
       else
-        if Pos(',', Line) > 0 then
+        if (Pos(',', Line) > 0) and (piColors in AItems) then
         begin
           ParseColor(Line, C, steps, clrName);
           DoAddColor(C, clrName);
@@ -807,7 +871,17 @@ var
 begin
   L := TStringList.Create;
   try
+    L.Add('# PROPERTIES');
+    L.Add(Format('$BTNBORDER %d, %d, %d', [Red(FButtonBorderColor), Green(FButtonBorderColor), Blue(FButtonBorderColor)]));
+    L.ADd(Format('$BTNWIDTH %d', [FButtonWidth]));
+    L.Add(Format('$BTNHEIGHT %d', [FButtonHeight]));
+    L.Add(Format('$BTNDIST %d', [FButtonDistance]));
+    L.Add(Format('$SELKIND %s', [SELKIND_NAMES[FSelectionKind]]));
+    L.Add(Format('$SELCOLOR %d, %d, %d', [Red(FSelectionColor), Green(FSelectionColor), Blue(FSelectionColor)]));
+    L.Add(Format('$FLIPPED %s', [BoolToStr(FFlipped, 'TRUE', 'FALSE')]));
     L.Add(Format('$COLS %d', [FCols]));
+    L.Add('');
+    L.Add('# COLORS');
     for i:=0 to FColors.Count-1 do begin
       clr := Colors[i];
       if clr = clNone then

components/colorpalette/demo/GeneralDemo/unit1.lfm

@@ -1,22 +1,22 @@
 object MainForm: TMainForm
   Left = 394
-  Height = 555
+  Height = 586
   Top = 287
   Width = 625
   Caption = 'MainForm'
-  ClientHeight = 555
+  ClientHeight = 586
   ClientWidth = 625
   OnCreate = FormCreate
   ShowHint = True
   LCLVersion = '1.5'
   object LeftPanel: TPanel
     Left = 0
-    Height = 555
+    Height = 586
     Top = 0
     Width = 160
     Align = alLeft
     BevelOuter = bvNone
-    ClientHeight = 555
+    ClientHeight = 586
     ClientWidth = 160
     TabOrder = 0
     object ColorSample: TShape
@@ -50,7 +50,7 @@ object MainForm: TMainForm
     object BtnLoadRndPalette: TButton
       Left = 10
       Height = 25
-      Top = 408
+      Top = 437
       Width = 137
       Caption = 'Load random palette'
       Enabled = False
@@ -60,7 +60,7 @@ object MainForm: TMainForm
     object BtnCreateRndPalette: TButton
       Left = 10
       Height = 25
-      Top = 379
+      Top = 408
       Width = 137
       Caption = 'Create random palette'
       OnClick = BtnCreateRndPaletteClick
@@ -69,7 +69,7 @@ object MainForm: TMainForm
     object BtnAddColor: TButton
       Left = 10
       Height = 25
-      Top = 485
+      Top = 514
       Width = 137
       Caption = 'Add color...'
       OnClick = BtnAddColorClick
@@ -87,7 +87,7 @@ object MainForm: TMainForm
     object BtnDeleteColor: TButton
       Left = 10
       Height = 25
-      Top = 514
+      Top = 543
       Width = 137
       Caption = 'Delete color #0'
       OnClick = BtnDeleteColorClick
@@ -96,9 +96,10 @@ object MainForm: TMainForm
     object BtnSavePalette: TButton
       Left = 10
       Height = 25
-      Top = 446
+      Top = 475
       Width = 137
       Caption = 'Save palette...'
+      OnClick = BtnSavePaletteClick
       TabOrder = 6
     end
     object LblGradientSteps: TLabel
@@ -175,10 +176,19 @@ object MainForm: TMainForm
       Visible = False
       WordWrap = True
     end
+    object BtnLoadPaletteAndProps: TButton
+      Left = 10
+      Height = 25
+      Top = 367
+      Width = 137
+      Caption = 'Load palette && props...'
+      OnClick = BtnLoadPaletteClick
+      TabOrder = 9
+    end
   end
   object Bevel1: TBevel
     Left = 160
-    Height = 539
+    Height = 570
     Top = 8
     Width = 3
     Align = alLeft
@@ -188,12 +198,12 @@ object MainForm: TMainForm
   end
   object RightPanel: TPanel
     Left = 465
-    Height = 555
+    Height = 586
     Top = 0
     Width = 160
     Align = alRight
     BevelOuter = bvNone
-    ClientHeight = 555
+    ClientHeight = 586
     ClientWidth = 160
     TabOrder = 1
     object LblButtonDistance: TLabel
@@ -415,7 +425,7 @@ object MainForm: TMainForm
   end
   object Bevel2: TBevel
     Left = 462
-    Height = 539
+    Height = 570
     Top = 8
     Width = 3
     Align = alRight
@@ -425,7 +435,7 @@ object MainForm: TMainForm
   end
   object ScrollBox: TScrollBox
     Left = 168
-    Height = 539
+    Height = 570
     Top = 8
     Width = 287
     HorzScrollBar.Increment = 15
@@ -438,7 +448,7 @@ object MainForm: TMainForm
     VertScrollBar.Tracking = True
     Anchors = [akTop, akLeft, akRight, akBottom]
     BorderStyle = bsNone
-    ClientHeight = 539
+    ClientHeight = 570
     ClientWidth = 287
     TabOrder = 2
     object ColorPalette: TColorPalette

components/colorpalette/demo/GeneralDemo/unit1.pas

@@ -16,6 +16,7 @@ type
     Bevel1: TBevel;
     Bevel2: TBevel;
     BtnDeleteColor: TButton;
+    BtnLoadPaletteAndProps: TButton;
     BtnSavePalette: TButton;
     BtnLoadRndPalette: TButton;
     BtnCreateRndPalette: TButton;
@@ -66,6 +67,7 @@ type
     procedure BtnEditColorClick(Sender: TObject);
     procedure BtnLoadPaletteClick(Sender: TObject);
     procedure BtnLoadRndPaletteClick(Sender: TObject);
+    procedure BtnSavePaletteClick(Sender: TObject);
     procedure CbBuiltinPalettesSelect(Sender: TObject);
     procedure CbBkColorSelect(Sender: TObject);
     procedure CbCustomHintTextChange(Sender: TObject);
@@ -163,20 +165,18 @@ begin
   with OpenDialog do
     if Execute then
     begin
+      if Sender = BtnLoadPaletteAndProps then
+        ColorPalette.LoadPalette(FileName, piAll) else
         ColorPalette.LoadPalette(FileName);
-      UpdateCaption;
       EdColCount.Value := ColorPalette.ColumnCount;
-    end;
+      CbSelKind.ItemIndex := ord(Colorpalette.SelectionKind);
-                     {
+      CbSelColor.Selected := ColorPalette.SelectionColor;
-  if not FileExists('..\default.pal') then
+      CbButtonBorderColor.Selected := ColorPalette.ButtonBorderColor;
-  begin
+      EdButtonSize.Value := ColorPalette.ButtonWidth;
-    ShowMessage('File "default.pal" not found. Copy it from the TColorPalette folder to the current exe folder.');
+      EdButtonDistance.Value := ColorPalette.ButtonDistance;
-    exit;
+      CbFlipped.Checked := ColorPalette.Flipped;
-  end;
-  ColorPalette.LoadPalette('..\default.pal');
       UpdateCaption;
-  EdColCount.Value := ColorPalette.ColumnCount;
+    end;
-  }
 end;
 
 procedure TMainForm.BtnLoadRndPaletteClick(Sender: TObject);
@@ -186,6 +186,12 @@ begin
   EdColCount.Value := ColorPalette.ColumnCount;
 end;
 
+procedure TMainForm.BtnSavePaletteClick(Sender: TObject);
+begin
+  if SaveDialog.Execute then
+    ColorPalette.SavePalette(SaveDialog.FileName);
+end;
+
 procedure TMainForm.BtnEditColorClick(Sender: TObject);
 begin
   if BtnEditColor.caption = 'Edit' then