ColorPalette: New properties BorderColor and BorderWidth.

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

components/colorpalette/colorpalette.pas

@@ -87,15 +87,18 @@ type
     FShowColorHint: Boolean;
     FShowSelection: Boolean;
     FSavedHint: String;
+    FBorderColor: TColor;
+    FBorderWidth: Integer;
     function GetColorCount: Integer;
     function GetColors(AIndex: Integer): TColor;
     function GetPickedColor: TColor;
+    procedure SetBorderColor(const AValue: TColor);
+    procedure SetBorderWidth(const AValue: Integer);
     procedure SetButtonHeight(const AValue: Integer);
     procedure SetButtonWidth(const AValue: Integer);
     procedure SetColors(AIndex: Integer; const AValue: TColor);
     procedure SetCols(AValue: Integer);
     procedure SetSelectedIndex(AValue: Integer);
-//    procedure SetShowColorHint(AValue: Boolean);
     procedure SetShowSelection(AValue: Boolean);
   protected
     procedure ColorPick(AIndex: Integer; Shift: TShiftState); dynamic;
@@ -112,6 +115,8 @@ type
     procedure MouseMove(Shift:TShiftState; X, Y:Integer); override;
     procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
     procedure UpdateSize; virtual;
+    property BorderColor: TColor read FBorderColor write SetBorderColor default clBlack;
+    property BorderWidth: Integer read FBorderWidth write SetBorderWidth default 1;
     property ButtonWidth: Integer read FButtonWidth write SetButtonWidth;
     property ButtonHeight: Integer read FButtonHeight write SetButtonHeight;
     property ColumnCount: Integer read FCols write SetCols;
@@ -120,11 +125,12 @@ type
     property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex default 0;
     property ShowColorHint: Boolean read FShowColorHint write FShowColorHint default true;
     property ShowSelection: Boolean read FShowSelection write SetShowSelection default false;
+
   public
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
     procedure Paint; override;
-  public
+
     procedure AddColor(AColor: TColor);
     procedure DeleteColor(AIndex: Integer);
     procedure LoadPalette(const FileName: String);
@@ -145,13 +151,27 @@ type
   
   TColorPalette = class(TCustomColorPalette)
   published
+    // inherited from TCustomColorPalette
+    property BorderColor;
+    property BorderWidth;
+    property ButtonWidth;
+    property ButtonHeight;
+    property ColumnCount;
+    property PickMode;
+    property PickShift;
+    property SelectedIndex;
+    property ShowColorHint;
+    property ShowSelection;
+
+    property OnColorMouseMove;
+    property OnColorPick;
+    property OnSelectColor;
+
+    // inherited from TCustomColorPalette's ancestors
     property Align;
     property Anchors;
     property BorderSpacing;
-    property ButtonWidth;
-    property ButtonHeight;
     property Color;
-    property ColumnCount;
     property Constraints;
     property DragCursor;
     property DragKind;
@@ -160,19 +180,12 @@ type
     property Hint;
     property ParentColor;
     property ParentShowHint;
-    property PickMode;
-    property PickShift;
     property PopupMenu;
-    property SelectedIndex;
-    property ShowColorHint;
     property ShowHint;
-    property ShowSelection;
     property Visible;
     
     property OnChangeBounds;
     property OnClick;
-    property OnColorMouseMove;
-    property OnColorPick;
     property OnDblClick;
     property OnMouseDown;
     property OnMouseMove;
@@ -180,7 +193,6 @@ type
     property OnMouseEnter;
     property OnMouseLeave;
     property OnResize;
-    property OnSelectColor;
   end;
   
   procedure Register;
@@ -188,6 +200,9 @@ type
 
 implementation
 
+uses
+  LCLIntf;
+
 procedure Register;
 begin
   RegisterComponents('Misc', [TColorPalette]);
@@ -202,6 +217,8 @@ begin
   ControlStyle := ControlStyle + [csFixedWidth, csFixedHeight];
 
   FColors := TList.Create;
+  FBorderColor := clBlack;
+  FBorderWidth := 1;
   FButtonWidth := 12;
   FButtonHeight := 12;
   FPrevMouseIndex := -1;
@@ -520,34 +537,74 @@ begin
 end;
 
 procedure TCustomColorPalette.Paint;
-var
+
-  I, X, Y: Integer;
+  procedure PaintBox(x1, y1, x2, y2: Integer; c: TColor);
-  c: TColor;
-  R: TRect;
-begin
-  Canvas.Pen.Color := clBlack;
-  for I := 0 to Pred(FColors.Count) do
   begin
