You've already forked lazarus-ccr
ColorPalette: New properties BorderColor and BorderWidth.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4283 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -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;
|
||||
|
||||
procedure PaintBox(x1, y1, x2, y2: Integer; c: TColor);
|
||||
begin
|
||||
Canvas.Pen.Color := clBlack;
|
||||
for I := 0 to Pred(FColors.Count) do
|
||||
begin
|
||||
Y := I div FCols;
|
||||
X := I mod FCols;
|
||||
c := GetColors(I);
|
||||
if c <> clNone 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;
|
||||
if c = clNone then
|
||||
exit;
|
||||
|
||||
// Fill interior
|
||||
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;
|
||||
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;
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
Reference in New Issue
Block a user