From 3980f70b8ba5cbeddd3a62a23341dde0c8801518 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 21 Aug 2015 22:32:56 +0000 Subject: [PATCH] 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 | 156 +++++++++++++++++------ components/colorpalette/demo/unit1.lfm | 97 +++++++++++--- components/colorpalette/demo/unit1.pas | 42 +++--- 3 files changed, 218 insertions(+), 77 deletions(-) diff --git a/components/colorpalette/colorpalette.pas b/components/colorpalette/colorpalette.pas index 1c7bbcea7..39f220e88 100644 --- a/components/colorpalette/colorpalette.pas +++ b/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; - c: TColor; - R: TRect; -begin - Canvas.Pen.Color := clBlack; - for I := 0 to Pred(FColors.Count) do + + procedure PaintBox(x1, y1, x2, y2: Integer; c: TColor); begin - Y := I div FCols; - X := I mod FCols; - c := GetColors(I); - if c <> clNone then + if c = clNone then + exit; + + // Fill interior + Canvas.Brush.Color := c; + Canvas.FillRect(x1, y1, x2, y2); + + // Paint border + if (FBorderColor <> clNone) and (FBorderWidth > 0) then 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); + 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; - FButtonWidth := AValue; - if FButtonWidth < 1 then FButtonWidth := 1; + if FBorderColor = AValue then exit; + FBorderColor := AValue; + 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; diff --git a/components/colorpalette/demo/unit1.lfm b/components/colorpalette/demo/unit1.lfm index bedd3b750..4d066f3b9 100644 --- a/components/colorpalette/demo/unit1.lfm +++ b/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 - Width = 66 + Top = 581 + Width = 59 + Alignment = taRightJustify MinValue = 1 OnChange = EdColCountChange TabOrder = 7 Value = 8 end object Label2: TLabel - Left = 11 + Left = 9 Height = 15 - Top = 442 - Width = 80 - Caption = 'Column count:' + Top = 561 + Width = 48 + 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 - Width = 136 + Top = 355 + 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 diff --git a/components/colorpalette/demo/unit1.pas b/components/colorpalette/demo/unit1.pas index 88da65caf..a74ae4d29 100644 --- 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, - 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;