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

@@ -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;
+  FMouseIndex := X div FButtonWidth + (Y div FButtonHeight) * FCols;
-  Y := Y div FButtonHeight;
 
-  FMouseIndex := X + Y * FCols;
+  if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) then
-  if (FMouseIndex >= 0) and (FMouseIndex < FColors.Count) and
-     (FMouseIndex <> FPrevMouseIndex) then
   begin
     C := GetColors(FMouseIndex);
-    if C <> clNone then
+    if ShowHint and FShowColorHint then
-      ColorMouseMove(C, Shift);
+    begin
-
+      Hint := GetHintText(c);
-    if FPickMode = pmContinuous then
+      if FMouseIndex <> FPrevMouseIndex then
-      ColorPick(FMouseIndex, Shift);
+        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;

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

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;