-    Y := I div FCols;
+    if c = clNone then
-    X := I mod FCols;
+      exit;
-    c := GetColors(I);
+
-    if c <> clNone then
+    // Fill interior
-    begin
-      R := Bounds(X * FButtonWidth, Y*FButtonHeight, FButtonWidth, FButtonHeight);
-      if FShowSelection and (FSelectedIndex = I) then
-      begin
-        if Red(c) + Green(c) + Blue(c) > 128*3 then
-          Canvas.Pen.Color := clBlack else
-          Canvas.Pen.Color := clWhite;
-        Canvas.Pen.Width := 3;
-      end else begin
-        Canvas.Pen.Color := clBlack;
-        Canvas.Pen.Width := 1;
-      end;
     Canvas.Brush.Color := c;
-      Canvas.Rectangle(R);
+    Canvas.FillRect(x1, y1, x2, y2);
+
+    // Paint border
+    if (FBorderColor <> clNone) and (FBorderWidth > 0) then
+    begin
+      x1 := x1 - FBorderWidth div 2 - FBorderWidth mod 2;
+      y1 := y1 - FBorderWidth div 2 - FBorderWidth mod 2;
+      x2 := x1 + FButtonWidth;
+      y2 := y1 + FButtonHeight;
+      Canvas.Pen.Color := FBorderColor;
+      Canvas.Pen.Width := FBorderWidth;
+      Canvas.MoveTo(x1, y1);
+      Canvas.LineTo(x2, y1);
+      Canvas.LineTo(x2, y2);
+      Canvas.LineTo(x1, y2);
+      Canvas.LineTo(x1, y1);
     end;
   end;
+
+var
+  I, X, Y, W, H, d: Integer;
+  c: TColor;
+  Rsel: TRect;
+begin
+  Canvas.Pen.Endcap := pecSquare;
+
+  // Paint color boxes
+  X := FBorderWidth;
+  Y := FBorderWidth;
+  W := FButtonWidth - FBorderWidth;
+  H := FButtonHeight - FBorderWidth;
+  for I := 0 to pred(FColors.Count) do
+  begin
+    if I = FSelectedIndex then    // Selected rect of box with selected color
+      Rsel := Bounds(X, Y, W, H);
+    c := GetColors(I);
+    PaintBox(X, Y, X+W, Y+H, c);
+    inc(X, FButtonWidth);
+    if X >= Width then
+    begin
+      inc(Y, FButtonHeight);
+      X := FBorderWidth;
+    end;
+  end;
+
+  // Paint selection
+  if FShowSelection then
+  begin
+    d := FBorderWidth div 2;
+    if d = 0 then
+      c := GetColors(FSelectedIndex) else
+      c := ColorToRgb(FBorderColor);
+    Canvas.Pen.Color := InvertColor(c);
+    Canvas.Pen.Width := 1;
+    Canvas.Pen.Style := psSolid;
+    Canvas.Brush.Style := bsSolid;
+    Canvas.Brush.Style := bsClear;
+    InflateRect(Rsel, d, d);
+    Canvas.Rectangle(Rsel);
+  end;
 end;
 
 procedure TCustomColorPalette.SavePalette(const Filename: String);
@@ -575,12 +632,19 @@ begin
   end;
 end;
 
-procedure TCustomColorPalette.SetButtonWidth(const AValue: Integer);
+procedure TCustomColorPalette.SetBorderColor(const AValue: TColor);
 begin
-  if FButtonWidth = AValue then Exit;
+  if FBorderColor = AValue then exit;
-  FButtonWidth := AValue;
+  FBorderColor := AValue;
-  if FButtonWidth < 1 then FButtonWidth := 1;
+  Invalidate;
+end;
+
+procedure TCustomColorPalette.SetBorderWidth(const AValue: Integer);
+begin
+  if FBorderWidth = AValue then exit;
+  FBorderWidth := AValue;
   UpdateSize;
+  Invalidate;
 end;
 
 procedure TCustomColorPalette.SetButtonHeight(const AValue: Integer);
@@ -591,6 +655,14 @@ begin
   UpdateSize;
 end;
 
+procedure TCustomColorPalette.SetButtonWidth(const AValue: Integer);
+begin
+  if FButtonWidth = AValue then Exit;
+  FButtonWidth := AValue;
+  if FButtonWidth < 1 then FButtonWidth := 1;
+  UpdateSize;
+end;
+
 procedure TCustomColorPalette.SetColors(AIndex: Integer; const AValue: TColor);
 begin
   FColors.Items[AIndex] := Pointer(AValue);
