pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

ColorPalette: Add MouseIndex and MouseColor. Restructure painting and layout calculation. Rename BorderWidth to ButtonDistance, BorderColor to ButtonBorderColor.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4288 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-08-24 16:56:28 +00:00
parent ce951f772f
commit 0239cb3c67
3 changed files with 240 additions and 130 deletions
Download Patch File Download Diff File Expand all files Collapse all files

181
components/colorpalette/colorpalette.pas
View File

@ -76,6 +76,8 @@ type
private private
FButtonHeight: Integer; FButtonHeight: Integer;
FButtonWidth: Integer; FButtonWidth: Integer;
FButtonBorderColor: TColor;
FButtonDistance: Integer;
FCols: Integer; FCols: Integer;
FOnColorMouseMove: TColorMouseEvent; FOnColorMouseMove: TColorMouseEvent;
FOnColorPick: TColorMouseEvent; FOnColorPick: TColorMouseEvent;
@ -94,17 +96,16 @@ type
FShowColorHint: Boolean; FShowColorHint: Boolean;
FShowSelection: Boolean; FShowSelection: Boolean;
FSavedHint: String; FSavedHint: String;
FBorderColor: TColor;
FBorderWidth: Integer;
FPaletteKind: TPaletteKind; FPaletteKind: TPaletteKind;
FGradientSteps: Byte; FGradientSteps: Byte;
FUseSpacers: Boolean; FUseSpacers: Boolean;
function GetColorCount: Integer; function GetColorCount: Integer;
function GetColors(AIndex: Integer): TColor; function GetColors(AIndex: Integer): TColor;
function GetColorNames(AIndex: Integer): String; function GetColorNames(AIndex: Integer): String;
function GetMouseColor: TColor;
function GetPickedColor: TColor; function GetPickedColor: TColor;
procedure SetBorderColor(const AValue: TColor); procedure SetButtonBorderColor(const AValue: TColor);
procedure SetBorderWidth(const AValue: Integer); procedure SetButtonDistance(const AValue: Integer);
procedure SetButtonHeight(const AValue: Integer); procedure SetButtonHeight(const AValue: Integer);
procedure SetButtonWidth(const AValue: Integer); procedure SetButtonWidth(const AValue: Integer);
procedure SetColorNames(AIndex: Integer; const AValue: String); procedure SetColorNames(AIndex: Integer; const AValue: String);
@ -124,6 +125,9 @@ type
procedure DoColorPick(AColor: TColor; AShift: TShiftState); virtual; procedure DoColorPick(AColor: TColor; AShift: TShiftState); virtual;
procedure DoDeleteColor(AIndex: Integer); virtual; procedure DoDeleteColor(AIndex: Integer); virtual;
procedure DoSelectColor(AColor: TColor); virtual; procedure DoSelectColor(AColor: TColor); virtual;
function GetCellHeight: Integer;
function GetCellWidth: Integer;
function GetColorIndex(X,Y: Integer): Integer;
function GetHintText(AIndex: Integer): String; virtual; function GetHintText(AIndex: Integer): String; virtual;
function IsCorrectShift(Shift: TShiftState): Boolean; function IsCorrectShift(Shift: TShiftState): Boolean;
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override; procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
@ -132,8 +136,8 @@ type
procedure MouseMove(Shift:TShiftState; X, Y:Integer); override; procedure MouseMove(Shift:TShiftState; X, Y:Integer); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override; procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
procedure UpdateSize; virtual; procedure UpdateSize; virtual;
property BorderColor: TColor read FBorderColor write SetBorderColor default clBlack; property ButtonBorderColor: TColor read FButtonBorderColor write SetButtonBorderColor default clBlack;
property BorderWidth: Integer read FBorderWidth write SetBorderWidth default 1; property ButtonDistance: Integer read FButtonDistance write SetButtonDistance default 0;
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth; property ButtonWidth: Integer read FButtonWidth write SetButtonWidth;
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight; property ButtonHeight: Integer read FButtonHeight write SetButtonHeight;
property ColumnCount: Integer read FCols write SetCols; property ColumnCount: Integer read FCols write SetCols;
@ -161,6 +165,8 @@ type
property Colors[Index: Integer]: TColor read GetColors write SetColors; property Colors[Index: Integer]: TColor read GetColors write SetColors;
property ColorNames[Index: Integer]: String read GetColorNames write SetColorNames; property ColorNames[Index: Integer]: String read GetColorNames write SetColorNames;
property ColorCount: Integer read GetColorCount; property ColorCount: Integer read GetColorCount;
property MouseIndex: Integer read FMouseIndex;
property MouseColor: TColor read GetMouseColor;
property PickedColor: TColor read GetPickedColor; deprecated 'Use SelectedColor'; property PickedColor: TColor read GetPickedColor; deprecated 'Use SelectedColor';
property SelectedColor: TColor read FSelectedColor; property SelectedColor: TColor read FSelectedColor;
@ -175,10 +181,10 @@ type
TColorPalette = class(TCustomColorPalette) TColorPalette = class(TCustomColorPalette)
published published
// inherited from TCustomColorPalette // inherited from TCustomColorPalette
property BorderColor; property ButtonBorderColor;
property BorderWidth; property ButtonDistance;
property ButtonWidth;
property ButtonHeight; property ButtonHeight;
property ButtonWidth;
property ColumnCount; property ColumnCount;
property GradientSteps; property GradientSteps;
property PaletteKind; property PaletteKind;
@ -198,7 +204,7 @@ type
property Align; property Align;
property Anchors; property Anchors;
property BorderSpacing; property BorderSpacing;
property Color; property Color default clNone;
property Constraints; property Constraints;
property DragCursor; property DragCursor;
property DragKind; property DragKind;
@ -230,6 +236,9 @@ implementation
uses uses
LCLIntf, StrUtils; LCLIntf, StrUtils;
const
SELMARGIN = 1; // extra margin for selection rectangle
procedure Register; procedure Register;
begin begin
RegisterComponents('Misc', [TColorPalette]); RegisterComponents('Misc', [TColorPalette]);
@ -242,12 +251,13 @@ constructor TCustomColorPalette.Create(AOwner: TComponent);
begin begin
inherited; inherited;
ControlStyle := ControlStyle + [csFixedWidth, csFixedHeight]; ControlStyle := ControlStyle + [csFixedWidth, csFixedHeight];
Color := clNone;
FColors := TStringList.Create; FColors := TStringList.Create;
FBorderColor := clBlack; FButtonBorderColor := clBlack;
FBorderWidth := 1; FButtonDistance := 0;
FButtonWidth := 12;
FButtonHeight := 12; FButtonHeight := 12;
FButtonWidth := 12;
FPrevMouseIndex := -1; FPrevMouseIndex := -1;
FPickMode := pmImmediate; FPickMode := pmImmediate;
FPickShift := [ssLeft]; FPickShift := [ssLeft];
@ -372,6 +382,11 @@ begin
Result := ''; Result := '';
end; end;
function TCustomColorPalette.GetMouseColor: TColor;
begin
Result := GetColors(FMouseIndex);
end;
function TCustomColorPalette.GetColors(AIndex: Integer): TColor; function TCustomColorPalette.GetColors(AIndex: Integer): TColor;
begin begin
if (AIndex >= 0) and (AIndex < FColors.Count) then if (AIndex >= 0) and (AIndex < FColors.Count) then
@ -380,6 +395,41 @@ begin
Result := clNone; Result := clNone;
end; end;
// Distance between top edge of a cell to the top edge of the next one
function TCustomColorPalette.GetCellHeight: Integer;
begin
Result := FButtonHeight + FButtonDistance;
end;
// Distance between left edge of a cell to the left edge of the next one
function TCustomColorPalette.GetCellWidth: Integer;
begin
Result := FButtonWidth + FButtonDistance;
end;
function TCustomColorPalette.GetColorIndex(X,Y: Integer): Integer;
var
W, H: Integer;
ix, iy: Integer;
begin
W := GetCellWidth;
H := GetCellHeight;
dec(X, SELMARGIN);
dec(Y, SELMARGIN);
if (FButtonDistance = 0) and (FButtonBorderColor <> clNone) then
begin
dec(W);
dec(H);
Result := X div W + Y div H * FCols;
end else
begin
Result := X div W + Y div H * FCols;
// Do not consider the space between the buttons
if (X mod W > FButtonWidth) or (Y mod H > FButtonWidth) then
Result := -1
end;
end;
function TCustomColorPalette.GetHintText(AIndex: Integer): string; function TCustomColorPalette.GetHintText(AIndex: Integer): string;
const const
INDENT = '* '; INDENT = '* ';
@ -546,10 +596,7 @@ begin
FMousePt.X := X; FMousePt.X := X;
FMousePt.Y := Y; FMousePt.Y := Y;
X := X div FButtonWidth; FMouseIndex := GetColorIndex(X, Y);
Y := Y div FButtonHeight;
FMouseIndex := X + Y * FCols;
FPrevMouseIndex := FMouseIndex; FPrevMouseIndex := FMouseIndex;
if FMouseIndex < 0 then if FMouseIndex < 0 then
@ -573,6 +620,7 @@ procedure TCustomColorPalette.MouseLeave;
begin begin
inherited; inherited;
Hint := FSavedHint; Hint := FSavedHint;
FMouseIndex := -1;
end; end;
procedure TCustomColorPalette.MouseMove(Shift: TShiftState; X, Y: Integer); procedure TCustomColorPalette.MouseMove(Shift: TShiftState; X, Y: Integer);
@ -581,8 +629,7 @@ var
begin begin
inherited; inherited;
FMouseIndex := X div FButtonWidth + (Y div FButtonHeight) * FCols; FMouseIndex := GetColorIndex(X, Y);
if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) then if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) then
begin begin
C := GetColors(FMouseIndex); C := GetColors(FMouseIndex);
@ -615,9 +662,7 @@ begin
ColorPick(FMouseIndex, FStoredShift); ColorPick(FMouseIndex, FStoredShift);
pmImmediate, pmContinuous: pmImmediate, pmContinuous:
begin begin
X := X div FButtonWidth; FMouseIndex := GetColorIndex(X, Y);
Y := Y div FButtonHeight;
FMouseIndex := X + Y * FCols;
if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and
(FMouseIndex <> FPrevMouseIndex) then (FMouseIndex <> FPrevMouseIndex) then
begin begin
@ -638,28 +683,34 @@ procedure TCustomColorPalette.Paint;
exit; exit;
// Fill interior // Fill interior
Canvas.Pen.Color := FButtonBorderColor;
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
if c = clNone then if c = clNone then
begin begin
Canvas.Pen.Color := clBlack; if Canvas.Pen.Color = clNone then
Canvas.Pen.Width := 1; Canvas.Pen.Color := FButtonBorderColor;
Canvas.Pen.Style := psSolid;
Canvas.Line(x1, y1, x2, y2); Canvas.Line(x1, y1, x2, y2);
Canvas.Line(x1, y2, x2, y1); Canvas.Line(x1, y2, x2, y1);
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(x1, y1, x2, y2);
end else end else
begin begin
Canvas.Brush.Color := c; Canvas.Brush.Color := c;
Canvas.FillRect(x1, y1, x2, y2); if (FButtonBorderColor = clNone) then
Canvas.FillRect(x1, y1, x2, y2) else
Canvas.Rectangle(x1, y1, x2, y2);
end; end;
// Paint border // Paint background between the color buttons
if (FBorderColor <> clNone) and (FBorderWidth > 0) then if ((Color <> clNone) and (FButtonDistance > 0)) then
begin begin
x1 := x1 - FBorderWidth div 2 - FBorderWidth mod 2; x1 := x1 - FButtonDistance div 2 - FButtonDistance mod 2;
y1 := y1 - FBorderWidth div 2 - FBorderWidth mod 2; y1 := y1 - FButtonDistance div 2 - FButtonDistance mod 2;
x2 := x1 + FButtonWidth; x2 := x1 + FButtonWidth - FButtonDistance;
y2 := y1 + FButtonHeight; y2 := y1 + FButtonHeight - FButtonDistance;
Canvas.Pen.Color := FBorderColor; Canvas.Pen.Color := Color;
Canvas.Pen.Width := FBorderWidth; Canvas.Pen.Width := FButtonDistance;
Canvas.MoveTo(x1, y1); Canvas.MoveTo(x1, y1);
Canvas.LineTo(x2, y1); Canvas.LineTo(x2, y1);
Canvas.LineTo(x2, y2); Canvas.LineTo(x2, y2);
@ -669,44 +720,39 @@ procedure TCustomColorPalette.Paint;
end; end;
var var
I, X, Y, W, H, d: Integer; I, X, Y: Integer;
c: TColor;
Rsel: TRect; Rsel: TRect;
xmax: Integer;
begin begin
Canvas.Pen.Endcap := pecSquare; Canvas.Pen.Endcap := pecSquare;
// Paint color boxes // Paint color boxes
X := FBorderWidth; X := SELMARGIN;
Y := FBorderWidth; Y := SELMARGIN;
W := FButtonWidth - FBorderWidth; xmax := Width - SELMARGIN;
H := FButtonHeight - FBorderWidth; if (FButtonDistance = 0) and (FButtonBordercolor <> clNone) then dec(xmax);
for I := 0 to pred(FColors.Count) do for I := 0 to pred(FColors.Count) do
begin begin
if I = FSelectedIndex then // Selected rect of box with selected color if I = FSelectedIndex then // Selected rect of box with selected color
Rsel := Bounds(X, Y, W, H); Rsel := Bounds(X, Y, FButtonWidth, FButtonHeight);
c := GetColors(I); PaintBox(X, Y, X + FButtonWidth, Y + FButtonHeight, GetColors(I));
PaintBox(X, Y, X+W, Y+H, c); inc(X, GetCellWidth);
inc(X, FButtonWidth); if (FButtonDistance = 0) and (FButtonBorderColor <> clNone) then dec(X);
if X >= Width then if X >= xmax then
begin begin
inc(Y, FButtonHeight); inc(Y, GetCellHeight);
X := FBorderWidth; if (FButtonDistance = 0) and (FButtonBorderColor <> clNone) then dec(Y);
X := SELMARGIN;
end; end;
end; end;
// Paint selection // Paint selection
if FShowSelection then if FShowSelection then
begin begin
d := FBorderWidth div 2; Canvas.Pen.Color := InvertColor(GetColors(FSelectedIndex));
if d = 0 then Canvas.Pen.Width := 3;
c := GetColors(FSelectedIndex) else
c := ColorToRgb(FBorderColor);
Canvas.Pen.Color := InvertColor(c);
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid; Canvas.Pen.Style := psSolid;
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Style := bsClear; Canvas.Brush.Style := bsClear;
InflateRect(Rsel, d, d);
Canvas.Rectangle(Rsel); Canvas.Rectangle(Rsel);
end; end;
end; end;
@ -741,17 +787,17 @@ begin
end; end;
end; end;
procedure TCustomColorPalette.SetBorderColor(const AValue: TColor); procedure TCustomColorPalette.SetButtonBorderColor(const AValue: TColor);
begin begin
if FBorderColor = AValue then exit; if FButtonBorderColor = AValue then exit;
FBorderColor := AValue; FButtonBorderColor := AValue;
Invalidate; Invalidate;
end; end;
procedure TCustomColorPalette.SetBorderWidth(const AValue: Integer); procedure TCustomColorPalette.SetButtonDistance(const AValue: Integer);
begin begin
if FBorderWidth = AValue then exit; if FButtonDistance = AValue then exit;
FBorderWidth := AValue; FButtonDistance := AValue;
UpdateSize; UpdateSize;
Invalidate; Invalidate;
end; end;
@ -1243,12 +1289,23 @@ begin
end; end;
procedure TCustomColorPalette.UpdateSize; procedure TCustomColorPalette.UpdateSize;
var
d, dx, dy: Integer;
begin begin
if (FCols = 0) or (FColors.Count = 0) then FRows := 0 if (FCols = 0) or (FColors.Count = 0) then FRows := 0
else else
FRows := Ceil(FColors.Count / FCols); FRows := Ceil(FColors.Count / FCols);
SetBounds(Left, Top, FCols * FButtonWidth + FBorderWidth, FRows * FButtonHeight + FBorderWidth); dx := GetCellWidth;
dy := GetCellHeight;
d := FButtonDistance;
if (FButtonDistance = 0) and (FButtonBorderColor <> clNone) then
begin
dec(dx);
dec(dy);
d := -1;
end;
SetBounds(Left, Top, FCols * dx - d + 2*SELMARGIN, FRows * dy - d + 2*SELMARGIN);
end; end;

