ColorPalette: Some cosmetic changes. Add new event OnSelectColor (which fires if ShiftState matches, in contrast to OnColorPick which fires always now).
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4280 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
parent
7f5584ad24
commit
bec8c5ac86
@ -53,15 +53,16 @@ uses
|
||||
type
|
||||
|
||||
TPickMode = (
|
||||
pmDefault, // Select color at mouse-down, ColorPick event at mouse-up if at same pos
|
||||
pmImproved, // Select color and ColorPick event at mouse-down
|
||||
pmContinuous // Select color at mouse-down and mouse-move, ColorPick event at mouse-up
|
||||
pmDefault, // Select color at mouse-down, ColorPick event at mouse-up if at same pos
|
||||
pmImmediate, // Select color and ColorPick event at mouse-down
|
||||
pmContinuous // Select color at mouse-down and mouse-move, ColorPick event at mouse-up
|
||||
);
|
||||
|
||||
TPickShiftEnum = (ssLeft, ssRight, ssMiddle);
|
||||
TPickShift = set of TPickShiftEnum;
|
||||
|
||||
TColorMouseEvent = procedure (Sender: TObject; AColor: TColor; Shift: TShiftState) of object;
|
||||
TColorPaletteEvent = procedure (Sender: TObject; AColor: TColor) of object;
|
||||
|
||||
{ TCustomColorPalette }
|
||||
|
||||
@ -72,9 +73,11 @@ type
|
||||
FCols: Integer;
|
||||
FOnColorMouseMove: TColorMouseEvent;
|
||||
FOnColorPick: TColorMouseEvent;
|
||||
FOnSelectColor: TColorPaletteEvent;
|
||||
FRows: Integer;
|
||||
FColors: TList;
|
||||
FPickedColor: TColor;
|
||||
FSelectedColor: TColor; // same as PickedColor, but updated only if "IsCorrectShift"
|
||||
FPickMode: TPickMode;
|
||||
FPickShift: TPickShift;
|
||||
FMousePt: TPoint;
|
||||
@ -91,7 +94,9 @@ type
|
||||
procedure ColorPick(AColor: TColor; Shift: TShiftState); dynamic;
|
||||
procedure ColorMouseMove(AColor: TColor; Shift: TShiftState); dynamic;
|
||||
procedure DoAddColor(AColor: TColor); virtual;
|
||||
procedure DoColorPick(AColor: TColor; AShift: TShiftState); virtual;
|
||||
procedure DoDeleteColor(AIndex: Integer); virtual;
|
||||
procedure DoSelectColor(AColor: TColor); virtual;
|
||||
function IsCorrectShift(Shift: TShiftState): Boolean;
|
||||
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override;
|
||||
procedure MouseMove(Shift:TShiftState; X, Y:Integer); override;
|
||||
@ -114,8 +119,10 @@ type
|
||||
|
||||
property Colors[Index: Integer]: TColor read GetColors write SetColors;
|
||||
property ColorCount: Integer read GetColorCount;
|
||||
property PickedColor: TColor read FPickedColor;
|
||||
property PickedColor: TColor read FSelectedColor; deprecated 'Use SelectedColor';
|
||||
property SelectedColor: TColor read FSelectedColor;
|
||||
|
||||
property OnSelectColor: TColorPaletteEvent read FOnSelectColor write FOnSelectColor;
|
||||
property OnColorPick: TColorMouseEvent read FOnColorPick write FOnColorPick;
|
||||
property OnColorMouseMove: TColorMouseEvent read FOnColorMouseMove write FOnColorMouseMove;
|
||||
|
||||
@ -157,10 +164,12 @@ type
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnResize;
|
||||
property OnSelectColor;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
@ -168,169 +177,20 @@ begin
|
||||
RegisterComponents('Misc', [TColorPalette]);
|
||||
end;
|
||||
|
||||
|
||||
{ TCustomColorPalette }
|
||||
|
||||
procedure TCustomColorPalette.SetButtonHeight(const AValue: Integer);
|
||||
begin
|
||||
if FButtonHeight = AValue then Exit;
|
||||
FButtonHeight := AValue;
|
||||
if FButtonHeight < 1 then FButtonHeight := 1;
|
||||
UpdateSize;
|
||||
end;
|
||||
|
||||
function TCustomColorPalette.GetColorCount: Integer;
|
||||
begin
|
||||
Result := FColors.Count;
|
||||
end;
|
||||
|
||||
function TCustomColorPalette.GetColors(Index: Integer): TColor;
|
||||
begin
|
||||
Result := TColor(PtrUInt(FColors.Items[Index]));
|
||||
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(Index: Integer; const AValue: TColor);
|
||||
begin
|
||||
FColors.Items[Index] := Pointer(AValue);
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.SetCols(AValue: Integer);
|
||||
begin
|
||||
if AValue = FCols then
|
||||
exit;
|
||||
FCols := AValue;
|
||||
UpdateSize;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.UpdateSize;
|
||||
begin
|
||||
if (FCols = 0) or (FColors.Count = 0) then FRows := 0
|
||||
else
|
||||
FRows := Ceil(FColors.Count / FCols);
|
||||
|
||||
SetBounds(Left, Top, FCols * FButtonWidth + 1, FRows * FButtonHeight + 1);
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.MouseDown(Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FMousePt.X := X;
|
||||
FMousePt.Y := Y;
|
||||
|
||||
X := X div FButtonWidth;
|
||||
Y := Y div FButtonHeight;
|
||||
|
||||
FMouseIndex := X + Y * FCols;
|
||||
FPrevMouseIndex := FMouseIndex;
|
||||
|
||||
if FMouseIndex < 0 then
|
||||
Exit;
|
||||
|
||||
if (FMouseIndex < FColors.Count) then
|
||||
begin
|
||||
FPickedColor := GetColors(FMouseIndex);
|
||||
FStoredShift := Shift; // store for usage by pmDefault at MouseUp
|
||||
if FPickMode <> pmDefault then
|
||||
ColorPick(FPickedColor, Shift);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.MouseUp(Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
case FPickMode of
|
||||
pmDefault:
|
||||
if (FMousePt.X = X) and (FMousePt.Y = Y) then
|
||||
ColorPick(FPickedColor, FStoredShift);
|
||||
pmImproved, pmContinuous:
|
||||
begin
|
||||
X := X div FButtonWidth;
|
||||
Y := Y div FButtonHeight;
|
||||
FMouseIndex := X + Y * FCols;
|
||||
if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and
|
||||
(FMouseIndex <> FPrevMouseIndex) then
|
||||
begin
|
||||
FPickedColor := GetColors(FMouseIndex);
|
||||
ColorPick(FPickedColor, Shift);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
FPrevMouseIndex := -1;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
var
|
||||
C: TColor;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
X := X div FButtonWidth;
|
||||
Y := Y div FButtonHeight;
|
||||
|
||||
FMouseIndex := X + Y * FCols;
|
||||
if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and
|
||||
(FMouseIndex <> FPrevMouseIndex) then
|
||||
begin
|
||||
C := GetColors(FMouseIndex);
|
||||
if C <> clNone then
|
||||
ColorMouseMove(C, Shift);
|
||||
|
||||
if FPickMode = pmContinuous then begin
|
||||
FPickedColor := GetColors(FMouseIndex);
|
||||
ColorPick(FPickedColor, Shift);
|
||||
end;
|
||||
end;
|
||||
|
||||
FPrevMouseIndex := FMouseIndex;
|
||||
end;
|
||||
|
||||
function TCustomColorPalette.IsCorrectShift(Shift: TShiftState): Boolean;
|
||||
var
|
||||
ss: TShiftState;
|
||||
begin
|
||||
Result := True;
|
||||
if (ssLeft in FPickShift) and (Classes.ssLeft in Shift) then exit;
|
||||
if (ssRight in FPickShift) and (Classes.ssRight in Shift) then exit;
|
||||
if (ssMiddle in FPickShift) and (Classes.ssMiddle in Shift) then exit;
|
||||
Result := false;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.ColorPick(AColor: TColor; Shift: TShiftState);
|
||||
begin
|
||||
if IsCorrectShift(Shift) and Assigned(FOnColorPick) then
|
||||
FOnColorPick(Self, AColor, Shift);
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.ColorMouseMove(AColor: TColor; Shift: TShiftState);
|
||||
begin
|
||||
if IsCorrectShift(Shift) and Assigned(FOnColorMouseMove) then
|
||||
FOnColorMouseMove(Self, AColor, Shift);
|
||||
end;
|
||||
|
||||
constructor TCustomColorPalette.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
|
||||
ControlStyle := ControlStyle + [csFixedWidth, csFixedHeight];
|
||||
|
||||
FColors := TList.Create;
|
||||
FButtonWidth := 12;
|
||||
FButtonHeight := 12;
|
||||
FPrevMouseIndex := -1;
|
||||
FPickShift := [ssLeft];
|
||||
ControlStyle := ControlStyle + [csFixedWidth, csFixedHeight];
|
||||
|
||||
|
||||
FCols := 8;
|
||||
|
||||
DoAddColor(clBlack);
|
||||
@ -357,7 +217,6 @@ end;
|
||||
destructor TCustomColorPalette.Destroy;
|
||||
begin
|
||||
FColors.Free;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
@ -368,6 +227,19 @@ begin
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.ColorPick(AColor: TColor; Shift: TShiftState);
|
||||
begin
|
||||
DoColorPick(AColor, Shift);
|
||||
if IsCorrectShift(Shift) then
|
||||
DoSelectColor(AColor);
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.ColorMouseMove(AColor: TColor; Shift: TShiftState);
|
||||
begin
|
||||
if Assigned(FOnColorMouseMove) then
|
||||
FOnColorMouseMove(Self, AColor, Shift);
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.DeleteColor(AIndex: Integer);
|
||||
begin
|
||||
DoDeleteColor(AIndex);
|
||||
@ -380,29 +252,42 @@ begin
|
||||
FColors.Add(Pointer(AColor));
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.DoColorPick(AColor: TColor; AShift: TShiftState);
|
||||
begin
|
||||
if Assigned(FOnColorPick) then
|
||||
FOnColorPick(Self, AColor, AShift);
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.DoDeleteColor(AIndex: Integer);
|
||||
begin
|
||||
FColors.Delete(AIndex);
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.Paint;
|
||||
var
|
||||
I, X, Y: Integer;
|
||||
c: TColor;
|
||||
procedure TCustomColorPalette.DoSelectColor(AColor: 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
|
||||
Canvas.Brush.Color := c;
|
||||
Canvas.Rectangle(Bounds(X * FButtonWidth, Y * FButtonHeight, FButtonWidth,
|
||||
FButtonHeight));
|
||||
end;
|
||||
end;
|
||||
FSelectedColor := AColor;
|
||||
if Assigned(FOnSelectColor) then FOnSelectColor(self, AColor);
|
||||
end;
|
||||
|
||||
function TCustomColorPalette.GetColorCount: Integer;
|
||||
begin
|
||||
Result := FColors.Count;
|
||||
end;
|
||||
|
||||
function TCustomColorPalette.GetColors(Index: Integer): TColor;
|
||||
begin
|
||||
Result := TColor(PtrUInt(FColors.Items[Index]));
|
||||
end;
|
||||
|
||||
function TCustomColorPalette.IsCorrectShift(Shift: TShiftState): Boolean;
|
||||
var
|
||||
ss: TShiftState;
|
||||
begin
|
||||
Result := True;
|
||||
if (ssLeft in FPickShift) and (Classes.ssLeft in Shift) then exit;
|
||||
if (ssRight in FPickShift) and (Classes.ssRight in Shift) then exit;
|
||||
if (ssMiddle in FPickShift) and (Classes.ssMiddle in Shift) then exit;
|
||||
Result := false;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.LoadPalette(const FileName: String);
|
||||
@ -410,7 +295,7 @@ var
|
||||
F: TextFile;
|
||||
Line: String;
|
||||
C: TColor;
|
||||
|
||||
|
||||
function ParseColor(var S: String): TColor;
|
||||
var
|
||||
R, G, B: Integer;
|
||||
@ -420,7 +305,7 @@ var
|
||||
Delete(S, 1, Pos(',', S));
|
||||
G := StrToIntDef(Copy(S, 1, Pos(',', S) - 1), 0);
|
||||
Delete(S, 1, Pos(',', S));
|
||||
|
||||
|
||||
S := TrimLeft(S);
|
||||
I := 1;
|
||||
while (I <= Length(S)) and (S[I] in ['0'..'9']) do Inc(I);
|
||||
@ -429,14 +314,14 @@ var
|
||||
|
||||
Result := RGBToColor(Max(0, Min(R, 255)), Max(0, Min(G, 255)), Max(0, Min(B, 255)));
|
||||
end;
|
||||
|
||||
|
||||
procedure BlendWBColor(Color: TColor; Steps: Integer);
|
||||
var
|
||||
I: Integer;
|
||||
R, G, B, NR, NG, NB: Byte;
|
||||
begin
|
||||
RedGreenBlue(Color, R, G, B);
|
||||
|
||||
|
||||
for I := 1 to Steps do
|
||||
begin
|
||||
NR := Round((R * I + 255 * (Steps + 1 - I)) / (Steps + 1));
|
||||
@ -444,9 +329,9 @@ var
|
||||
NB := Round((B * I + 255 * (Steps + 1 - I)) / (Steps + 1));
|
||||
DoAddColor(RGBToColor(NR, NG, NB));
|
||||
end;
|
||||
|
||||
|
||||
DoAddColor(Color);
|
||||
|
||||
|
||||
for I := Steps downto 1 do
|
||||
begin
|
||||
NR := Round(R * I / (Steps + 1));
|
||||
@ -455,7 +340,7 @@ var
|
||||
DoAddColor(RGBToColor(NR, NG, NB));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
if not FileExists(FileName) then
|
||||
raise Exception.Create(Format('[TCustomColorPalette.LoadPalette] File not found: %s', [FileName]));
|
||||
@ -489,11 +374,108 @@ begin
|
||||
finally
|
||||
Close(F);
|
||||
end;
|
||||
|
||||
|
||||
UpdateSize;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.MouseDown(Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FMousePt.X := X;
|
||||
FMousePt.Y := Y;
|
||||
|
||||
X := X div FButtonWidth;
|
||||
Y := Y div FButtonHeight;
|
||||
|
||||
FMouseIndex := X + Y * FCols;
|
||||
FPrevMouseIndex := FMouseIndex;
|
||||
|
||||
if FMouseIndex < 0 then
|
||||
Exit;
|
||||
|
||||
if (FMouseIndex < FColors.Count) then
|
||||
begin
|
||||
FPickedColor := GetColors(FMouseIndex);
|
||||
FStoredShift := Shift; // store for usage by pmDefault at MouseUp
|
||||
if FPickMode <> pmDefault then
|
||||
ColorPick(FPickedColor, Shift);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
var
|
||||
C: TColor;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
X := X div FButtonWidth;
|
||||
Y := Y div FButtonHeight;
|
||||
|
||||
FMouseIndex := X + Y * FCols;
|
||||
if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and
|
||||
(FMouseIndex <> FPrevMouseIndex) then
|
||||
begin
|
||||
C := GetColors(FMouseIndex);
|
||||
if C <> clNone then
|
||||
ColorMouseMove(C, Shift);
|
||||
|
||||
if FPickMode = pmContinuous then begin
|
||||
FPickedColor := GetColors(FMouseIndex);
|
||||
ColorPick(FPickedColor, Shift);
|
||||
end;
|
||||
end;
|
||||
|
||||
FPrevMouseIndex := FMouseIndex;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.MouseUp(Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
case FPickMode of
|
||||
pmDefault:
|
||||
if (FMousePt.X = X) and (FMousePt.Y = Y) then
|
||||
ColorPick(FPickedColor, FStoredShift);
|
||||
pmImmediate, pmContinuous:
|
||||
begin
|
||||
X := X div FButtonWidth;
|
||||
Y := Y div FButtonHeight;
|
||||
FMouseIndex := X + Y * FCols;
|
||||
if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and
|
||||
(FMouseIndex <> FPrevMouseIndex) then
|
||||
begin
|
||||
FPickedColor := GetColors(FMouseIndex);
|
||||
ColorPick(FPickedColor, Shift);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
FPrevMouseIndex := -1;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.Paint;
|
||||
var
|
||||
I, X, Y: 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
|
||||
Canvas.Brush.Color := c;
|
||||
Canvas.Rectangle(Bounds(X * FButtonWidth, Y * FButtonHeight, FButtonWidth,
|
||||
FButtonHeight));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.SavePalette(const Filename: String);
|
||||
var
|
||||
i: Integer;
|
||||
@ -519,6 +501,46 @@ begin
|
||||
end;
|
||||
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.SetButtonHeight(const AValue: Integer);
|
||||
begin
|
||||
if FButtonHeight = AValue then Exit;
|
||||
FButtonHeight := AValue;
|
||||
if FButtonHeight < 1 then FButtonHeight := 1;
|
||||
UpdateSize;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.SetColors(Index: Integer; const AValue: TColor);
|
||||
begin
|
||||
FColors.Items[Index] := Pointer(AValue);
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.SetCols(AValue: Integer);
|
||||
begin
|
||||
if AValue = FCols then
|
||||
exit;
|
||||
FCols := AValue;
|
||||
UpdateSize;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.UpdateSize;
|
||||
begin
|
||||
if (FCols = 0) or (FColors.Count = 0) then FRows := 0
|
||||
else
|
||||
FRows := Ceil(FColors.Count / FCols);
|
||||
|
||||
SetBounds(Left, Top, FCols * FButtonWidth + 1, FRows * FButtonHeight + 1);
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
{$I colorpalette.lrs}
|
||||
|
||||
@ -19,9 +19,9 @@ object MainForm: TMainForm
|
||||
ColumnCount = 8
|
||||
PickShift = [ssLeft, ssMiddle]
|
||||
PopupMenu = PalettePopupMenu
|
||||
OnColorPick = ColorPaletteColorPick
|
||||
OnDblClick = ColorPaletteDblClick
|
||||
OnMouseDown = ColorPaletteMouseDown
|
||||
OnSelectColor = ColorPaletteSelectColor
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
@ -33,19 +33,19 @@ object MainForm: TMainForm
|
||||
ClientHeight = 502
|
||||
ClientWidth = 160
|
||||
TabOrder = 0
|
||||
object curColor: TShape
|
||||
object ColorSample: TShape
|
||||
Left = 10
|
||||
Height = 29
|
||||
Top = 13
|
||||
Width = 63
|
||||
end
|
||||
object LblInfo: TLabel
|
||||
object LblColorInfo: TLabel
|
||||
Left = 12
|
||||
Height = 65
|
||||
Top = 45
|
||||
Width = 135
|
||||
AutoSize = False
|
||||
Caption = 'LblInfo'
|
||||
Caption = 'LblColorInfo'
|
||||
Font.Color = clGreen
|
||||
ParentColor = False
|
||||
ParentFont = False
|
||||
@ -98,13 +98,13 @@ object MainForm: TMainForm
|
||||
OnClick = BtnLoadDefaultPalClick
|
||||
TabOrder = 4
|
||||
end
|
||||
object BtnDeleteCurrent: TButton
|
||||
object BtnDeleteColor: TButton
|
||||
Left = 10
|
||||
Height = 25
|
||||
Top = 311
|
||||
Width = 137
|
||||
Caption = 'Delete color #0'
|
||||
OnClick = BtnDeleteCurrentClick
|
||||
OnClick = BtnDeleteColorClick
|
||||
TabOrder = 5
|
||||
end
|
||||
object BtnLoadDefaultPal1: TButton
|
||||
@ -115,16 +115,8 @@ object MainForm: TMainForm
|
||||
Caption = 'Save palette...'
|
||||
TabOrder = 6
|
||||
end
|
||||
object LblPaletteSize: TLabel
|
||||
Left = 10
|
||||
Height = 15
|
||||
Top = 466
|
||||
Width = 72
|
||||
Caption = 'LblPaletteSize'
|
||||
ParentColor = False
|
||||
end
|
||||
object EdColCount: TSpinEdit
|
||||
Left = 12
|
||||
Left = 11
|
||||
Height = 23
|
||||
Top = 432
|
||||
Width = 66
|
||||
@ -134,7 +126,7 @@ object MainForm: TMainForm
|
||||
Value = 8
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 10
|
||||
Left = 11
|
||||
Height = 15
|
||||
Top = 411
|
||||
Width = 80
|
||||
@ -142,16 +134,16 @@ object MainForm: TMainForm
|
||||
ParentColor = False
|
||||
end
|
||||
object CbPickMode: TComboBox
|
||||
Left = 12
|
||||
Left = 11
|
||||
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'pmImproved:'#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 = 376
|
||||
Width = 135
|
||||
Width = 136
|
||||
ItemHeight = 15
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'default'
|
||||
'improved'
|
||||
'immediate'
|
||||
'continuous'
|
||||
)
|
||||
OnSelect = CbPickModeSelect
|
||||
@ -160,7 +152,7 @@ object MainForm: TMainForm
|
||||
Text = 'default'
|
||||
end
|
||||
object LblPickMode: TLabel
|
||||
Left = 12
|
||||
Left = 11
|
||||
Height = 15
|
||||
Top = 355
|
||||
Width = 56
|
||||
@ -217,7 +209,7 @@ object MainForm: TMainForm
|
||||
top = 136
|
||||
object MnuEditPickedColor: TMenuItem
|
||||
Caption = 'Edit picked color...'
|
||||
OnClick = MnuEditPickedClick
|
||||
OnClick = MnuEditPickedColorClick
|
||||
end
|
||||
object MnuDeletePickedColor: TMenuItem
|
||||
Caption = 'Delete picked color'
|
||||
|
||||
@ -14,7 +14,7 @@ type
|
||||
|
||||
TMainForm = class(TForm)
|
||||
Bevel1: TBevel;
|
||||
BtnDeleteCurrent: TButton;
|
||||
BtnDeleteColor: TButton;
|
||||
BtnLoadDefaultPal1: TButton;
|
||||
BtnLoadRndPalette: TButton;
|
||||
BtnCreateRndPalette: TButton;
|
||||
@ -25,38 +25,36 @@ type
|
||||
ColorPalette: TColorPalette;
|
||||
CbPickMode: TComboBox;
|
||||
LblPickMode: TLabel;
|
||||
LblPaletteSize: TLabel;
|
||||
EdColCount: TSpinEdit;
|
||||
Label2: TLabel;
|
||||
LblInfo: TLabel;
|
||||
LblColorInfo: TLabel;
|
||||
MnuEditPickedColor: TMenuItem;
|
||||
MnuDeletePickedColor: TMenuItem;
|
||||
PalettePopupMenu: TPopupMenu;
|
||||
Panel1: TPanel;
|
||||
SaveDialog: TSaveDialog;
|
||||
curColor: TShape;
|
||||
ColorSample: TShape;
|
||||
procedure BtnAddColorClick(Sender: TObject);
|
||||
procedure BtnCreateRndPaletteClick(Sender: TObject);
|
||||
procedure BtnDeleteCurrentClick(Sender: TObject);
|
||||
procedure BtnDeleteColorClick(Sender: TObject);
|
||||
procedure BtnEditColorClick(Sender: TObject);
|
||||
procedure BtnLoadDefaultPalClick(Sender: TObject);
|
||||
procedure BtnLoadRndPaletteClick(Sender: TObject);
|
||||
procedure CbPickModeSelect(Sender: TObject);
|
||||
procedure ColorPaletteColorPick(Sender: TObject; AColor: TColor;
|
||||
Shift: TShiftState);
|
||||
procedure ColorPaletteDblClick(Sender: TObject);
|
||||
procedure ColorPaletteMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
procedure ColorPaletteSelectColor(Sender: TObject; AColor: TColor);
|
||||
procedure EdColCountChange(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure MnuDeletePickedColorClick(Sender: TObject);
|
||||
procedure MnuEditPickedClick(Sender: TObject);
|
||||
procedure BtnEditColorClick(Sender: TObject);
|
||||
procedure MnuEditPickedColorClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
curIndex: integer;
|
||||
procedure EditCurColor;
|
||||
procedure SetLabel(ATitle: string; AColor: TColor);
|
||||
procedure UpdateColorCountInfo;
|
||||
procedure SetColorInfo(ATitle: string; AColor: TColor);
|
||||
procedure UpdateCaption;
|
||||
procedure UpdatePalette;
|
||||
public
|
||||
{ public declarations }
|
||||
@ -76,7 +74,7 @@ procedure TMainForm.BtnAddColorClick(Sender: TObject);
|
||||
begin
|
||||
if ColorDialog.Execute then
|
||||
ColorPalette.AddColor(ColorDialog.Color);
|
||||
LblPaletteSize.Caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
|
||||
UpdateCaption;
|
||||
end;
|
||||
|
||||
procedure TMainForm.BtnCreateRndPaletteClick(Sender: TObject);
|
||||
@ -103,7 +101,7 @@ begin
|
||||
BtnLoadRndPalette.Enabled := true;
|
||||
end;
|
||||
|
||||
procedure TMainForm.BtnDeleteCurrentClick(Sender: TObject);
|
||||
procedure TMainForm.BtnDeleteColorClick(Sender: TObject);
|
||||
begin
|
||||
with ColorPalette do
|
||||
begin
|
||||
@ -111,12 +109,12 @@ begin
|
||||
begin
|
||||
DeleteColor(curIndex);
|
||||
if curIndex = ColorCount then dec(curIndex);
|
||||
curColor.Brush.Color := Colors[curIndex] ;
|
||||
ColorSample.Brush.Color := Colors[curIndex] ;
|
||||
if Colors[curIndex] = clNone then
|
||||
curColor.Brush.Style := bsClear else
|
||||
curColor.Brush.Style := bsSolid;
|
||||
LblPaletteSize.Caption := IntToStr(ColorCount) + ' colors available';
|
||||
SetLabel('Current', ColorPalette.Colors[curIndex]);
|
||||
ColorSample.Brush.Style := bsClear else
|
||||
ColorSample.Brush.Style := bsSolid;
|
||||
UpdateCaption;
|
||||
SetColorInfo('Current', ColorPalette.Colors[curIndex]);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -129,14 +127,14 @@ begin
|
||||
exit;
|
||||
end;
|
||||
ColorPalette.LoadPalette('..\default.pal');
|
||||
LblPaletteSize.caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
|
||||
UpdateCaption;
|
||||
EdColCount.Value := ColorPalette.ColumnCount;
|
||||
end;
|
||||
|
||||
procedure TMainForm.BtnLoadRndPaletteClick(Sender: TObject);
|
||||
begin
|
||||
ColorPalette.LoadPalette('random_palette.pal');
|
||||
LblPaletteSize.Caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
|
||||
UpdateCaption;
|
||||
EdColCount.Value := ColorPalette.ColumnCount;
|
||||
end;
|
||||
|
||||
@ -153,16 +151,6 @@ begin
|
||||
ColorPalette.PickMode := TPickMode(CbPickMode.ItemIndex);
|
||||
end;
|
||||
|
||||
procedure TMainForm.ColorPaletteColorPick(Sender: TObject; AColor: TColor;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
curColor.Brush.Color := ColorPalette.PickedColor;
|
||||
if ColorPalette.Colors[curIndex] = clNone then
|
||||
curColor.Brush.Style := bsClear else
|
||||
curColor.Brush.Style := bsSolid;
|
||||
SetLabel('PickedColor', ColorPalette.PickedColor);
|
||||
end;
|
||||
|
||||
procedure TMainForm.ColorPaletteDblClick(Sender: TObject);
|
||||
begin
|
||||
with ColorDialog do
|
||||
@ -171,9 +159,9 @@ begin
|
||||
if Execute then
|
||||
begin
|
||||
ColorPalette.Colors[curIndex] := Color;
|
||||
curColor.Brush.Color := Color;
|
||||
curColor.Brush.Style := bsSolid;
|
||||
SetLabel('Current', Color);
|
||||
ColorSample.Brush.Color := Color;
|
||||
ColorSample.Brush.Style := bsSolid;
|
||||
SetColorInfo('Current', Color);
|
||||
with BtnEditColor do
|
||||
begin
|
||||
Caption := 'Edit';
|
||||
@ -192,8 +180,17 @@ begin
|
||||
Y := Y div ButtonHeight;
|
||||
curIndex := X + Y * ColumnCount;
|
||||
end;
|
||||
BtnDeleteCurrent.caption := 'Delete color #' + IntToStr(curIndex);
|
||||
Caption := 'CurIndex: ' + IntToStr(curIndex);
|
||||
BtnDeleteColor.caption := 'Delete color #' + IntToStr(curIndex);
|
||||
UpdateCaption;
|
||||
end;
|
||||
|
||||
procedure TMainForm.ColorPaletteSelectColor(Sender: TObject; AColor: TColor);
|
||||
begin
|
||||
ColorSample.Brush.Color := ColorPalette.SelectedColor;
|
||||
if ColorPalette.Colors[curIndex] = clNone then
|
||||
ColorSample.Brush.Style := bsClear else
|
||||
ColorSample.Brush.Style := bsSolid;
|
||||
SetColorInfo('SelectedColor', ColorPalette.SelectedColor);
|
||||
end;
|
||||
|
||||
procedure TMainForm.EdColCountChange(Sender: TObject);
|
||||
@ -205,27 +202,26 @@ procedure TMainForm.EditCurColor;
|
||||
begin
|
||||
with ColorDialog do
|
||||
begin
|
||||
Color := curColor.Brush.color;
|
||||
Color := ColorSample.Brush.color;
|
||||
if Execute then begin
|
||||
curColor.Brush.Color := Color;
|
||||
curColor.Brush.Style := bsSolid;
|
||||
ColorSample.Brush.Color := Color;
|
||||
ColorSample.Brush.Style := bsSolid;
|
||||
end;
|
||||
end;
|
||||
if curColor.Brush.Color <> ColorPalette.PickedColor then
|
||||
if ColorSample.Brush.Color <> ColorPalette.SelectedColor then
|
||||
begin
|
||||
BtnEditColor.caption := 'Update >';
|
||||
BtnEditColor.hint := 'Update palette';
|
||||
SetLabel('New color', curColor.Brush.Color);
|
||||
SetColorInfo('New color', ColorSample.Brush.Color);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Caption := 'TColorPalette Demo';
|
||||
curIndex := 0;
|
||||
curColor.Brush.Color := ColorPalette.Colors[0];
|
||||
SetLabel('Current', ColorPalette.Colors[curIndex]);
|
||||
UpdateColorCountInfo;
|
||||
ColorSample.Brush.Color := ColorPalette.Colors[0];
|
||||
SetColorInfo('Current', ColorPalette.Colors[curIndex]);
|
||||
UpdateCaption;
|
||||
|
||||
{ ColorPalette.PickShift must contain ssRight in order to be able to select
|
||||
colors for the context menu. Use object inspector, or use this code: }
|
||||
@ -234,33 +230,41 @@ end;
|
||||
|
||||
procedure TMainForm.MnuDeletePickedColorClick(Sender: TObject);
|
||||
begin
|
||||
BtnDeleteCurrentClick(self);
|
||||
BtnDeleteColorClick(self);
|
||||
end;
|
||||
|
||||
procedure TMainForm.MnuEditPickedClick(Sender: TObject);
|
||||
procedure TMainForm.MnuEditPickedColorClick(Sender: TObject);
|
||||
begin
|
||||
BtnEditColorClick(self);
|
||||
end;
|
||||
|
||||
procedure TMainForm.SetLabel(ATitle: string; AColor: TColor);
|
||||
procedure TMainForm.SetColorInfo(ATitle: string; AColor: TColor);
|
||||
begin
|
||||
LblInfo.caption := Format(
|
||||
'%s: %s'#13+
|
||||
' red = %d'#13+
|
||||
' green = %d'#13+
|
||||
' blue = %d', [ATitle, ColorToString(AColor), Red(AColor), Green(AColor), Blue(AColor)]
|
||||
);
|
||||
if AColor = clNone then
|
||||
LblColorInfo.Caption := Format(
|
||||
'%s: %s', [ATitle, ColorToString(AColor)]
|
||||
)
|
||||
else
|
||||
LblColorInfo.caption := Format(
|
||||
'%s: %s'#13+
|
||||
' red = %d'#13+
|
||||
' green = %d'#13+
|
||||
' blue = %d',
|
||||
[ATitle, ColorToString(AColor), Red(AColor), Green(AColor), Blue(AColor)]
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TMainForm.UpdateColorCountInfo;
|
||||
procedure TMainForm.UpdateCaption;
|
||||
begin
|
||||
LblPaletteSize.Caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
|
||||
Caption := Format('ColorPalette demo - CurIndex: %d (%d colors available)',
|
||||
[curIndex, ColorPalette.ColorCount]
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TMainForm.UpdatePalette;
|
||||
begin
|
||||
ColorPalette.Colors[curIndex] := curColor.Brush.Color;
|
||||
SetLabel('Current', ColorPalette.Colors[curIndex]);
|
||||
ColorPalette.Colors[curIndex] := ColorSample.Brush.Color;
|
||||
SetColorInfo('Current', ColorPalette.Colors[curIndex]);
|
||||
with BtnEditColor do
|
||||
begin
|
||||
Caption := 'Edit';
|
||||
|
||||
Loading…
Reference in New Issue
Block a user