ColorPalette: Add new properties "PickMode" and "PickShift" to select when and by which mouse button the color is selected. Some reorganisation of code. Update demo.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4279 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
parent
77c582dda8
commit
7f5584ad24
@ -52,6 +52,15 @@ 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
|
||||
);
|
||||
|
||||
TPickShiftEnum = (ssLeft, ssRight, ssMiddle);
|
||||
TPickShift = set of TPickShiftEnum;
|
||||
|
||||
TColorMouseEvent = procedure (Sender: TObject; AColor: TColor; Shift: TShiftState) of object;
|
||||
|
||||
{ TCustomColorPalette }
|
||||
@ -65,7 +74,13 @@ type
|
||||
FOnColorPick: TColorMouseEvent;
|
||||
FRows: Integer;
|
||||
FColors: TList;
|
||||
MX, MY: integer;
|
||||
FPickedColor: TColor;
|
||||
FPickMode: TPickMode;
|
||||
FPickShift: TPickShift;
|
||||
FMousePt: TPoint;
|
||||
FMouseIndex: Integer;
|
||||
FPrevMouseIndex: Integer;
|
||||
FStoredShift: TShiftState;
|
||||
function GetColorCount: Integer;
|
||||
function GetColors(Index: Integer): TColor;
|
||||
procedure SetButtonHeight(const AValue: Integer);
|
||||
@ -73,17 +88,21 @@ type
|
||||
procedure SetColors(Index: Integer; const AValue: TColor);
|
||||
procedure SetCols(AValue: Integer);
|
||||
protected
|
||||
procedure MouseDown(Button: TMouseButton; 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 ColorPick(AColor: TColor; Shift: TShiftState); dynamic;
|
||||
procedure ColorMouseMove(AColor: TColor; Shift: TShiftState); dynamic;
|
||||
procedure DoAddColor(AColor: TColor); virtual;
|
||||
procedure DoDeleteColor(AIndex: Integer); virtual;
|
||||
function IsCorrectShift(Shift: TShiftState): Boolean;
|
||||
procedure MouseDown(Button: TMouseButton; 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 UpdateSize; virtual;
|
||||
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth;
|
||||
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight;
|
||||
property ColumnCount: Integer read FCols write SetCols;
|
||||
property PickMode: TPickMode read FPickMode write FPickMode default pmDefault;
|
||||
property PickShift: TPickShift read FPickShift write FPickShift default [ssLeft];
|
||||
public
|
||||
PickedColor: TColor;
|
||||
PickShift: TShiftState;
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure Paint; override;
|
||||
@ -93,12 +112,10 @@ type
|
||||
procedure LoadPalette(const FileName: String);
|
||||
procedure SavePalette(const FileName: String);
|
||||
|
||||
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth;
|
||||
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight;
|
||||
property Colors[Index: Integer]: TColor read GetColors write SetColors;
|
||||
property ColorCount: Integer read GetColorCount;
|
||||
property ColumnCount: Integer read FCols write SetCols;
|
||||
|
||||
property PickedColor: TColor read FPickedColor;
|
||||
|
||||
property OnColorPick: TColorMouseEvent read FOnColorPick write FOnColorPick;
|
||||
property OnColorMouseMove: TColorMouseEvent read FOnColorMouseMove write FOnColorMouseMove;
|
||||
|
||||
@ -123,6 +140,8 @@ type
|
||||
property Hint;
|
||||
property ParentColor;
|
||||
property ParentShowHint;
|
||||
property PickMode;
|
||||
property PickShift;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property Visible;
|
||||
@ -180,6 +199,7 @@ end;
|
||||
procedure TCustomColorPalette.SetColors(Index: Integer; const AValue: TColor);
|
||||
begin
|
||||
FColors.Items[Index] := Pointer(AValue);
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.SetCols(AValue: Integer);
|
||||
@ -205,27 +225,49 @@ procedure TCustomColorPalette.MouseDown(Button: TMouseButton;
|
||||
begin
|
||||
inherited;
|
||||
|
||||
MX := X;
|
||||
MY := Y;
|
||||
FMousePt.X := X;
|
||||
FMousePt.Y := Y;
|
||||
|
||||
X := X div FButtonWidth;
|
||||
Y := Y div FButtonHeight;
|
||||
|
||||
if X + Y * FCols < 0 then
|
||||
FMouseIndex := X + Y * FCols;
|
||||
FPrevMouseIndex := FMouseIndex;
|
||||
|
||||
if FMouseIndex < 0 then
|
||||
Exit;
|
||||
|
||||
if X + Y * FCols < FColors.Count then
|
||||
if (FMouseIndex < FColors.Count) then
|
||||
begin
|
||||
PickedColor := GetColors(X + Y * FCols);
|
||||
PickShift := Shift;
|
||||
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
|
||||
if (PickedColor <> clNone) and (MX = X) and (MY = Y) then
|
||||
ColorPick(PickedColor, PickShift);
|
||||
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;
|
||||
|
||||
@ -238,23 +280,44 @@ begin
|
||||
X := X div FButtonWidth;
|
||||
Y := Y div FButtonHeight;
|
||||
|
||||
if X + Y * FCols < 0 then
|
||||
Exit;
|
||||
if X + Y * FCols < FColors.Count then
|
||||
FMouseIndex := X + Y * FCols;
|
||||
if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and
|
||||
(FMouseIndex <> FPrevMouseIndex) then
|
||||
begin
|
||||
C := GetColors(X + Y * FCols);
|
||||
if C <> clNone then ColorMouseMove(C, Shift);
|
||||
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 Assigned(FOnColorPick) then FOnColorPick(Self, AColor, Shift);
|
||||
if IsCorrectShift(Shift) and Assigned(FOnColorPick) then
|
||||
FOnColorPick(Self, AColor, Shift);
|
||||
end;
|
||||
|
||||
procedure TCustomColorPalette.ColorMouseMove(AColor: TColor; Shift: TShiftState);
|
||||
begin
|
||||
if Assigned(FOnColorMouseMove) then FOnColorMouseMove(Self, AColor, Shift);
|
||||
if IsCorrectShift(Shift) and Assigned(FOnColorMouseMove) then
|
||||
FOnColorMouseMove(Self, AColor, Shift);
|
||||
end;
|
||||
|
||||
constructor TCustomColorPalette.Create(TheOwner: TComponent);
|
||||
@ -264,6 +327,8 @@ begin
|
||||
FColors := TList.Create;
|
||||
FButtonWidth := 12;
|
||||
FButtonHeight := 12;
|
||||
FPrevMouseIndex := -1;
|
||||
FPickShift := [ssLeft];
|
||||
ControlStyle := ControlStyle + [csFixedWidth, csFixedHeight];
|
||||
|
||||
FCols := 8;
|
||||
|
||||
@ -9,6 +9,7 @@
|
||||
<Title Value="project1"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
|
||||
@ -1,7 +1,7 @@
|
||||
object MainForm: TMainForm
|
||||
Left = 522
|
||||
Left = 358
|
||||
Height = 502
|
||||
Top = 211
|
||||
Top = 179
|
||||
Width = 455
|
||||
Caption = 'MainForm'
|
||||
ClientHeight = 502
|
||||
@ -17,8 +17,10 @@ object MainForm: TMainForm
|
||||
ButtonWidth = 16
|
||||
ButtonHeight = 16
|
||||
ColumnCount = 8
|
||||
PickShift = [ssLeft, ssMiddle]
|
||||
PopupMenu = PalettePopupMenu
|
||||
OnColorPick = ColorPaletteColorPick
|
||||
OnDblClick = ColorPaletteDblClick
|
||||
OnMouseDown = ColorPaletteMouseDown
|
||||
end
|
||||
object Panel1: TPanel
|
||||
@ -35,7 +37,7 @@ object MainForm: TMainForm
|
||||
Left = 10
|
||||
Height = 29
|
||||
Top = 13
|
||||
Width = 69
|
||||
Width = 63
|
||||
end
|
||||
object LblInfo: TLabel
|
||||
Left = 12
|
||||
@ -50,11 +52,11 @@ object MainForm: TMainForm
|
||||
WordWrap = True
|
||||
end
|
||||
object BtnEditColor: TButton
|
||||
Left = 91
|
||||
Left = 83
|
||||
Height = 19
|
||||
Hint = 'Edit current color'
|
||||
Top = 13
|
||||
Width = 56
|
||||
Width = 64
|
||||
Caption = 'Edit'
|
||||
OnClick = BtnEditColorClick
|
||||
TabOrder = 0
|
||||
@ -62,7 +64,7 @@ object MainForm: TMainForm
|
||||
object BtnLoadRndPalette: TButton
|
||||
Left = 10
|
||||
Height = 25
|
||||
Top = 188
|
||||
Top = 190
|
||||
Width = 137
|
||||
Caption = 'Load random palette'
|
||||
Enabled = False
|
||||
@ -99,7 +101,7 @@ object MainForm: TMainForm
|
||||
object BtnDeleteCurrent: TButton
|
||||
Left = 10
|
||||
Height = 25
|
||||
Top = 314
|
||||
Top = 311
|
||||
Width = 137
|
||||
Caption = 'Delete color #0'
|
||||
OnClick = BtnDeleteCurrentClick
|
||||
@ -108,10 +110,9 @@ object MainForm: TMainForm
|
||||
object BtnLoadDefaultPal1: TButton
|
||||
Left = 10
|
||||
Height = 25
|
||||
Top = 227
|
||||
Top = 228
|
||||
Width = 137
|
||||
Caption = 'Save palette...'
|
||||
OnClick = BtnLoadDefaultPal1Click
|
||||
TabOrder = 6
|
||||
end
|
||||
object LblPaletteSize: TLabel
|
||||
@ -140,6 +141,32 @@ object MainForm: TMainForm
|
||||
Caption = 'Column count:'
|
||||
ParentColor = False
|
||||
end
|
||||
object CbPickMode: TComboBox
|
||||
Left = 12
|
||||
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'
|
||||
Top = 376
|
||||
Width = 135
|
||||
ItemHeight = 15
|
||||
ItemIndex = 0
|
||||
Items.Strings = (
|
||||
'default'
|
||||
'improved'
|
||||
'continuous'
|
||||
)
|
||||
OnSelect = CbPickModeSelect
|
||||
Style = csDropDownList
|
||||
TabOrder = 8
|
||||
Text = 'default'
|
||||
end
|
||||
object LblPickMode: TLabel
|
||||
Left = 12
|
||||
Height = 15
|
||||
Top = 355
|
||||
Width = 56
|
||||
Caption = 'Pick mode'
|
||||
ParentColor = False
|
||||
end
|
||||
end
|
||||
object Bevel1: TBevel
|
||||
Left = 160
|
||||
|
||||
@ -23,6 +23,8 @@ type
|
||||
BtnEditColor: TButton;
|
||||
ColorDialog: TColorDialog;
|
||||
ColorPalette: TColorPalette;
|
||||
CbPickMode: TComboBox;
|
||||
LblPickMode: TLabel;
|
||||
LblPaletteSize: TLabel;
|
||||
EdColCount: TSpinEdit;
|
||||
Label2: TLabel;
|
||||
@ -33,14 +35,15 @@ type
|
||||
Panel1: TPanel;
|
||||
SaveDialog: TSaveDialog;
|
||||
curColor: TShape;
|
||||
procedure BtnDeleteCurrentClick(Sender: TObject);
|
||||
procedure BtnLoadDefaultPal1Click(Sender: TObject);
|
||||
procedure BtnLoadRndPaletteClick(Sender: TObject);
|
||||
procedure BtnCreateRndPaletteClick(Sender: TObject);
|
||||
procedure BtnAddColorClick(Sender: TObject);
|
||||
procedure BtnCreateRndPaletteClick(Sender: TObject);
|
||||
procedure BtnDeleteCurrentClick(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 EdColCountChange(Sender: TObject);
|
||||
@ -53,6 +56,7 @@ type
|
||||
curIndex: integer;
|
||||
procedure EditCurColor;
|
||||
procedure SetLabel(ATitle: string; AColor: TColor);
|
||||
procedure UpdateColorCountInfo;
|
||||
procedure UpdatePalette;
|
||||
public
|
||||
{ public declarations }
|
||||
@ -72,7 +76,7 @@ procedure TMainForm.BtnAddColorClick(Sender: TObject);
|
||||
begin
|
||||
if ColorDialog.Execute then
|
||||
ColorPalette.AddColor(ColorDialog.Color);
|
||||
LblPaletteSize.caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
|
||||
LblPaletteSize.Caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
|
||||
end;
|
||||
|
||||
procedure TMainForm.BtnCreateRndPaletteClick(Sender: TObject);
|
||||
@ -108,6 +112,9 @@ begin
|
||||
DeleteColor(curIndex);
|
||||
if curIndex = ColorCount then dec(curIndex);
|
||||
curColor.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]);
|
||||
end;
|
||||
@ -126,15 +133,6 @@ begin
|
||||
EdColCount.Value := ColorPalette.ColumnCount;
|
||||
end;
|
||||
|
||||
procedure TMainForm.BtnLoadDefaultPal1Click(Sender: TObject);
|
||||
begin
|
||||
Showmessage('???');
|
||||
SaveDialog.FileName := 'random_palette.pal';
|
||||
SaveDialog.InitialDir := ExtractFileDir(ParamStr(0));
|
||||
if SaveDialog.Execute then
|
||||
ColorPalette.SavePalette(SaveDialog.FileName);
|
||||
end;
|
||||
|
||||
procedure TMainForm.BtnLoadRndPaletteClick(Sender: TObject);
|
||||
begin
|
||||
ColorPalette.LoadPalette('random_palette.pal');
|
||||
@ -150,13 +148,41 @@ begin
|
||||
UpdatePalette;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CbPickModeSelect(Sender: TObject);
|
||||
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
|
||||
begin
|
||||
Color := ColorPalette.Colors[curIndex];
|
||||
if Execute then
|
||||
begin
|
||||
ColorPalette.Colors[curIndex] := Color;
|
||||
curColor.Brush.Color := Color;
|
||||
curColor.Brush.Style := bsSolid;
|
||||
SetLabel('Current', Color);
|
||||
with BtnEditColor do
|
||||
begin
|
||||
Caption := 'Edit';
|
||||
Hint := 'Edit current color';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.ColorPaletteMouseDown(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
begin
|
||||
@ -180,12 +206,14 @@ begin
|
||||
with ColorDialog do
|
||||
begin
|
||||
Color := curColor.Brush.color;
|
||||
if Execute then
|
||||
if Execute then begin
|
||||
curColor.Brush.Color := Color;
|
||||
curColor.Brush.Style := bsSolid;
|
||||
end;
|
||||
end;
|
||||
if curColor.Brush.Color <> ColorPalette.PickedColor then
|
||||
begin
|
||||
BtnEditColor.caption := 'Update';
|
||||
BtnEditColor.caption := 'Update >';
|
||||
BtnEditColor.hint := 'Update palette';
|
||||
SetLabel('New color', curColor.Brush.Color);
|
||||
end;
|
||||
@ -195,9 +223,13 @@ procedure TMainForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Caption := 'TColorPalette Demo';
|
||||
curIndex := 0;
|
||||
curColor.brush.color := ColorPalette.Colors[0];
|
||||
curColor.Brush.Color := ColorPalette.Colors[0];
|
||||
SetLabel('Current', ColorPalette.Colors[curIndex]);
|
||||
LblPaletteSize.Caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
|
||||
UpdateColorCountInfo;
|
||||
|
||||
{ ColorPalette.PickShift must contain ssRight in order to be able to select
|
||||
colors for the context menu. Use object inspector, or use this code: }
|
||||
ColorPalette.PickShift := [ssLeft, ssRight];
|
||||
end;
|
||||
|
||||
procedure TMainForm.MnuDeletePickedColorClick(Sender: TObject);
|
||||
@ -220,10 +252,14 @@ begin
|
||||
);
|
||||
end;
|
||||
|
||||
procedure TMainForm.UpdateColorCountInfo;
|
||||
begin
|
||||
LblPaletteSize.Caption := IntToStr(ColorPalette.ColorCount) + ' colors available';
|
||||
end;
|
||||
|
||||
procedure TMainForm.UpdatePalette;
|
||||
begin
|
||||
ColorPalette.Colors[curIndex] := curColor.Brush.Color;
|
||||
ColorPalette.Refresh;
|
||||
SetLabel('Current', ColorPalette.Colors[curIndex]);
|
||||
with BtnEditColor do
|
||||
begin
|
||||
|
||||
Loading…
Reference in New Issue
Block a user