Colorpalette: Add event OnGetHintText to provide a custom color hint text.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4286 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/colorpalette/colorpalette.pas

@@ -68,6 +68,8 @@ type
   TColorMouseEvent = procedure (Sender: TObject; AColor: TColor; Shift: TShiftState) of object;
   TColorPaletteEvent = procedure (Sender: TObject; AColor: TColor) of object;
 
+  TColorPaletteHintEvent = procedure (Sender: TObject; AColor: TColor; var AText: String) of object;
+
   { TCustomColorPalette }
 
   TCustomColorPalette = class(TGraphicControl)
@@ -78,6 +80,7 @@ type
     FOnColorMouseMove: TColorMouseEvent;
     FOnColorPick: TColorMouseEvent;
     FOnSelectColor: TColorPaletteEvent;
+    FOnGetHintText: TColorPaletteHintEvent;
     FRows: Integer;
     FColors: TList;
     FSelectedColor: TColor;
@@ -137,6 +140,7 @@ type
     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;
+    property OnGetHintText: TColorPaletteHintEvent read FOnGetHintText write FOnGetHintText;
 
   public
     constructor Create(AOwner: TComponent); override;
@@ -180,6 +184,7 @@ type
 
     property OnColorMouseMove;
     property OnColorPick;
+    property OnGetHintText;
     property OnSelectColor;
 
     // inherited from TCustomColorPalette's ancestors
@@ -355,7 +360,7 @@ end;
 function TCustomColorPalette.GetHintText(AColor: TColor): string;
 const
   INDENT = '* ';
-  MASK = '%sRed: %d'#13'%sGreen: %d'#13'%sBlue: %d';
+  MASK = '%3:s'#13'%4:sRed: %0:d'#13'%4:sGreen: %1:d'#13'%4:sBlue: %2:d';
 begin
   if AColor = clNone then
     Result := 'NONE'
@@ -363,14 +368,13 @@ begin
   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)]);
+    Result := Format(MASK, [
+      Red(AColor), Green(AColor), Blue(AColor), Uppercase(Result), INDENT]
+    );
   end;
+  if Assigned(FOnGetHintText) then
+    FOnGetHintText(Self, AColor, Result);
 end;
 
 function TCustomColorPalette.GetPickedColor: TColor;

components/colorpalette/demo/unit1.lfm

@@ -176,17 +176,17 @@ object MainForm: TMainForm
     ClientWidth = 160
     TabOrder = 1
     object Label3: TLabel
-      Left = 10
+      Left = 11
       Height = 15
-      Top = 183
+      Top = 230
       Width = 68
       Caption = 'Border width'
       ParentColor = False
     end
     object EdBorderWidth: TSpinEdit
-      Left = 10
+      Left = 11
       Height = 23
-      Top = 203
+      Top = 250
       Width = 58
       Alignment = taRightJustify
       MaxValue = 16
@@ -195,17 +195,17 @@ object MainForm: TMainForm
       Value = 1
     end
     object Label4: TLabel
-      Left = 93
+      Left = 94
       Height = 15
-      Top = 239
+      Top = 286
       Width = 40
       Caption = 'Btn size'
       ParentColor = False
     end
     object EdBoxSize: TSpinEdit
-      Left = 93
+      Left = 94
       Height = 23
-      Top = 259
+      Top = 306
       Width = 54
       Alignment = taRightJustify
       MinValue = 1
@@ -214,17 +214,17 @@ object MainForm: TMainForm
       Value = 16
     end
     object LblPickMode1: TLabel
-      Left = 10
+      Left = 11
       Height = 15
-      Top = 129
+      Top = 176
       Width = 68
       Caption = 'Border color:'
       ParentColor = False
     end
     object CbBorderColor: TColorBox
-      Left = 10
+      Left = 11
       Height = 22
-      Top = 149
+      Top = 196
       Width = 137
       NoneColorColor = clWindow
       Style = [cbStandardColors, cbExtendedColors, cbSystemColors, cbIncludeNone]