119
components/colorpalette/demo/unit1.lfm
View File

@ -1,22 +1,22 @@
object MainForm: TMainForm object MainForm: TMainForm
Left = 394 Left = 394
Height = 535 Height = 551
Top = 287 Top = 287
Width = 625 Width = 625
Caption = 'MainForm' Caption = 'MainForm'
ClientHeight = 535 ClientHeight = 551
ClientWidth = 625 ClientWidth = 625
OnCreate = FormCreate OnCreate = FormCreate
ShowHint = True ShowHint = True
LCLVersion = '1.5' LCLVersion = '1.5'
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 535 Height = 551
Top = 0 Top = 0
Width = 160 Width = 160
Align = alLeft Align = alLeft
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 535 ClientHeight = 551
ClientWidth = 160 ClientWidth = 160
TabOrder = 0 TabOrder = 0
object ColorSample: TShape object ColorSample: TShape
@ -50,7 +50,7 @@ object MainForm: TMainForm
object BtnLoadRndPalette: TButton object BtnLoadRndPalette: TButton
Left = 10 Left = 10
Height = 25 Height = 25
Top = 308 Top = 408
Width = 137 Width = 137
Caption = 'Load random palette' Caption = 'Load random palette'
Enabled = False Enabled = False
@ -60,7 +60,7 @@ object MainForm: TMainForm
object BtnCreateRndPalette: TButton object BtnCreateRndPalette: TButton
Left = 10 Left = 10
Height = 25 Height = 25
Top = 279 Top = 379
Width = 137 Width = 137
Caption = 'Create random palette' Caption = 'Create random palette'
OnClick = BtnCreateRndPaletteClick OnClick = BtnCreateRndPaletteClick
@ -69,7 +69,7 @@ object MainForm: TMainForm
object BtnAddColor: TButton object BtnAddColor: TButton
Left = 10 Left = 10
Height = 25 Height = 25
Top = 385 Top = 485
Width = 137 Width = 137
Caption = 'Add color...' Caption = 'Add color...'
OnClick = BtnAddColorClick OnClick = BtnAddColorClick
@ -78,7 +78,7 @@ object MainForm: TMainForm
object BtnLoadDefaultPal: TButton object BtnLoadDefaultPal: TButton
Left = 10 Left = 10
Height = 25 Height = 25
Top = 239 Top = 339
Width = 137 Width = 137
Caption = 'Load palette...' Caption = 'Load palette...'
OnClick = BtnLoadDefaultPalClick OnClick = BtnLoadDefaultPalClick
@ -87,7 +87,7 @@ object MainForm: TMainForm
object BtnDeleteColor: TButton object BtnDeleteColor: TButton
Left = 10 Left = 10
Height = 25 Height = 25
Top = 414 Top = 514
Width = 137 Width = 137
Caption = 'Delete color #0' Caption = 'Delete color #0'
OnClick = BtnDeleteColorClick OnClick = BtnDeleteColorClick
@ -96,7 +96,7 @@ object MainForm: TMainForm
object BtnLoadDefaultPal1: TButton object BtnLoadDefaultPal1: TButton
Left = 10 Left = 10
Height = 25 Height = 25
Top = 346 Top = 446
Width = 137 Width = 137
Caption = 'Save palette...' Caption = 'Save palette...'
TabOrder = 6 TabOrder = 6
@ -104,7 +104,7 @@ object MainForm: TMainForm
object LblGradientSteps: TLabel object LblGradientSteps: TLabel
Left = 10 Left = 10
Height = 15 Height = 15
Top = 176 Top = 276
Width = 116 Width = 116
Caption = 'Built-in gradient steps' Caption = 'Built-in gradient steps'
Enabled = False Enabled = False
@ -113,7 +113,7 @@ object MainForm: TMainForm
object EdGradientSteps: TSpinEdit object EdGradientSteps: TSpinEdit
Left = 10 Left = 10
Height = 23 Height = 23
Top = 196 Top = 296
Width = 59 Width = 59
Alignment = taRightJustify Alignment = taRightJustify
Enabled = False Enabled = False
@ -126,7 +126,7 @@ object MainForm: TMainForm
object LblPickMode2: TLabel object LblPickMode2: TLabel
Left = 10 Left = 10
Height = 15 Height = 15
Top = 124 Top = 224
Width = 83 Width = 83
Caption = 'Built-in palettes' Caption = 'Built-in palettes'
ParentColor = False ParentColor = False
@ -135,7 +135,7 @@ object MainForm: TMainForm
Left = 10 Left = 10
Height = 23 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' 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 = 144 Top = 244
Width = 137 Width = 137
ItemHeight = 15 ItemHeight = 15
ItemIndex = 0 ItemIndex = 0
@ -154,10 +154,30 @@ object MainForm: TMainForm
TabOrder = 8 TabOrder = 8
Text = 'Standard palette' Text = 'Standard palette'
end end
object MouseColorSample: TShape
Left = 10
Height = 29
Top = 117
Width = 63
Visible = False
end
object LblMouseColorInfo: TLabel
Left = 10
Height = 65
Top = 149
Width = 146
AutoSize = False
Caption = 'LblMouseColorInfo'
Font.Color = clGreen
ParentColor = False
ParentFont = False
Visible = False
WordWrap = True
end
end end
object Bevel1: TBevel object Bevel1: TBevel
Left = 160 Left = 160
Height = 519 Height = 535
Top = 8 Top = 8
Width = 3 Width = 3
Align = alLeft Align = alLeft
@ -167,69 +187,70 @@ object MainForm: TMainForm
end end
object Panel2: TPanel object Panel2: TPanel
Left = 465 Left = 465
Height = 535 Height = 551
Top = 0 Top = 0
Width = 160 Width = 160
Align = alRight Align = alRight
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 535 ClientHeight = 551
ClientWidth = 160 ClientWidth = 160
TabOrder = 1 TabOrder = 1
object Label3: TLabel object Label3: TLabel
Left = 11 Left = 83
Height = 15 Height = 15
Top = 230 Top = 230
Width = 68 Width = 65
Caption = 'Border width' Caption = 'Btn distance'
ParentColor = False ParentColor = False
end end
object EdBorderWidth: TSpinEdit object EdButtonDistance: TSpinEdit
Left = 11 Left = 83
Height = 23 Height = 23
Top = 250 Top = 250
Width = 58 Width = 58
Alignment = taRightJustify Alignment = taRightJustify
MaxValue = 16 MaxValue = 16
OnChange = EdBorderWidthChange OnChange = EdButtonDistanceChange
TabOrder = 0 TabOrder = 0
Value = 1 Value = 1
end end
object Label4: TLabel object Label4: TLabel
Left = 94 Left = 10
Height = 15 Height = 15
Top = 286 Top = 230
Width = 40 Width = 40
Caption = 'Btn size' Caption = 'Btn size'
ParentColor = False ParentColor = False
end end
object EdBoxSize: TSpinEdit object EdBoxSize: TSpinEdit
Left = 94 Left = 10
Height = 23 Height = 23
Top = 306 Top = 250
Width = 54 Width = 59
Alignment = taRightJustify Alignment = taRightJustify
MinValue = 1 MinValue = 1
OnChange = EdBoxSizeChange OnChange = EdBoxSizeChange
TabOrder = 1 TabOrder = 1
Value = 16 Value = 16
end end
object LblPickMode1: TLabel object LblButtonBorderColor: TLabel
Left = 11 Left = 10
Height = 15 Height = 15
Top = 176 Top = 176
Width = 68 Width = 89
Caption = 'Border color:' Caption = 'Btn border color:'
FocusControl = CbButtonBorderColor
ParentColor = False ParentColor = False
end end
object CbBorderColor: TColorBox object CbButtonBorderColor: TColorBox
Left = 11 Left = 10
Height = 22 Height = 22
Top = 196 Top = 196
Width = 137 Width = 138
NoneColorColor = clWindow NoneColorColor = clWindow
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbIncludeNone] Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbIncludeNone]
ItemHeight = 16 ItemHeight = 16
OnSelect = CbBorderColorSelect OnSelect = CbButtonBorderColorSelect
TabOrder = 2 TabOrder = 2
end end
object CbPickMode: TComboBox object CbPickMode: TComboBox
@ -320,7 +341,7 @@ object MainForm: TMainForm
end end
object Bevel2: TBevel object Bevel2: TBevel
Left = 462 Left = 462
Height = 519 Height = 535
Top = 8 Top = 8
Width = 3 Width = 3
Align = alRight Align = alRight
@ -330,36 +351,40 @@ object MainForm: TMainForm
end end
object ScrollBox1: TScrollBox object ScrollBox1: TScrollBox
Left = 168 Left = 168
Height = 519 Height = 535
Top = 8 Top = 8
Width = 287 Width = 287
HorzScrollBar.Increment = 12 HorzScrollBar.Increment = 16
HorzScrollBar.Page = 129 HorzScrollBar.Page = 160
HorzScrollBar.Smooth = True HorzScrollBar.Smooth = True
HorzScrollBar.Tracking = True HorzScrollBar.Tracking = True
VertScrollBar.Increment = 3 VertScrollBar.Increment = 4
VertScrollBar.Page = 34 VertScrollBar.Page = 41
VertScrollBar.Smooth = True VertScrollBar.Smooth = True
VertScrollBar.Tracking = True VertScrollBar.Tracking = True
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderStyle = bsNone BorderStyle = bsNone
ClientHeight = 519 ClientHeight = 535
ClientWidth = 287 ClientWidth = 287
TabOrder = 2 TabOrder = 2
object ColorPalette: TColorPalette object ColorPalette: TColorPalette
Left = 0 Left = 0
Height = 33 Height = 40
Hint = 'Click to select a color' Hint = 'Click to select a color'
Top = 1 Top = 1
Width = 129 Width = 160
ButtonWidth = 16 ButtonHeight = 20
ButtonHeight = 16 ButtonWidth = 20
ColumnCount = 8 ColumnCount = 8
PickShift = [ssLeft, ssMiddle] PickShift = [ssLeft, ssMiddle]
OnGetHintText = ColorPaletteGetHintText OnGetHintText = ColorPaletteGetHintText
OnSelectColor = ColorPaletteSelectColor OnSelectColor = ColorPaletteSelectColor
ParentColor = False
PopupMenu = PalettePopupMenu PopupMenu = PalettePopupMenu
OnDblClick = ColorPaletteDblClick OnDblClick = ColorPaletteDblClick
OnMouseMove = ColorPaletteMouseMove
OnMouseEnter = ColorPaletteMouseEnter
OnMouseLeave = ColorPaletteMouseLeave
end end
end end
object ColorDialog: TColorDialog object ColorDialog: TColorDialog

