From 7f5584ad24c7440c2ac28cf09d52ddcad443b827 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 20 Aug 2015 21:02:08 +0000 Subject: [PATCH] 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 --- components/colorpalette/colorpalette.pas | 115 +++++++++++++++++----- components/colorpalette/demo/project1.lpi | 1 + components/colorpalette/demo/unit1.lfm | 45 +++++++-- components/colorpalette/demo/unit1.pas | 74 ++++++++++---- 4 files changed, 182 insertions(+), 53 deletions(-) diff --git a/components/colorpalette/colorpalette.pas b/components/colorpalette/colorpalette.pas index b9977f493..8f2b2278d 100644 --- a/components/colorpalette/colorpalette.pas +++ b/components/colorpalette/colorpalette.pas @@ -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; diff --git a/components/colorpalette/demo/project1.lpi b/components/colorpalette/demo/project1.lpi index f830ce9c1..3e7a00f72 100644 --- a/components/colorpalette/demo/project1.lpi +++ b/components/colorpalette/demo/project1.lpi @@ -9,6 +9,7 @@ <ResourceType Value="res"/> <UseXPManifest Value="True"/> + <Icon Value="0"/> </General> <i18n> <EnableI18N LFM="False"/> diff --git a/components/colorpalette/demo/unit1.lfm b/components/colorpalette/demo/unit1.lfm index c6d227132..624989215 100644 --- a/components/colorpalette/demo/unit1.lfm +++ b/components/colorpalette/demo/unit1.lfm @@ -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 diff --git a/components/colorpalette/demo/unit1.pas b/components/colorpalette/demo/unit1.pas index 50aac815a..0f3f07390 100644 --- a/components/colorpalette/demo/unit1.pas +++ b/components/colorpalette/demo/unit1.pas @@ -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