You've already forked lazarus-ccr
ColorPalette: Add MouseIndex and MouseColor. Restructure painting and layout calculation. Rename BorderWidth to ButtonDistance, BorderColor to ButtonBorderColor.
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
@ -76,6 +76,8 @@ type
|
||||
private
|
||||
FButtonHeight: Integer;
|
||||
FButtonWidth: Integer;
|
||||
FButtonBorderColor: TColor;
|
||||
FButtonDistance: Integer;
|
||||
FCols: Integer;
|
||||
FOnColorMouseMove: TColorMouseEvent;
|
||||
FOnColorPick: TColorMouseEvent;
|
||||
@ -94,17 +96,16 @@ type
|
||||
FShowColorHint: Boolean;
|
||||
FShowSelection: Boolean;
|
||||
FSavedHint: String;
|
||||
FBorderColor: TColor;
|
||||
FBorderWidth: Integer;
|
||||
FPaletteKind: TPaletteKind;
|
||||
FGradientSteps: Byte;
|
||||
FUseSpacers: Boolean;
|
||||
function GetColorCount: Integer;
|
||||
function GetColors(AIndex: Integer): TColor;
|
||||
function GetColorNames(AIndex: Integer): String;
|
||||
function GetMouseColor: TColor;
|
||||
function GetPickedColor: TColor;
|
||||
procedure SetBorderColor(const AValue: TColor);
|
||||
procedure SetBorderWidth(const AValue: Integer);
|
||||
procedure SetButtonBorderColor(const AValue: TColor);
|
||||
procedure SetButtonDistance(const AValue: Integer);
|
||||
procedure SetButtonHeight(const AValue: Integer);
|
||||
procedure SetButtonWidth(const AValue: Integer);
|
||||
procedure SetColorNames(AIndex: Integer; const AValue: String);
|
||||
@ -124,6 +125,9 @@ type
|
||||
procedure DoColorPick(AColor: TColor; AShift: TShiftState); virtual;
|
||||
procedure DoDeleteColor(AIndex: Integer); 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 IsCorrectShift(Shift: TShiftState): Boolean;
|
||||
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
|
||||
@ -132,8 +136,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 ButtonBorderColor: TColor read FButtonBorderColor write SetButtonBorderColor default clBlack;
|
||||
property ButtonDistance: Integer read FButtonDistance write SetButtonDistance default 0;
|
||||
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth;
|
||||
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight;
|
||||
property ColumnCount: Integer read FCols write SetCols;
|
||||
@ -161,6 +165,8 @@ type
|
||||
property Colors[Index: Integer]: TColor read GetColors write SetColors;
|
||||
property ColorNames[Index: Integer]: String read GetColorNames write SetColorNames;
|
||||
property ColorCount: Integer read GetColorCount;
|
||||
property MouseIndex: Integer read FMouseIndex;
|
||||
property MouseColor: TColor read GetMouseColor;
|
||||
property PickedColor: TColor read GetPickedColor; deprecated 'Use SelectedColor';
|
||||
property SelectedColor: TColor read FSelectedColor;
|
||||
|
||||
@ -175,10 +181,10 @@ type
|
||||
TColorPalette = class(TCustomColorPalette)
|
||||
published
|
||||
// inherited from TCustomColorPalette
|
||||
property BorderColor;
|
||||
property BorderWidth;
|
||||
property ButtonWidth;
|
||||
property ButtonBorderColor;
|
||||
property ButtonDistance;
|
||||
property ButtonHeight;
|
||||
property ButtonWidth;
|
||||
property ColumnCount;
|
||||
property GradientSteps;
|
||||
property PaletteKind;
|
||||
@ -198,7 +204,7 @@ type
|
||||
property Align;
|
||||
property Anchors;
|
||||
property BorderSpacing;
|
||||
property Color;
|
||||
property Color default clNone;
|
||||
property Constraints;
|
||||
property DragCursor;
|
||||
property DragKind;
|
||||
@ -230,6 +236,9 @@ implementation
|
||||
uses
|
||||
LCLIntf, StrUtils;
|
||||
|
||||
const
|
||||
SELMARGIN = 1; // extra margin for selection rectangle
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('Misc', [TColorPalette]);
|
||||
@ -242,12 +251,13 @@ constructor TCustomColorPalette.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
ControlStyle := ControlStyle + [csFixedWidth, csFixedHeight];
|
||||
Color := clNone;
|
||||
|
||||
FColors := TStringList.Create;
|
||||
FBorderColor := clBlack;
|
||||
FBorderWidth := 1;
|
||||
FButtonWidth := 12;
|
||||
FButtonBorderColor := clBlack;
|
||||
FButtonDistance := 0;
|
||||
FButtonHeight := 12;
|
||||
FButtonWidth := 12;
|
||||
FPrevMouseIndex := -1;
|
||||
FPickMode := pmImmediate;
|
||||
FPickShift := [ssLeft];
|
||||
@ -372,6 +382,11 @@ begin
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function TCustomColorPalette.GetMouseColor: TColor;
|
||||
begin
|
||||
Result := GetColors(FMouseIndex);
|
||||
end;
|
||||
|
||||
function TCustomColorPalette.GetColors(AIndex: Integer): TColor;
|
||||
begin
|
||||
if (AIndex >= 0) and (AIndex < FColors.Count) then
|
||||
@ -380,6 +395,41 @@ begin
|
||||
Result := clNone;
|
||||
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;
|
||||
const
|
||||
INDENT = '* ';
|
||||
@ -546,10 +596,7 @@ begin
|
||||
FMousePt.X := X;
|
||||
FMousePt.Y := Y;
|
||||
|
||||
X := X div FButtonWidth;
|
||||
Y := Y div FButtonHeight;
|
||||
|
||||
FMouseIndex := X + Y * FCols;
|
||||
FMouseIndex := GetColorIndex(X, Y);
|
||||
FPrevMouseIndex := FMouseIndex;
|
||||
|
||||
if FMouseIndex < 0 then
|
||||
@ -573,6 +620,7 @@ procedure TCustomColorPalette.MouseLeave;
|
||||
begin
|
||||
inherited;
|
||||
Hint := FSavedHint;
|
||||
FMouseIndex := -1;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
@ -581,8 +629,7 @@ var
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FMouseIndex := X div FButtonWidth + (Y div FButtonHeight) * FCols;
|
||||
|
||||
FMouseIndex := GetColorIndex(X, Y);
|
||||
if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) then
|
||||
begin
|
||||
C := GetColors(FMouseIndex);
|
||||
@ -615,9 +662,7 @@ begin
|
||||
ColorPick(FMouseIndex, FStoredShift);
|
||||
pmImmediate, pmContinuous:
|
||||
begin
|
||||
X := X div FButtonWidth;
|
||||
Y := Y div FButtonHeight;
|
||||
FMouseIndex := X + Y * FCols;
|
||||
FMouseIndex := GetColorIndex(X, Y);
|
||||
if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and
|
||||
(FMouseIndex <> FPrevMouseIndex) then
|
||||
begin
|
||||
@ -638,28 +683,34 @@ procedure TCustomColorPalette.Paint;
|
||||
exit;
|
||||
|
||||
// Fill interior
|
||||
Canvas.Pen.Color := FButtonBorderColor;
|
||||
Canvas.Pen.Width := 1;
|
||||
Canvas.Pen.Style := psSolid;
|
||||
if c = clNone then
|
||||
begin
|
||||
Canvas.Pen.Color := clBlack;
|
||||
Canvas.Pen.Width := 1;
|
||||
Canvas.Pen.Style := psSolid;
|
||||
if Canvas.Pen.Color = clNone then
|
||||
Canvas.Pen.Color := FButtonBorderColor;
|
||||
Canvas.Line(x1, y1, x2, y2);
|
||||
Canvas.Line(x1, y2, x2, y1);
|
||||
Canvas.Brush.Style := bsClear;
|
||||
Canvas.Rectangle(x1, y1, x2, y2);
|
||||
end else
|
||||
begin
|
||||
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;
|
||||
|
||||
// Paint border
|
||||
if (FBorderColor <> clNone) and (FBorderWidth > 0) then
|
||||
// Paint background between the color buttons
|
||||
if ((Color <> clNone) and (FButtonDistance > 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;
|
||||
x1 := x1 - FButtonDistance div 2 - FButtonDistance mod 2;
|
||||
y1 := y1 - FButtonDistance div 2 - FButtonDistance mod 2;
|
||||
x2 := x1 + FButtonWidth - FButtonDistance;
|
||||
y2 := y1 + FButtonHeight - FButtonDistance;
|
||||
Canvas.Pen.Color := Color;
|
||||
Canvas.Pen.Width := FButtonDistance;
|
||||
Canvas.MoveTo(x1, y1);
|
||||
Canvas.LineTo(x2, y1);
|
||||
Canvas.LineTo(x2, y2);
|
||||
@ -669,44 +720,39 @@ procedure TCustomColorPalette.Paint;
|
||||
end;
|
||||
|
||||
var
|
||||
I, X, Y, W, H, d: Integer;
|
||||
c: TColor;
|
||||
I, X, Y: Integer;
|
||||
Rsel: TRect;
|
||||
xmax: Integer;
|
||||
begin
|
||||
Canvas.Pen.Endcap := pecSquare;
|
||||
|
||||
// Paint color boxes
|
||||
X := FBorderWidth;
|
||||
Y := FBorderWidth;
|
||||
W := FButtonWidth - FBorderWidth;
|
||||
H := FButtonHeight - FBorderWidth;
|
||||
X := SELMARGIN;
|
||||
Y := SELMARGIN;
|
||||
xmax := Width - SELMARGIN;
|
||||
if (FButtonDistance = 0) and (FButtonBordercolor <> clNone) then dec(xmax);
|
||||
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
|
||||
Rsel := Bounds(X, Y, FButtonWidth, FButtonHeight);
|
||||
PaintBox(X, Y, X + FButtonWidth, Y + FButtonHeight, GetColors(I));
|
||||
inc(X, GetCellWidth);
|
||||
if (FButtonDistance = 0) and (FButtonBorderColor <> clNone) then dec(X);
|
||||
if X >= xmax then
|
||||
begin
|
||||
inc(Y, FButtonHeight);
|
||||
X := FBorderWidth;
|
||||
inc(Y, GetCellHeight);
|
||||
if (FButtonDistance = 0) and (FButtonBorderColor <> clNone) then dec(Y);
|
||||
X := SELMARGIN;
|
||||
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.Color := InvertColor(GetColors(FSelectedIndex));
|
||||
Canvas.Pen.Width := 3;
|
||||
Canvas.Pen.Style := psSolid;
|
||||
Canvas.Brush.Style := bsSolid;
|
||||
Canvas.Brush.Style := bsClear;
|
||||
InflateRect(Rsel, d, d);
|
||||
Canvas.Rectangle(Rsel);
|
||||
end;
|
||||
end;
|
||||
@ -741,17 +787,17 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.SetBorderColor(const AValue: TColor);
|
||||
procedure TCustomColorPalette.SetButtonBorderColor(const AValue: TColor);
|
||||
begin
|
||||
if FBorderColor = AValue then exit;
|
||||
FBorderColor := AValue;
|
||||
if FButtonBorderColor = AValue then exit;
|
||||
FButtonBorderColor := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.SetBorderWidth(const AValue: Integer);
|
||||
procedure TCustomColorPalette.SetButtonDistance(const AValue: Integer);
|
||||
begin
|
||||
if FBorderWidth = AValue then exit;
|
||||
FBorderWidth := AValue;
|
||||
if FButtonDistance = AValue then exit;
|
||||
FButtonDistance := AValue;
|
||||
UpdateSize;
|
||||
Invalidate;
|
||||
end;
|
||||
@ -1243,12 +1289,23 @@ begin
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.UpdateSize;
|
||||
var
|
||||
d, dx, dy: Integer;
|
||||
begin
|
||||
if (FCols = 0) or (FColors.Count = 0) then FRows := 0
|
||||
else
|
||||
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;
|
||||
|
||||
|
||||
|
||||
@ -1,22 +1,22 @@
|
||||
object MainForm: TMainForm
|
||||
Left = 394
|
||||
Height = 535
|
||||
Height = 551
|
||||
Top = 287
|
||||
Width = 625
|
||||
Caption = 'MainForm'
|
||||
ClientHeight = 535
|
||||
ClientHeight = 551
|
||||
ClientWidth = 625
|
||||
OnCreate = FormCreate
|
||||
ShowHint = True
|
||||
LCLVersion = '1.5'
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 535
|
||||
Height = 551
|
||||
Top = 0
|
||||
Width = 160
|
||||
Align = alLeft
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 535
|
||||
ClientHeight = 551
|
||||
ClientWidth = 160
|
||||
TabOrder = 0
|
||||
object ColorSample: TShape
|
||||
@ -50,7 +50,7 @@ object MainForm: TMainForm
|
||||
object BtnLoadRndPalette: TButton
|
||||
Left = 10
|
||||
Height = 25
|
||||
Top = 308
|
||||
Top = 408
|
||||
Width = 137
|
||||
Caption = 'Load random palette'
|
||||
Enabled = False
|
||||
@ -60,7 +60,7 @@ object MainForm: TMainForm
|
||||
object BtnCreateRndPalette: TButton
|
||||
Left = 10
|
||||
Height = 25
|
||||
Top = 279
|
||||
Top = 379
|
||||
Width = 137
|
||||
Caption = 'Create random palette'
|
||||
OnClick = BtnCreateRndPaletteClick
|
||||
@ -69,7 +69,7 @@ object MainForm: TMainForm
|
||||
object BtnAddColor: TButton
|
||||
Left = 10
|
||||
Height = 25
|
||||
Top = 385
|
||||
Top = 485
|
||||
Width = 137
|
||||
Caption = 'Add color...'
|
||||
OnClick = BtnAddColorClick
|
||||
@ -78,7 +78,7 @@ object MainForm: TMainForm
|
||||
object BtnLoadDefaultPal: TButton
|
||||
Left = 10
|
||||
Height = 25
|
||||
Top = 239
|
||||
Top = 339
|
||||
Width = 137
|
||||
Caption = 'Load palette...'
|
||||
OnClick = BtnLoadDefaultPalClick
|
||||
@ -87,7 +87,7 @@ object MainForm: TMainForm
|
||||
object BtnDeleteColor: TButton
|
||||
Left = 10
|
||||
Height = 25
|
||||
Top = 414
|
||||
Top = 514
|
||||
Width = 137
|
||||
Caption = 'Delete color #0'
|
||||
OnClick = BtnDeleteColorClick
|
||||
@ -96,7 +96,7 @@ object MainForm: TMainForm
|
||||
object BtnLoadDefaultPal1: TButton
|
||||
Left = 10
|
||||
Height = 25
|
||||
Top = 346
|
||||
Top = 446
|
||||
Width = 137
|
||||
Caption = 'Save palette...'
|
||||
TabOrder = 6
|
||||
@ -104,7 +104,7 @@ object MainForm: TMainForm
|
||||
object LblGradientSteps: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Top = 176
|
||||
Top = 276
|
||||
Width = 116
|
||||
Caption = 'Built-in gradient steps'
|
||||
Enabled = False
|
||||
@ -113,7 +113,7 @@ object MainForm: TMainForm
|
||||
object EdGradientSteps: TSpinEdit
|
||||
Left = 10
|
||||
Height = 23
|
||||
Top = 196
|
||||
Top = 296
|
||||
Width = 59
|
||||
Alignment = taRightJustify
|
||||
Enabled = False
|
||||
@ -126,7 +126,7 @@ object MainForm: TMainForm
|
||||
object LblPickMode2: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Top = 124
|
||||
Top = 224
|
||||
Width = 83
|
||||
Caption = 'Built-in palettes'
|
||||
ParentColor = False
|
||||
@ -135,7 +135,7 @@ object MainForm: TMainForm
|
||||
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 = 144
|
||||
Top = 244
|
||||
Width = 137
|
||||
ItemHeight = 15
|
||||
ItemIndex = 0
|
||||
@ -154,10 +154,30 @@ object MainForm: TMainForm
|
||||
TabOrder = 8
|
||||
Text = 'Standard palette'
|
||||
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
|
||||
object Bevel1: TBevel
|
||||
Left = 160
|
||||
Height = 519
|
||||
Height = 535
|
||||
Top = 8
|
||||
Width = 3
|
||||
Align = alLeft
|
||||
@ -167,69 +187,70 @@ object MainForm: TMainForm
|
||||
end
|
||||
object Panel2: TPanel
|
||||
Left = 465
|
||||
Height = 535
|
||||
Height = 551
|
||||
Top = 0
|
||||
Width = 160
|
||||
Align = alRight
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 535
|
||||
ClientHeight = 551
|
||||
ClientWidth = 160
|
||||
TabOrder = 1
|
||||
object Label3: TLabel
|
||||
Left = 11
|
||||
Left = 83
|
||||
Height = 15
|
||||
Top = 230
|
||||
Width = 68
|
||||
Caption = 'Border width'
|
||||
Width = 65
|
||||
Caption = 'Btn distance'
|
||||
ParentColor = False
|
||||
end
|
||||
object EdBorderWidth: TSpinEdit
|
||||
Left = 11
|
||||
object EdButtonDistance: TSpinEdit
|
||||
Left = 83
|
||||
Height = 23
|
||||
Top = 250
|
||||
Width = 58
|
||||
Alignment = taRightJustify
|
||||
MaxValue = 16
|
||||
OnChange = EdBorderWidthChange
|
||||
OnChange = EdButtonDistanceChange
|
||||
TabOrder = 0
|
||||
Value = 1
|
||||
end
|
||||
object Label4: TLabel
|
||||
Left = 94
|
||||
Left = 10
|
||||
Height = 15
|
||||
Top = 286
|
||||
Top = 230
|
||||
Width = 40
|
||||
Caption = 'Btn size'
|
||||
ParentColor = False
|
||||
end
|
||||
object EdBoxSize: TSpinEdit
|
||||
Left = 94
|
||||
Left = 10
|
||||
Height = 23
|
||||
Top = 306
|
||||
Width = 54
|
||||
Top = 250
|
||||
Width = 59
|
||||
Alignment = taRightJustify
|
||||
MinValue = 1
|
||||
OnChange = EdBoxSizeChange
|
||||
TabOrder = 1
|
||||
Value = 16
|
||||
end
|
||||
object LblPickMode1: TLabel
|
||||
Left = 11
|
||||
object LblButtonBorderColor: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Top = 176
|
||||
Width = 68
|
||||
Caption = 'Border color:'
|
||||
Width = 89
|
||||
Caption = 'Btn border color:'
|
||||
FocusControl = CbButtonBorderColor
|
||||
ParentColor = False
|
||||
end
|
||||
object CbBorderColor: TColorBox
|
||||
Left = 11
|
||||
object CbButtonBorderColor: TColorBox
|
||||
Left = 10
|
||||
Height = 22
|
||||
Top = 196
|
||||
Width = 137
|
||||
Width = 138
|
||||
NoneColorColor = clWindow
|
||||
Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbIncludeNone]
|
||||
ItemHeight = 16
|
||||
OnSelect = CbBorderColorSelect
|
||||
OnSelect = CbButtonBorderColorSelect
|
||||
TabOrder = 2
|
||||
end
|
||||
object CbPickMode: TComboBox
|
||||
@ -320,7 +341,7 @@ object MainForm: TMainForm
|
||||
end
|
||||
object Bevel2: TBevel
|
||||
Left = 462
|
||||
Height = 519
|
||||
Height = 535
|
||||
Top = 8
|
||||
Width = 3
|
||||
Align = alRight
|
||||
@ -330,36 +351,40 @@ object MainForm: TMainForm
|
||||
end
|
||||
object ScrollBox1: TScrollBox
|
||||
Left = 168
|
||||
Height = 519
|
||||
Height = 535
|
||||
Top = 8
|
||||
Width = 287
|
||||
HorzScrollBar.Increment = 12
|
||||
HorzScrollBar.Page = 129
|
||||
HorzScrollBar.Increment = 16
|
||||
HorzScrollBar.Page = 160
|
||||
HorzScrollBar.Smooth = True
|
||||
HorzScrollBar.Tracking = True
|
||||
VertScrollBar.Increment = 3
|
||||
VertScrollBar.Page = 34
|
||||
VertScrollBar.Increment = 4
|
||||
VertScrollBar.Page = 41
|
||||
VertScrollBar.Smooth = True
|
||||
VertScrollBar.Tracking = True
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
BorderStyle = bsNone
|
||||
ClientHeight = 519
|
||||
ClientHeight = 535
|
||||
ClientWidth = 287
|
||||
TabOrder = 2
|
||||
object ColorPalette: TColorPalette
|
||||
Left = 0
|
||||
Height = 33
|
||||
Height = 40
|
||||
Hint = 'Click to select a color'
|
||||
Top = 1
|
||||
Width = 129
|
||||
ButtonWidth = 16
|
||||
ButtonHeight = 16
|
||||
Width = 160
|
||||
ButtonHeight = 20
|
||||
ButtonWidth = 20
|
||||
ColumnCount = 8
|
||||
PickShift = [ssLeft, ssMiddle]
|
||||
OnGetHintText = ColorPaletteGetHintText
|
||||
OnSelectColor = ColorPaletteSelectColor
|
||||
ParentColor = False
|
||||
PopupMenu = PalettePopupMenu
|
||||
OnDblClick = ColorPaletteDblClick
|
||||
OnMouseMove = ColorPaletteMouseMove
|
||||
OnMouseEnter = ColorPaletteMouseEnter
|
||||
OnMouseLeave = ColorPaletteMouseLeave
|
||||
end
|
||||
end
|
||||
object ColorDialog: TColorDialog
|
||||
|
||||
@ -25,23 +25,25 @@ type
|
||||
CbBuiltinPalettes: TComboBox;
|
||||
CbShowSelection: TCheckBox;
|
||||
CbShowColorHints: TCheckBox;
|
||||
CbBorderColor: TColorBox;
|
||||
CbButtonBorderColor: TColorBox;
|
||||
CbCustomHintText: TCheckBox;
|
||||
CbUseSpacers: TCheckBox;
|
||||
ColorDialog: TColorDialog;
|
||||
ColorPalette: TColorPalette;
|
||||
CbPickMode: TComboBox;
|
||||
EdBorderWidth: TSpinEdit;
|
||||
MouseColorSample: TShape;
|
||||
EdButtonDistance: TSpinEdit;
|
||||
EdBoxSize: TSpinEdit;
|
||||
EdGradientSteps: TSpinEdit;
|
||||
Label3: TLabel;
|
||||
Label4: TLabel;
|
||||
LblMouseColorInfo: TLabel;
|
||||
LblGradientSteps: TLabel;
|
||||
LblPickMode: TLabel;
|
||||
EdColCount: TSpinEdit;
|
||||
Label2: TLabel;
|
||||
LblColorInfo: TLabel;
|
||||
LblPickMode1: TLabel;
|
||||
LblButtonBorderColor: TLabel;
|
||||
LblPickMode2: TLabel;
|
||||
MnuEditPickedColor: TMenuItem;
|
||||
MnuDeletePickedColor: TMenuItem;
|
||||
@ -63,13 +65,17 @@ type
|
||||
procedure CbPickModeSelect(Sender: TObject);
|
||||
procedure CbShowColorHintsChange(Sender: TObject);
|
||||
procedure CbShowSelectionChange(Sender: TObject);
|
||||
procedure CbBorderColorSelect(Sender: TObject);
|
||||
procedure CbButtonBorderColorSelect(Sender: TObject);
|
||||
procedure CbUseSpacersChange(Sender: TObject);
|
||||
procedure ColorPaletteDblClick(Sender: TObject);
|
||||
procedure ColorPaletteGetHintText(Sender: TObject; AColor: TColor;
|
||||
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 EdBorderWidthChange(Sender: TObject);
|
||||
procedure EdButtonDistanceChange(Sender: TObject);
|
||||
procedure EdBoxSizeChange(Sender: TObject);
|
||||
procedure EdColCountChange(Sender: TObject);
|
||||
procedure EdGradientStepsChange(Sender: TObject);
|
||||
@ -79,7 +85,7 @@ type
|
||||
private
|
||||
{ private declarations }
|
||||
procedure EditCurColor;
|
||||
procedure SetColorInfo(ATitle: string; AColor: TColor);
|
||||
procedure SetColorInfo(ALabel: TLabel; ATitle: string; AColor: TColor);
|
||||
procedure UpdateCaption;
|
||||
procedure UpdatePalette;
|
||||
public
|
||||
@ -138,7 +144,7 @@ begin
|
||||
ColorSample.Brush.Style := bsClear else
|
||||
ColorSample.Brush.Style := bsSolid;
|
||||
UpdateCaption;
|
||||
SetColorInfo('Current', Colors[SelectedIndex]);
|
||||
SetColorInfo(LblColorInfo, 'Current', Colors[SelectedIndex]);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -178,9 +184,9 @@ begin
|
||||
UpdatePalette;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbBorderColorSelect(Sender: TObject);
|
||||
procedure TMainForm.CbButtonBorderColorSelect(Sender: TObject);
|
||||
begin
|
||||
ColorPalette.BorderColor := CbBorderColor.Selected;
|
||||
ColorPalette.ButtonBorderColor := CbButtonBorderColor.Selected;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbBuiltinPalettesSelect(Sender: TObject);
|
||||
@ -230,7 +236,7 @@ begin
|
||||
ColorPalette.Colors[ColorPalette.SelectedIndex] := Color;
|
||||
ColorSample.Brush.Color := Color;
|
||||
ColorSample.Brush.Style := bsSolid;
|
||||
SetColorInfo('Current', Color);
|
||||
SetColorInfo(LblColorInfo, 'Current', Color);
|
||||
with BtnEditColor do
|
||||
begin
|
||||
Caption := 'Edit';
|
||||
@ -248,20 +254,42 @@ begin
|
||||
]);
|
||||
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);
|
||||
begin
|
||||
ColorSample.Brush.Color := AColor;
|
||||
if AColor = clNone then
|
||||
ColorSample.Brush.Style := bsClear else
|
||||
ColorSample.Brush.Style := bsSolid;
|
||||
SetColorInfo('SelectedColor', AColor);
|
||||
SetColorInfo(LblColorInfo, 'SelectedColor', AColor);
|
||||
BtnDeleteColor.Caption := 'Delete color #' + IntToStr(ColorPalette.SelectedIndex);
|
||||
UpdateCaption;
|
||||
end;
|
||||
|
||||
procedure TMainForm.EdBorderWidthChange(Sender: TObject);
|
||||
procedure TMainForm.EdButtonDistanceChange(Sender: TObject);
|
||||
begin
|
||||
ColorPalette.BorderWidth := EdBorderWidth.Value;
|
||||
ColorPalette.ButtonDistance := EdButtonDistance.Value;
|
||||
end;
|
||||
|
||||
procedure TMainForm.EdBoxSizeChange(Sender: TObject);
|
||||
@ -295,7 +323,7 @@ begin
|
||||
begin
|
||||
BtnEditColor.caption := 'Update >';
|
||||
BtnEditColor.hint := 'Update palette';
|
||||
SetColorInfo('New color', ColorSample.Brush.Color);
|
||||
SetColorInfo(LblColorInfo, 'New color', ColorSample.Brush.Color);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -306,12 +334,12 @@ begin
|
||||
CbPickMode.ItemIndex := ord(ColorPalette.PickMode);
|
||||
CbShowSelection.Checked := ColorPalette.ShowSelection;
|
||||
CbShowColorHints.Checked := ColorPalette.ShowColorHint;
|
||||
CbBorderColor.Selected := ColorPalette.SelectedColor;
|
||||
EdBorderWidth.Value := ColorPalette.BorderWidth;
|
||||
CbButtonBorderColor.Selected := ColorPalette.SelectedColor;
|
||||
EdButtonDistance.Value := ColorPalette.ButtonDistance;
|
||||
EdBoxSize.Value := ColorPalette.ButtonWidth;
|
||||
|
||||
ColorSample.Brush.Color := ColorPalette.SelectedColor;
|
||||
SetColorInfo('Current', ColorPalette.SelectedColor);
|
||||
SetColorInfo(LblColorInfo, 'Current', ColorPalette.SelectedColor);
|
||||
UpdateCaption;
|
||||
|
||||
{ ColorPalette.PickShift must contain ssRight in order to be able to select
|
||||
@ -331,14 +359,14 @@ begin
|
||||
BtnEditColorClick(self);
|
||||
end;
|
||||
|
||||
procedure TMainForm.SetColorInfo(ATitle: string; AColor: TColor);
|
||||
procedure TMainForm.SetColorInfo(ALabel: TLabel; ATitle: string; AColor: TColor);
|
||||
begin
|
||||
if AColor = clNone then
|
||||
LblColorInfo.Caption := Format(
|
||||
ALabel.Caption := Format(
|
||||
'%s: None', [ATitle]
|
||||
)
|
||||
else
|
||||
LblColorInfo.caption := Format(
|
||||
ALabel.caption := Format(
|
||||
'%s: %s'#13+
|
||||
' red = %d'#13+
|
||||
' green = %d'#13+
|
||||
@ -358,7 +386,7 @@ end;
|
||||
procedure TMainForm.UpdatePalette;
|
||||
begin
|
||||
ColorPalette.Colors[ColorPalette.SelectedIndex] := ColorSample.Brush.Color;
|
||||
SetColorInfo('Current', ColorSample.Brush.Color);
|
||||
SetColorInfo(LblColorInfo, 'Current', ColorSample.Brush.Color);
|
||||
with BtnEditColor do
|
||||
begin
|
||||
Caption := 'Edit';
|
||||
|
||||
Reference in New Issue
Block a user