From 895bad7c0422c5321704aa27cc44de294a102dcf Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 21 Aug 2015 15:27:19 +0000 Subject: [PATCH] ColorPalette: Support for popup hints. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4282 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/colorpalette/colorpalette.pas | 79 ++++++++++++++++++++---- components/colorpalette/demo/unit1.lfm | 30 ++++++--- components/colorpalette/demo/unit1.pas | 7 +++ 3 files changed, 96 insertions(+), 20 deletions(-) diff --git a/components/colorpalette/colorpalette.pas b/components/colorpalette/colorpalette.pas index abb476ad5..1c7bbcea7 100644 --- a/components/colorpalette/colorpalette.pas +++ b/components/colorpalette/colorpalette.pas @@ -84,7 +84,9 @@ type FMouseIndex: Integer; FPrevMouseIndex: Integer; FStoredShift: TShiftState; + FShowColorHint: Boolean; FShowSelection: Boolean; + FSavedHint: String; function GetColorCount: Integer; function GetColors(AIndex: Integer): TColor; function GetPickedColor: TColor; @@ -93,6 +95,7 @@ type procedure SetColors(AIndex: Integer; const AValue: TColor); procedure SetCols(AValue: Integer); procedure SetSelectedIndex(AValue: Integer); +// procedure SetShowColorHint(AValue: Boolean); procedure SetShowSelection(AValue: Boolean); protected procedure ColorPick(AIndex: Integer; Shift: TShiftState); dynamic; @@ -101,8 +104,11 @@ type procedure DoColorPick(AColor: TColor; AShift: TShiftState); virtual; procedure DoDeleteColor(AIndex: Integer); virtual; procedure DoSelectColor(AColor: TColor); virtual; + function GetHintText(AColor: TColor): String; virtual; function IsCorrectShift(Shift: TShiftState): Boolean; procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override; + procedure MouseEnter; override; + procedure MouseLeave; override; procedure MouseMove(Shift:TShiftState; X, Y:Integer); override; procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y:Integer); override; procedure UpdateSize; virtual; @@ -112,6 +118,7 @@ type property PickMode: TPickMode read FPickMode write FPickMode default pmDefault; property PickShift: TPickShift read FPickShift write FPickShift default [ssLeft]; property SelectedIndex: Integer read FSelectedIndex write SetSelectedIndex default 0; + property ShowColorHint: Boolean read FShowColorHint write FShowColorHint default true; property ShowSelection: Boolean read FShowSelection write SetShowSelection default false; public constructor Create(TheOwner: TComponent); override; @@ -157,6 +164,7 @@ type property PickShift; property PopupMenu; property SelectedIndex; + property ShowColorHint; property ShowHint; property ShowSelection; property Visible; @@ -198,6 +206,7 @@ begin FButtonHeight := 12; FPrevMouseIndex := -1; FPickShift := [ssLeft]; + FShowColorHint := true; FCols := 8; @@ -296,6 +305,27 @@ begin Result := TColor(PtrUInt(FColors.Items[AIndex])); end; +function TCustomColorPalette.GetHintText(AColor: TColor): string; +const + INDENT = '* '; + MASK = '%sRed: %d'#13'%sGreen: %d'#13'%sBlue: %d'; +begin + if AColor = clNone then + Result := 'NONE' + else + begin + Result := ColorToString(AColor); + if (Result[1] = 'c') and (Result[2] = 'l') then + begin + Delete(Result, 1, 2); + Result := Uppercase(Result) + #13 + Format(MASK, [ + INDENT, Red(AColor), INDENT, Green(AColor), INDENT, Blue(AColor)] + ); + end else + Result := Format(MASK, ['', Red(AColor), '', Green(AColor), '', Blue(AColor)]); + end; +end; + function TCustomColorPalette.GetPickedColor: TColor; begin Result := GetColors(FMouseIndex); @@ -424,25 +454,42 @@ begin end; end; +procedure TCustomColorPalette.MouseEnter; +begin + FSavedHint := Hint; + inherited; +end; + +procedure TCustomColorPalette.MouseLeave; +begin + inherited; + Hint := FSavedHint; +end; + procedure TCustomColorPalette.MouseMove(Shift: TShiftState; X, Y: Integer); var C: TColor; begin inherited; - X := X div FButtonWidth; - Y := Y div FButtonHeight; + FMouseIndex := X div FButtonWidth + (Y div FButtonHeight) * FCols; - FMouseIndex := X + Y * FCols; - if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and - (FMouseIndex <> FPrevMouseIndex) then + if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) then begin C := GetColors(FMouseIndex); - if C <> clNone then - ColorMouseMove(C, Shift); - - if FPickMode = pmContinuous then - ColorPick(FMouseIndex, Shift); + if ShowHint and FShowColorHint then + begin + Hint := GetHintText(c); + if FMouseIndex <> FPrevMouseIndex then + Application.ActivateHint(ClientToScreen(Point(X, Y))); + end; + if (FMouseIndex <> FPrevMouseIndex) then + begin + if C <> clNone then + ColorMouseMove(C, Shift); + if FPickMode = pmContinuous then + ColorPick(FMouseIndex, Shift); + end; end; FPrevMouseIndex := FMouseIndex; @@ -558,7 +605,17 @@ begin UpdateSize; Invalidate; end; - +{ +procedure TCustomColorPalette.SetShowColorHint(AValue: Boolean); +begin + if FShowColorHint = AValue then exit; + if AValue then + FSavedHint := Hint + else + Hint := FSavedHint; + FShowColorHint := AValue; +end; + } procedure TCustomColorPalette.SetShowSelection(AValue: Boolean); begin if FShowSelection = AValue then exit; diff --git a/components/colorpalette/demo/unit1.lfm b/components/colorpalette/demo/unit1.lfm index 3076e9993..bedd3b750 100644 --- a/components/colorpalette/demo/unit1.lfm +++ b/components/colorpalette/demo/unit1.lfm @@ -12,6 +12,7 @@ object MainForm: TMainForm object ColorPalette: TColorPalette Left = 176 Height = 33 + Hint = 'Click to select a color' Top = 15 Width = 129 ButtonWidth = 16 @@ -64,7 +65,7 @@ object MainForm: TMainForm object BtnLoadRndPalette: TButton Left = 10 Height = 25 - Top = 190 + Top = 181 Width = 137 Caption = 'Load random palette' Enabled = False @@ -74,7 +75,7 @@ object MainForm: TMainForm object BtnCreateRndPalette: TButton Left = 10 Height = 25 - Top = 161 + Top = 152 Width = 137 Caption = 'Create random palette' OnClick = BtnCreateRndPaletteClick @@ -83,7 +84,7 @@ object MainForm: TMainForm object BtnAddColor: TButton Left = 10 Height = 25 - Top = 282 + Top = 264 Width = 137 Caption = 'Add color...' OnClick = BtnAddColorClick @@ -92,7 +93,7 @@ object MainForm: TMainForm object BtnLoadDefaultPal: TButton Left = 10 Height = 25 - Top = 121 + Top = 112 Width = 137 Caption = 'Load Default.pal' OnClick = BtnLoadDefaultPalClick @@ -101,7 +102,7 @@ object MainForm: TMainForm object BtnDeleteColor: TButton Left = 10 Height = 25 - Top = 311 + Top = 293 Width = 137 Caption = 'Delete color #0' OnClick = BtnDeleteColorClick @@ -110,7 +111,7 @@ object MainForm: TMainForm object BtnLoadDefaultPal1: TButton Left = 10 Height = 25 - Top = 228 + Top = 219 Width = 137 Caption = 'Save palette...' TabOrder = 6 @@ -137,7 +138,7 @@ object MainForm: TMainForm 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'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 + Top = 358 Width = 136 ItemHeight = 15 ItemIndex = 0 @@ -154,7 +155,7 @@ object MainForm: TMainForm object LblPickMode: TLabel Left = 10 Height = 15 - Top = 355 + Top = 337 Width = 56 Caption = 'Pick mode' ParentColor = False @@ -162,12 +163,23 @@ object MainForm: TMainForm object CbShowSelection: TCheckBox Left = 11 Height = 19 - Top = 413 + Top = 395 Width = 99 Caption = 'Show selection' OnChange = CbShowSelectionChange TabOrder = 9 end + object CbShowColorHints: TCheckBox + Left = 11 + Height = 19 + Top = 416 + Width = 108 + Caption = 'Show color hints' + Checked = True + OnChange = CbShowColorHintsChange + State = cbChecked + TabOrder = 10 + end end object Bevel1: TBevel Left = 160 diff --git a/components/colorpalette/demo/unit1.pas b/components/colorpalette/demo/unit1.pas index 53d32c659..88da65caf 100644 --- a/components/colorpalette/demo/unit1.pas +++ b/components/colorpalette/demo/unit1.pas @@ -22,6 +22,7 @@ type BtnLoadDefaultPal: TButton; BtnEditColor: TButton; CbShowSelection: TCheckBox; + CbShowColorHints: TCheckBox; ColorDialog: TColorDialog; ColorPalette: TColorPalette; CbPickMode: TComboBox; @@ -42,6 +43,7 @@ type procedure BtnLoadDefaultPalClick(Sender: TObject); procedure BtnLoadRndPaletteClick(Sender: TObject); procedure CbPickModeSelect(Sender: TObject); + procedure CbShowColorHintsChange(Sender: TObject); procedure CbShowSelectionChange(Sender: TObject); procedure ColorPaletteDblClick(Sender: TObject); procedure ColorPaletteMouseDown(Sender: TObject; Button: TMouseButton; @@ -149,6 +151,11 @@ begin ColorPalette.PickMode := TPickMode(CbPickMode.ItemIndex); end; +procedure TMainForm.CbShowColorHintsChange(Sender: TObject); +begin + ColorPalette.ShowColorHint := CbShowColorHints.Checked; +end; + procedure TMainForm.CbShowSelectionChange(Sender: TObject); begin ColorPalette.ShowSelection := CbShowSelection.Checked;