@@ -279,9 +279,9 @@ object MainForm: TMainForm
       TabOrder = 5
     end
     object EdColCount: TSpinEdit
-      Left = 9
+      Left = 10
       Height = 23
-      Top = 259
+      Top = 306
       Width = 59
       Alignment = taRightJustify
       MinValue = 1
@@ -290,13 +290,22 @@ object MainForm: TMainForm
       Value = 8
     end
     object Label2: TLabel
-      Left = 9
+      Left = 10
       Height = 15
-      Top = 239
+      Top = 286
       Width = 48
       Caption = 'Columns'
       ParentColor = False
     end
+    object CbCustomHintText: TCheckBox
+      Left = 10
+      Height = 19
+      Top = 117
+      Width = 108
+      Caption = 'Custom hint text'
+      OnChange = CbCustomHintTextChange
+      TabOrder = 7
+    end
   end
   object Bevel2: TBevel
     Left = 462
@@ -336,6 +345,7 @@ object MainForm: TMainForm
       ButtonHeight = 16
       ColumnCount = 8
       PickShift = [ssLeft, ssMiddle]
+      OnGetHintText = ColorPaletteGetHintText
       OnSelectColor = ColorPaletteSelectColor
       PopupMenu = PalettePopupMenu
       OnDblClick = ColorPaletteDblClick

components/colorpalette/demo/unit1.pas

@@ -26,6 +26,7 @@ type
     CbShowSelection: TCheckBox;
     CbShowColorHints: TCheckBox;
     CbBorderColor: TColorBox;
+    CbCustomHintText: TCheckBox;
     ColorDialog: TColorDialog;
     ColorPalette: TColorPalette;
     CbPickMode: TComboBox;
@@ -56,11 +57,14 @@ type
     procedure BtnLoadDefaultPalClick(Sender: TObject);
     procedure BtnLoadRndPaletteClick(Sender: TObject);
     procedure CbBuiltinPalettesSelect(Sender: TObject);
+    procedure CbCustomHintTextChange(Sender: TObject);
     procedure CbPickModeSelect(Sender: TObject);
     procedure CbShowColorHintsChange(Sender: TObject);
     procedure CbShowSelectionChange(Sender: TObject);
     procedure CbBorderColorSelect(Sender: TObject);
     procedure ColorPaletteDblClick(Sender: TObject);
+    procedure ColorPaletteGetHintText(Sender: TObject; AColor: TColor;
+      var AText: String);
     procedure ColorPaletteSelectColor(Sender: TObject; AColor: TColor);
     procedure EdBorderWidthChange(Sender: TObject);
     procedure EdBoxSizeChange(Sender: TObject);
@@ -176,6 +180,14 @@ begin
   LblGradientSteps.Enabled := EdGradientSteps.Enabled;
 end;
 
+procedure TMainForm.CbCustomHintTextChange(Sender: TObject);
+begin
+  if CbCustomHintText.Checked then
+    ColorPalette.OnGetHintText := @ColorPaletteGetHintText
+  else
+    ColorPalette.OnGetHintText := nil;
+end;
+
 procedure TMainForm.CbPickModeSelect(Sender: TObject);
 begin
   ColorPalette.PickMode := TPickMode(CbPickMode.ItemIndex);
@@ -211,6 +223,14 @@ begin
   end;
 end;
 
+procedure TMainForm.ColorPaletteGetHintText(Sender: TObject; AColor: TColor;
+  var AText: String);
+begin
+  AText := Format('This is HTML color #%0.2x%0.2x%0.2x', [
+    Red(AColor), Green(AColor), Blue(AColor)
+  ]);
+end;
+
 procedure TMainForm.ColorPaletteSelectColor(Sender: TObject; AColor: TColor);
 begin
   ColorSample.Brush.Color := AColor;
@@ -281,6 +301,7 @@ begin
     colors for the context menu. Use object inspector, or use this code:  }
   ColorPalette.PickShift := [ssLeft, ssRight];
 
+  ColorPalette.OnGetHintText := nil;
 end;
 
 procedure TMainForm.MnuDeletePickedColorClick(Sender: TObject);