70
components/colorpalette/demo/unit1.pas
View File

@ -25,23 +25,25 @@ type
CbBuiltinPalettes: TComboBox; CbBuiltinPalettes: TComboBox;
CbShowSelection: TCheckBox; CbShowSelection: TCheckBox;
CbShowColorHints: TCheckBox; CbShowColorHints: TCheckBox;
CbBorderColor: TColorBox; CbButtonBorderColor: TColorBox;
CbCustomHintText: TCheckBox; CbCustomHintText: TCheckBox;
CbUseSpacers: TCheckBox; CbUseSpacers: TCheckBox;
ColorDialog: TColorDialog; ColorDialog: TColorDialog;
ColorPalette: TColorPalette; ColorPalette: TColorPalette;
CbPickMode: TComboBox; CbPickMode: TComboBox;
EdBorderWidth: TSpinEdit; MouseColorSample: TShape;
EdButtonDistance: TSpinEdit;
EdBoxSize: TSpinEdit; EdBoxSize: TSpinEdit;
EdGradientSteps: TSpinEdit; EdGradientSteps: TSpinEdit;
Label3: TLabel; Label3: TLabel;
Label4: TLabel; Label4: TLabel;
LblMouseColorInfo: TLabel;
LblGradientSteps: TLabel; LblGradientSteps: TLabel;
LblPickMode: TLabel; LblPickMode: TLabel;
EdColCount: TSpinEdit; EdColCount: TSpinEdit;
Label2: TLabel; Label2: TLabel;
LblColorInfo: TLabel; LblColorInfo: TLabel;
LblPickMode1: TLabel; LblButtonBorderColor: TLabel;
LblPickMode2: TLabel; LblPickMode2: TLabel;
MnuEditPickedColor: TMenuItem; MnuEditPickedColor: TMenuItem;
MnuDeletePickedColor: TMenuItem; MnuDeletePickedColor: TMenuItem;
@ -63,13 +65,17 @@ type
procedure CbPickModeSelect(Sender: TObject); procedure CbPickModeSelect(Sender: TObject);
procedure CbShowColorHintsChange(Sender: TObject); procedure CbShowColorHintsChange(Sender: TObject);
procedure CbShowSelectionChange(Sender: TObject); procedure CbShowSelectionChange(Sender: TObject);
procedure CbBorderColorSelect(Sender: TObject); procedure CbButtonBorderColorSelect(Sender: TObject);
procedure CbUseSpacersChange(Sender: TObject); procedure CbUseSpacersChange(Sender: TObject);
procedure ColorPaletteDblClick(Sender: TObject); procedure ColorPaletteDblClick(Sender: TObject);
procedure ColorPaletteGetHintText(Sender: TObject; AColor: TColor; procedure ColorPaletteGetHintText(Sender: TObject; AColor: TColor;
var AText: String); var AText: String);
procedure ColorPaletteMouseEnter(Sender: TObject);
procedure ColorPaletteMouseLeave(Sender: TObject);
procedure ColorPaletteMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ColorPaletteSelectColor(Sender: TObject; AColor: TColor); procedure ColorPaletteSelectColor(Sender: TObject; AColor: TColor);
procedure EdBorderWidthChange(Sender: TObject); procedure EdButtonDistanceChange(Sender: TObject);
procedure EdBoxSizeChange(Sender: TObject); procedure EdBoxSizeChange(Sender: TObject);
procedure EdColCountChange(Sender: TObject); procedure EdColCountChange(Sender: TObject);
procedure EdGradientStepsChange(Sender: TObject); procedure EdGradientStepsChange(Sender: TObject);
@ -79,7 +85,7 @@ type
private private
{ private declarations } { private declarations }
procedure EditCurColor; procedure EditCurColor;
procedure SetColorInfo(ATitle: string; AColor: TColor); procedure SetColorInfo(ALabel: TLabel; ATitle: string; AColor: TColor);
procedure UpdateCaption; procedure UpdateCaption;
procedure UpdatePalette; procedure UpdatePalette;
public public
@ -138,7 +144,7 @@ begin
ColorSample.Brush.Style := bsClear else ColorSample.Brush.Style := bsClear else
ColorSample.Brush.Style := bsSolid; ColorSample.Brush.Style := bsSolid;
UpdateCaption; UpdateCaption;
SetColorInfo('Current', Colors[SelectedIndex]); SetColorInfo(LblColorInfo, 'Current', Colors[SelectedIndex]);
end; end;
end; end;
@ -178,9 +184,9 @@ begin
UpdatePalette; UpdatePalette;
end; end;
procedure TMainForm.CbBorderColorSelect(Sender: TObject); procedure TMainForm.CbButtonBorderColorSelect(Sender: TObject);
begin begin
ColorPalette.BorderColor := CbBorderColor.Selected; ColorPalette.ButtonBorderColor := CbButtonBorderColor.Selected;
end; end;
procedure TMainForm.CbBuiltinPalettesSelect(Sender: TObject); procedure TMainForm.CbBuiltinPalettesSelect(Sender: TObject);
@ -230,7 +236,7 @@ begin
ColorPalette.Colors[ColorPalette.SelectedIndex] := Color; ColorPalette.Colors[ColorPalette.SelectedIndex] := Color;
ColorSample.Brush.Color := Color; ColorSample.Brush.Color := Color;
ColorSample.Brush.Style := bsSolid; ColorSample.Brush.Style := bsSolid;
SetColorInfo('Current', Color); SetColorInfo(LblColorInfo, 'Current', Color);
with BtnEditColor do with BtnEditColor do
begin begin
Caption := 'Edit'; Caption := 'Edit';
@ -248,20 +254,42 @@ begin
]); ]);
end; end;
procedure TMainForm.ColorPaletteMouseEnter(Sender: TObject);
begin
MouseColorSample.Show;
LblMouseColorInfo.Show;
end;
procedure TMainForm.ColorPaletteMouseLeave(Sender: TObject);
begin
MouseColorSample.Hide;
LblMouseColorInfo.Hide;
end;
procedure TMainForm.ColorPaletteMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
MousecolorSample.Brush.Color := Colorpalette.MouseColor;
if MouseColorSample.Brush.Color = clNone then
MouseColorSample.Brush.Style := bsClear else
MouseColorSample.Brush.Style := bsSolid;
SetColorInfo(LblMouseColorInfo, 'MouseColor', MouseColorSample.Brush.Color);
end;
procedure TMainForm.ColorPaletteSelectColor(Sender: TObject; AColor: TColor); procedure TMainForm.ColorPaletteSelectColor(Sender: TObject; AColor: TColor);
begin begin
ColorSample.Brush.Color := AColor; ColorSample.Brush.Color := AColor;
if AColor = clNone then if AColor = clNone then
ColorSample.Brush.Style := bsClear else ColorSample.Brush.Style := bsClear else
ColorSample.Brush.Style := bsSolid; ColorSample.Brush.Style := bsSolid;
SetColorInfo('SelectedColor', AColor); SetColorInfo(LblColorInfo, 'SelectedColor', AColor);
BtnDeleteColor.Caption := 'Delete color #' + IntToStr(ColorPalette.SelectedIndex); BtnDeleteColor.Caption := 'Delete color #' + IntToStr(ColorPalette.SelectedIndex);
UpdateCaption; UpdateCaption;
end; end;
procedure TMainForm.EdBorderWidthChange(Sender: TObject); procedure TMainForm.EdButtonDistanceChange(Sender: TObject);
begin begin
ColorPalette.BorderWidth := EdBorderWidth.Value; ColorPalette.ButtonDistance := EdButtonDistance.Value;
end; end;
procedure TMainForm.EdBoxSizeChange(Sender: TObject); procedure TMainForm.EdBoxSizeChange(Sender: TObject);
@ -295,7 +323,7 @@ begin
begin begin
BtnEditColor.caption := 'Update >'; BtnEditColor.caption := 'Update >';
BtnEditColor.hint := 'Update palette'; BtnEditColor.hint := 'Update palette';
SetColorInfo('New color', ColorSample.Brush.Color); SetColorInfo(LblColorInfo, 'New color', ColorSample.Brush.Color);
end; end;
end; end;
@ -306,12 +334,12 @@ begin
CbPickMode.ItemIndex := ord(ColorPalette.PickMode); CbPickMode.ItemIndex := ord(ColorPalette.PickMode);
CbShowSelection.Checked := ColorPalette.ShowSelection; CbShowSelection.Checked := ColorPalette.ShowSelection;
CbShowColorHints.Checked := ColorPalette.ShowColorHint; CbShowColorHints.Checked := ColorPalette.ShowColorHint;
CbBorderColor.Selected := ColorPalette.SelectedColor; CbButtonBorderColor.Selected := ColorPalette.SelectedColor;
EdBorderWidth.Value := ColorPalette.BorderWidth; EdButtonDistance.Value := ColorPalette.ButtonDistance;
EdBoxSize.Value := ColorPalette.ButtonWidth; EdBoxSize.Value := ColorPalette.ButtonWidth;
ColorSample.Brush.Color := ColorPalette.SelectedColor; ColorSample.Brush.Color := ColorPalette.SelectedColor;
SetColorInfo('Current', ColorPalette.SelectedColor); SetColorInfo(LblColorInfo, 'Current', ColorPalette.SelectedColor);
UpdateCaption; UpdateCaption;
{ ColorPalette.PickShift must contain ssRight in order to be able to select { ColorPalette.PickShift must contain ssRight in order to be able to select
@ -331,14 +359,14 @@ begin
BtnEditColorClick(self); BtnEditColorClick(self);
end; end;
procedure TMainForm.SetColorInfo(ATitle: string; AColor: TColor); procedure TMainForm.SetColorInfo(ALabel: TLabel; ATitle: string; AColor: TColor);
begin begin
if AColor = clNone then if AColor = clNone then
LblColorInfo.Caption := Format( ALabel.Caption := Format(
'%s: None', [ATitle] '%s: None', [ATitle]
) )
else else
LblColorInfo.caption := Format( ALabel.caption := Format(
'%s: %s'#13+ '%s: %s'#13+
' red = %d'#13+ ' red = %d'#13+
' green = %d'#13+ ' green = %d'#13+
@ -358,7 +386,7 @@ end;
procedure TMainForm.UpdatePalette; procedure TMainForm.UpdatePalette;
begin begin
ColorPalette.Colors[ColorPalette.SelectedIndex] := ColorSample.Brush.Color; ColorPalette.Colors[ColorPalette.SelectedIndex] := ColorSample.Brush.Color;
SetColorInfo('Current', ColorSample.Brush.Color); SetColorInfo(LblColorInfo, 'Current', ColorSample.Brush.Color);
with BtnEditColor do with BtnEditColor do
begin begin
Caption := 'Edit'; Caption := 'Edit';