@@ -642,7 +714,7 @@ begin
   else
     FRows := Ceil(FColors.Count / FCols);
 
-  SetBounds(Left, Top, FCols * FButtonWidth + 1, FRows * FButtonHeight + 1);
+  SetBounds(Left, Top, FCols * FButtonWidth + FBorderWidth, FRows * FButtonHeight + FBorderWidth);
 end;
 
 

components/colorpalette/demo/unit1.lfm

@@ -1,10 +1,10 @@
 object MainForm: TMainForm
   Left = 358
-  Height = 502
+  Height = 622
   Top = 179
   Width = 455
   Caption = 'MainForm'
-  ClientHeight = 502
+  ClientHeight = 622
   ClientWidth = 455
   OnCreate = FormCreate
   ShowHint = True
@@ -19,19 +19,18 @@ object MainForm: TMainForm
     ButtonHeight = 16
     ColumnCount = 8
     PickShift = [ssLeft, ssMiddle]
+    OnSelectColor = ColorPaletteSelectColor
     PopupMenu = PalettePopupMenu
     OnDblClick = ColorPaletteDblClick
-    OnMouseDown = ColorPaletteMouseDown
-    OnSelectColor = ColorPaletteSelectColor
   end
   object Panel1: TPanel
     Left = 0
-    Height = 502
+    Height = 622
     Top = 0
     Width = 160
     Align = alLeft
     BevelOuter = bvNone
-    ClientHeight = 502
+    ClientHeight = 622
     ClientWidth = 160
     TabOrder = 0
     object ColorSample: TShape
@@ -117,29 +116,30 @@ object MainForm: TMainForm
       TabOrder = 6
     end
     object EdColCount: TSpinEdit
-      Left = 11
+      Left = 9
       Height = 23
-      Top = 463
+      Top = 581
-      Width = 66
+      Width = 59
+      Alignment = taRightJustify
       MinValue = 1
       OnChange = EdColCountChange
       TabOrder = 7
       Value = 8
     end
     object Label2: TLabel
-      Left = 11
+      Left = 9
       Height = 15
-      Top = 442
+      Top = 561
-      Width = 80
+      Width = 48
-      Caption = 'Column count:'
+      Caption = 'Columns'
       ParentColor = False
     end
     object CbPickMode: TComboBox
-      Left = 11
+      Left = 10
       Height = 23
       Hint = 'Defines when the picked color is determined and when the OnPickColor event is generated:'#13#10#13#10'pmDefault: '#13#10'  Color selection at mouse-down, OnPickColor event at mouse-up if at same location'#13#10#13#10'pmImmediate:'#13#10'  Color selection and OnPickColor event at mouse-down'#13#10#13#10'pmContinuous:'#13#10'  Color selection and OnPickColor event while mouse is down'
-      Top = 358
+      Top = 355
-      Width = 136
+      Width = 137
       ItemHeight = 15
       ItemIndex = 0
       Items.Strings = (
@@ -155,13 +155,13 @@ object MainForm: TMainForm
     object LblPickMode: TLabel
       Left = 10
       Height = 15
-      Top = 337
+      Top = 335
       Width = 56
       Caption = 'Pick mode'
       ParentColor = False
     end
     object CbShowSelection: TCheckBox
-      Left = 11
+      Left = 10
       Height = 19
       Top = 395
       Width = 99
@@ -170,7 +170,7 @@ object MainForm: TMainForm
       TabOrder = 9
     end
     object CbShowColorHints: TCheckBox
-      Left = 11
+      Left = 10
       Height = 19
       Top = 416
       Width = 108
@@ -180,10 +180,67 @@ object MainForm: TMainForm
       State = cbChecked
       TabOrder = 10
     end
+    object LblPickMode1: TLabel
+      Left = 10
+      Height = 15
+      Top = 451
+      Width = 68
+      Caption = 'Border color:'
+      ParentColor = False
+    end
+    object CbBorderColor: TColorBox
+      Left = 10
+      Height = 22
+      Top = 471
+      Width = 137
+      NoneColorColor = clWindow
+      Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbIncludeNone]
+      ItemHeight = 16
+      OnSelect = CbBorderColorSelect
+      TabOrder = 11
+    end
+    object Label3: TLabel
+      Left = 10
+      Height = 15
+      Top = 505
+      Width = 68
+      Caption = 'Border width'
+      ParentColor = False
+    end
+    object EdBorderWidth: TSpinEdit
+      Left = 10
+      Height = 23
+      Top = 525
+      Width = 58
+      Alignment = taRightJustify
+      MaxValue = 16
+      OnChange = EdBorderWidthChange
+      TabOrder = 12
+      Value = 1
+    end
+    object Label4: TLabel
+      Left = 93
+      Height = 15
+      Top = 561
+      Width = 40
+      Caption = 'Btn size'
+      ParentColor = False
+    end
+    object EdBoxSize: TSpinEdit
+      Left = 93
+      Height = 23
+      Top = 581
+      Width = 54
+      Alignment = taRightJustify
+      MinValue = 1
+      OnChange = EdBoxSizeChange
+      TabOrder = 13
+      Value = 16
+    end
   end
   object Bevel1: TBevel
     Left = 160
-    Height = 486
+    Height = 606
     Top = 8
     Width = 3
     Align = alLeft

components/colorpalette/demo/unit1.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  Spin, ExtCtrls, Menus, ColorPalette;
+  Spin, ExtCtrls, Menus, ColorBox, ColorPalette;
 
 type
 
@@ -23,13 +23,19 @@ type
     BtnEditColor: TButton;
     CbShowSelection: TCheckBox;
     CbShowColorHints: TCheckBox;
+    CbBorderColor: TColorBox;
     ColorDialog: TColorDialog;
     ColorPalette: TColorPalette;
     CbPickMode: TComboBox;
+    EdBorderWidth: TSpinEdit;
+    EdBoxSize: TSpinEdit;
+    Label3: TLabel;
+    Label4: TLabel;
     LblPickMode: TLabel;
     EdColCount: TSpinEdit;
     Label2: TLabel;
     LblColorInfo: TLabel;
+    LblPickMode1: TLabel;
     MnuEditPickedColor: TMenuItem;
     MnuDeletePickedColor: TMenuItem;
     PalettePopupMenu: TPopupMenu;
@@ -45,10 +51,11 @@ type
     procedure CbPickModeSelect(Sender: TObject);
     procedure CbShowColorHintsChange(Sender: TObject);
     procedure CbShowSelectionChange(Sender: TObject);
+    procedure CbBorderColorSelect(Sender: TObject);
     procedure ColorPaletteDblClick(Sender: TObject);
-    procedure ColorPaletteMouseDown(Sender: TObject; Button: TMouseButton;
-      Shift: TShiftState; X, Y: Integer);
     procedure ColorPaletteSelectColor(Sender: TObject; AColor: TColor);
+    procedure EdBorderWidthChange(Sender: TObject);
+    procedure EdBoxSizeChange(Sender: TObject);
     procedure EdColCountChange(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure MnuDeletePickedColorClick(Sender: TObject);
@@ -70,8 +77,8 @@ implementation
 
 {$R *.lfm}
 
-{ TMainForm }
 
+{ TMainForm }
 
 procedure TMainForm.BtnAddColorClick(Sender: TObject);
 begin
@@ -146,6 +153,11 @@ begin
     UpdatePalette;
 end;
 
+procedure TMainForm.CbBorderColorSelect(Sender: TObject);
+begin
+  ColorPalette.BorderColor := CbBorderColor.Selected;
+end;
+
 procedure TMainForm.CbPickModeSelect(Sender: TObject);
 begin
   ColorPalette.PickMode := TPickMode(CbPickMode.ItemIndex);
@@ -181,17 +193,6 @@ begin
   end;
 end;
 
-procedure TMainForm.ColorPaletteMouseDown(Sender: TObject; Button: TMouseButton;
-  Shift: TShiftState; X, Y: Integer);
-begin
-exit;
-
-
-
-  BtnDeleteColor.caption := 'Delete color #' + IntToStr(ColorPalette.SelectedIndex);
-  UpdateCaption;
-end;
-
 procedure TMainForm.ColorPaletteSelectColor(Sender: TObject; AColor: TColor);
 begin
   ColorSample.Brush.Color := AColor;
@@ -203,6 +204,17 @@ begin
   UpdateCaption;
 end;
 
+procedure TMainForm.EdBorderWidthChange(Sender: TObject);
+begin
+  ColorPalette.BorderWidth := EdBorderWidth.Value;
+end;
+
+procedure TMainForm.EdBoxSizeChange(Sender: TObject);
+begin
+  ColorPalette.ButtonWidth := EdBoxSize.Value;
+  ColorPalette.ButtonHeight := EdBoxSize.Value;
+end;
+
 procedure TMainForm.EdColCountChange(Sender: TObject);
 begin
   ColorPalette.ColumnCount := EdColCount.Value;