mbColorLib: Redo hints

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

components/mbColorLib/HRingPicker.pas

@@ -42,7 +42,7 @@ type
     procedure SetSelectedColor(c: TColor); override;
     procedure Paint; override;
     procedure Resize; override;
-    procedure CreateWnd; override;
+//    procedure CreateWnd; override;
     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
     function MouseOnPicker(X, Y: Integer): Boolean; override;
@@ -52,6 +52,7 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     function GetColorAtPoint(x, y: integer): TColor; override;
+    property ColorUnderCursor;
   published
     property Hue: integer read FHue write SetHue default 0;
     property Saturation: integer read FSat write SetSat default 0;
@@ -135,14 +136,14 @@ begin
   CreateGradient;
   UpdateCoords;
 end;
-
+  {
 procedure THRingPicker.CreateWnd;
 begin
   inherited;
   CreateGradient;
   UpdateCoords;
 end;
-
+   }
 procedure THRingPicker.UpdateCoords;
 var
   r, angle: real;
@@ -396,7 +397,7 @@ begin
     s := 255
   else
     s := MulDiv(distance, 255, radius);
-  if PointInCircle(Point(mx, my), Min(Width, Height)) then
+  if PointInCircle(Point(x, y), Min(Width, Height)) then
   begin
     if not WebSafe then
       Result := HSVtoColor(h, s, FValue)

components/mbColorLib/HSLColorPicker.pas

@@ -52,6 +52,7 @@ type
     procedure CreateWnd; override;
     procedure DoChange;
     procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+    function GetColorUnderCursor: TColor; override;
     procedure Resize; override;
     procedure Paint; override;
 //    procedure PaintParentBack; override;
@@ -62,10 +63,9 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-    function GetColorUnderCursor: TColor;
+    function GetHexColorUnderCursor: string; override;
-    function GetHexColorUnderCursor: string;
     function GetSelectedHexColor: string;
-    property ColorUnderCursor: TColor read GetColorUnderCursor;
+    property ColorUnderCursor;
     property HValue: integer read FHValue write SetH default 0;
     property SValue: integer read FSValue write SetS default 240;
     property LValue: integer read FLValue write SetL default 120;
@@ -292,7 +292,7 @@ end;
 
 function THSLColorPicker.GetColorUnderCursor: TColor;
 begin
-  Result := FHSPicker.GetColorUnderCursor;
+  Result := FHSPicker.ColorUnderCursor;
 end;
 
 function THSLColorPicker.GetHexColorUnderCursor: string;

components/mbColorLib/HSLRingPicker.pas

@@ -49,6 +49,7 @@ type
     procedure CreateWnd; override;
     procedure Paint; override;
     procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+    function GetColorUnderCursor: TColor; override;
     procedure RingPickerChange(Sender: TObject);
     procedure SLPickerChange(Sender: TObject);
     procedure DoChange;
@@ -61,10 +62,9 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-    function GetColorUnderCursor: TColor;
+    function GetHexColorUnderCursor: string; override;
-    function GetHexColorUnderCursor: string;
     function GetSelectedHexColor: string;
-    property ColorUnderCursor: TColor read GetColorUnderCursor;
+    property ColorUnderCursor;
     property HValue: integer read FHValue write SetH default 0;
     property SValue: integer read FSValue write SetS default 240;
     property LValue: integer read FLValue write SetL default 120;
@@ -324,7 +324,7 @@ end;
 
 function THSLRingPicker.GetColorUnderCursor: TColor;
 begin
-  Result := FSLPicker.GetColorUnderCursor;
+  Result := FSLPicker.ColorUnderCursor;
 end;
 
 function THSLRingPicker.GetHexColorUnderCursor: string;

components/mbColorLib/SLColorPicker.pas

@@ -41,6 +41,7 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     function GetColorAtPoint(x, y: integer): TColor; override;
+    property ColorUnderCursor;
   published
     property Hue: integer read FHue write SetHue default 0;
     property Saturation: integer read FSat write SetSat default 0;

components/mbColorLib/SLHColorPicker.pas

@@ -51,6 +51,7 @@ type
     procedure CreateWnd; override;
     procedure DoChange;
     procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+    function GetColorUnderCursor: TColor; override;
     procedure Paint; override;
 //    procedure PaintParentBack; override;
     procedure Resize; override;
@@ -59,10 +60,9 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
-    function GetColorUnderCursor: TColor;
+    function GetHexColorUnderCursor: string; override;
-    function GetHexColorUnderCursor: string;
     function GetSelectedHexColor: string;
-    property ColorUnderCursor: TColor read GetColorUnderCursor;
+    property ColorUnderCursor;
     property HValue: integer read FHValue write SetH default 0;
     property SValue: integer read FSValue write SetS default 240;
     property LValue: integer read FLValue write SetL default 120;
@@ -294,7 +294,7 @@ end;
 
 function TSLHColorPicker.GetColorUnderCursor: TColor;
 begin
-  Result := FSLPicker.GetColorUnderCursor;
+  Result := FSLPicker.ColorUnderCursor;
 end;
 
 function TSLHColorPicker.GetHexColorUnderCursor: string;

components/mbColorLib/examples/fulldemo/Demo.lpi

@@ -9,10 +9,6 @@
       <Title Value="Demo"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
-      <XPManifest>
-        <TextName Value="CompanyName.ProductName.AppName"/>
-        <TextDesc Value="Your application description."/>
-      </XPManifest>
       <Icon Value="0"/>
     </General>
     <BuildModes Count="1">

components/mbColorLib/examples/fulldemo/main.lfm

@@ -42,9 +42,9 @@ object Form1: TForm1
     Height = 384
     Top = 6
     Width = 403
-    ActivePage = TabSheet5
+    ActivePage = TabSheet10
     Anchors = [akTop, akLeft, akRight, akBottom]
-    TabIndex = 4
+    TabIndex = 10
     TabOrder = 0
     OnChange = PageControl1Change
     OnMouseMove = PageControl1MouseMove
@@ -57,8 +57,8 @@ object Form1: TForm1
         Height = 340
         Top = 8
         Width = 381
-        SelectedColor = 273922
+        SelectedColor = 2048
-        HSPickerHintFormat = 'H: %h S: %s'#13'Hex: %hex'
+        HSPickerHintFormat = 'H: %h S: %s'#13'Hex: #%hex'
         LPickerHintFormat = 'Luminance: %l'
         Anchors = [akTop, akLeft, akRight, akBottom]
         TabOrder = 0
@@ -87,7 +87,7 @@ object Form1: TForm1
         Top = 4
         Width = 289
         Anchors = [akTop, akLeft, akRight, akBottom]
-        HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h'
+        HintFormat = 'RGB(%r, %g, %b)'#13'Hex: #%hex'
         SliderMarker = smRect
         IntensityText = 'Intensity'
         TabOrder = 0
@@ -480,7 +480,7 @@ object Form1: TForm1
             'clBlack'
             'clBlack'
           )
-          HintFormat = 'RGB(%r, %g, %b)'#13'Hex: %h'
+          HintFormat = 'RGB(%r, %g, %b)'#13'Hex: #%hex'
           AutoHeight = True
           TabOrder = 0
           OnSelColorChange = mbColorPalette1SelColorChange
@@ -628,7 +628,6 @@ object Form1: TForm1
         Width = 385
         HPickerHintFormat = 'Hue: %h (selected)'
         SLPickerHintFormat = 'S: %s L: %l'#13'Hex: %hex'
-        ParentShowHint = False
         Anchors = [akTop, akLeft, akRight, akBottom]
         TabOrder = 0
         OnChange = SLHColorPicker1Change
@@ -738,12 +737,13 @@ object Form1: TForm1
         Height = 61
         Top = 284
         Width = 347
-        HintFormat = 'Hue: %h (selected)'
+        HintFormat = 'Hue: %h (under mouse)'
         Increment = 5
         ArrowPlacement = spBoth
         SelectionIndicator = siRect
         Anchors = [akLeft, akRight, akBottom]
         TabOrder = 4
+        OnGetHintStr = HColorPicker1GetHintStr
         Saturation = 120
         SelectedColor = 8882175
       end
@@ -829,7 +829,7 @@ object Form1: TForm1
         OnChange = HSColorPicker1Change
       end
       object SLColorPicker1: TSLColorPicker
-        Left = 222
+        Left = 224
         Height = 147
         Top = 144
         Width = 161
@@ -1006,7 +1006,7 @@ object Form1: TForm1
         Height = 100
         Top = 28
         Width = 100
-        HintFormat = 'G: %g B: %b'#13'Hex: %hex'
+        HintFormat = 'G: %g B: %b'#13'Hex: #%hex'
         TabOrder = 0
       end
       object GAxisColorPicker1: TGAxisColorPicker
@@ -1014,7 +1014,7 @@ object Form1: TForm1
         Height = 100
         Top = 28
         Width = 100
-        HintFormat = 'R: %r B: %b'#13'Hex: %hex'
+        HintFormat = 'R: %r B: %b'#13'Hex: #%hex'
         TabOrder = 1
         MarkerStyle = msCross
       end
@@ -1023,7 +1023,7 @@ object Form1: TForm1
         Height = 100
         Top = 28
         Width = 100
-        HintFormat = 'R: %r G: %g'#13'Hex: %hex'
+        HintFormat = 'R: %r G: %g'#13'Hex: #%hex'
         TabOrder = 2
         MarkerStyle = msCrossCirc
       end
@@ -1033,7 +1033,7 @@ object Form1: TForm1
         Top = 164
         Width = 100
         SelectedColor = 16119089
-        HintFormat = 'A: %cieA B: %cieB'#13'Hex: %hex'
+        HintFormat = 'A: %cieA B: %cieB'#13'Hex: #%hex'
         TabOrder = 3
         LValue = 88
         AValue = -47
@@ -1045,7 +1045,7 @@ object Form1: TForm1
         Top = 164
         Width = 100
         SelectedColor = 16515327
-        HintFormat = 'L: %cieL B: %cieB'#13'Hex: %hex'
+        HintFormat = 'L: %cieL B: %cieB'#13'Hex: #%hex'
         TabOrder = 4
         LValue = 60
         AValue = 96
@@ -1058,7 +1058,7 @@ object Form1: TForm1
         Top = 164
         Width = 100
         SelectedColor = 130823
-        HintFormat = 'L: %cieL A: %cieA'#13'Hex: %hex'
+        HintFormat = 'L: %cieL A: %cieA'#13'Hex: #%hex'
         TabOrder = 5
         LValue = 88
         AValue = -88
@@ -1192,6 +1192,7 @@ object Form1: TForm1
     Height = 19
     Top = 371
     Width = 62
+    Anchors = [akLeft, akBottom]
     Caption = 'Enabled'
     Checked = True
     OnChange = CbEnabledChange

components/mbColorLib/examples/fulldemo/main.pas

@@ -13,7 +13,7 @@ uses
   BColorPicker, GColorPicker, RColorPicker, KColorPicker, YColorPicker,
   MColorPicker, CColorPicker, CIEBColorPicker, CIEAColorPicker, Typinfo,
   CIELColorPicker, BAxisColorPicker, GAxisColorPicker, RAxisColorPicker,
-  mbColorTree, mbColorList {for internet shortcuts};
+  mbColorTree, mbColorList {for internet shortcuts}, mbBasicPicker;
 
 type
 
@@ -107,6 +107,8 @@ type
     CbSwatchStyle: TCheckBox;
     procedure CbEnabledChange(Sender: TObject);
     procedure CbShowHintsChange(Sender: TObject);
+    procedure HColorPicker1GetHintStr(Sender: TObject; X, Y: Integer;
+      var AText: String);
     procedure PageControl1Change(Sender: TObject);
     procedure PageControl1MouseMove(Sender: TObject; Shift: TShiftState;
       X, Y: Integer);
@@ -339,6 +341,12 @@ begin
   end; 
 end;
 
+procedure TForm1.HColorPicker1GetHintStr(Sender: TObject; X, Y: Integer;
+  var AText: String);
+begin
+  AText := FormatHint(HColorPicker1.HintFormat, HColorPicker1.GetColorAtPoint(X, Y));
+end;
+
 procedure TForm1.CheckBox1Click(Sender: TObject);
 begin
 HexaColorPicker1.SliderVisible := checkbox1.Checked;

components/mbColorLib/mbBasicPicker.pas

@@ -15,24 +15,30 @@ uses
 type
   THintState = (hsOff, hsWaitingToShow, hsWaitingToHide);
 
+  TGetHintStrEvent = procedure (Sender: TObject; X, Y: Integer; var AText: String) of object;
+
   { TmbBasicPicker }
 
   TmbBasicPicker = class(TCustomControl)
   private
+    FOnGetHintStr: TGetHintStrEvent;
+    {
     FHintWindow: THintWindow;
     FHintTimer: TTimer;
     FHintState: THintState;
     procedure HintTimer(Sender: TObject);
+    }
   protected
     FBufferBmp: TBitmap;
     FGradientWidth: Integer;
     FGradientHeight: Integer;
     FHintShown: Boolean;
     procedure CreateGradient; virtual;
+    function GetColorUnderCursor: TColor; virtual;
     function GetGradientColor(AValue: Integer): TColor; virtual;
     function GetGradientColor2D(X, Y: Integer): TColor; virtual;
-    function GetHintText: String; virtual;
+    function GetHintPos(X, Y: Integer): TPoint; virtual;
-    procedure HideHintWindow; virtual;
+    function GetHintStr(X, Y: Integer): String; virtual;
     procedure MouseLeave; override;
     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
     function MouseOnPicker(X, Y: Integer): Boolean; virtual;
@@ -40,7 +46,7 @@ type
     procedure PaintParentBack(ACanvas: TCanvas); overload;
     procedure PaintParentBack(ACanvas: TCanvas; ARect: TRect); overload;
     procedure PaintParentBack(ABitmap: TBitmap); overload;
-    function ShowHintWindow(APoint: TPoint; AText: String): Boolean; virtual;
+    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
     {$IFDEF DELPHI}
     procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
@@ -48,9 +54,14 @@ type
     procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED;
 //    procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
     {$ENDIF}
+    property ColorUnderCursor: TColor read GetColorUnderCursor;
+    property OnGetHintStr: TGetHintStrEvent read FOnGetHintStr write FOnGetHintStr;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    function GetColorAtPoint(X, Y: Integer): TColor; virtual;
+    function GetHexColorAtPoint(X, Y: integer): string;
+    function GetHexColorUnderCursor: string; virtual;
 //    function GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor; override;
   published
     property ParentColor default true;
@@ -59,7 +70,8 @@ type
 implementation
 
 uses
-  LCLIntf, mbUtils;
+  LCLIntf,
+  HTMLColors, mbUtils;
 
 const
   HINT_SHOW_DELAY = 50;
@@ -70,16 +82,43 @@ begin
   inherited Create(AOwner);
 //  ControlStyle := ControlStyle - [csOpaque];
   ParentColor := true;
+  {
   FHintTimer := TTimer.Create(self);
   FHintTimer.Interval := HINT_SHOW_DELAY;
   FHintTimer.Enabled := false;
   FHintTimer.OnTimer := @HintTimer;
   FHintState := hsOff;
+  }
 end;
 
 destructor TmbBasicPicker.Destroy;
 begin
-  HideHintWindow;
+  //HideHintWindow;
+  inherited;
+end;
+
+procedure TmbBasicPicker.CMHintShow(var Message: TCMHintShow);
+var
+  cp: TPoint;
+begin
+  if GetColorUnderCursor <> clNone then
+    with TCMHintShow(Message) do
+      if not ShowHint then
+        Message.Result := 1
+      else
+      if Hint <> '' then
+        Message.Result := 0
+      else
+      begin
+        cp := HintInfo^.CursorPos;
+        HintInfo^.ReshowTimeout := 0;  // must be zero!
+        HintInfo^.HideTimeout := Application.HintHidePause;
+        HintInfo^.HintStr := GetHintStr(cp.X, cp.Y);
+        HintInfo^.HintPos := ClientToScreen(GetHintPos(cp.X, cp.Y));
+        HintInfo^.CursorRect := Rect(cp.X, cp.Y, cp.X+1, cp.Y+1);
+        Result := 0;    // 0 means: show hint
+      end;
+
   inherited;
 end;
 
@@ -98,6 +137,30 @@ procedure TmbBasicPicker.CreateGradient;
 begin
   // to be implemented by descendants
 end;
+
+function TmbBasicPicker.GetColorAtPoint(x, y: integer): TColor;
+begin
+  Result := Canvas.Pixels[x, y];  // valid for most descendents
+end;
+
+function TmbBasicPicker.GetColorUnderCursor: TColor;
+var
+  P: TPoint;
+begin
+  P := ScreenToClient(Mouse.CursorPos);
+  Result := GetColorAtPoint(P.X, P.Y);
+end;
+
+function TmbBasicPicker.GetHexColorAtPoint(X, Y: integer): string;
+begin
+  Result := ColorToHex(GetColorAtPoint(x, y));
+end;
+
+function TmbBasicPicker.GetHexColorUnderCursor: string;
+begin
+  Result := ColorToHex(GetColorUnderCursor);
+end;
+
                                      {
 function TmbBasicPicker.GetDefaultColor(const DefaultColorType: TDefaultColorType): TColor;
 begin
@@ -114,6 +177,19 @@ begin
   Result := clNone;
 end;
 
+function TmbBasicPicker.GetHintPos(X, Y: Integer): TPoint;
+begin
+  Result := Point(X, Y);
+end;
+
+function TmbBasicPicker.GetHintStr(X, Y: Integer): String;
+begin
+  Result := '';
+  if Assigned(FOnGetHintStr) then
+    FOnGetHintStr(Self, X, Y, Result);
+end;
+
+(*
 function TmbBasicPicker.GetHintText: String;
 begin
   Result := Hint;
@@ -135,18 +211,21 @@ begin
       HideHintWindow;
   end;
 end;
-
+   *)
 procedure TmbBasicPicker.MouseLeave;
 begin
   inherited;
+    {
   HideHintWindow;
   FHintTimer.Enabled := false;
   FHintState := hsOff;
+  }
 end;
 
 procedure TmbBasicPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
 begin
   inherited;
+  {
   if ShowHint and not FHintShown then
   begin
     if MouseOnPicker(X, Y) then
@@ -159,6 +238,7 @@ begin
     else
       HideHintWindow;
   end;
+  }
 end;
 
 function TmbBasicPicker.MouseOnPicker(X, Y: Integer): Boolean;
@@ -245,7 +325,7 @@ begin
     Offscreen.Free;
   end;
 end;
-
+   (*
 // Build and show the hint window
 function TmbBasicPicker.ShowHintWindow(APoint: TPoint; AText: String): Boolean;
 const
@@ -283,6 +363,7 @@ begin
 
   Result := true;
 end;
+*)
                                  (*  !!!!!!!!!!!!!!!!!
 procedure TmbBasicPicker.WMEraseBkgnd(
   var Message: {$IFDEF DELPHI}TWMEraseBkgnd{$ELSE}TLMEraseBkgnd{$ENDIF} );

components/mbColorLib/mbColorPalette.pas

@@ -74,6 +74,9 @@ type
    procedure DrawCell(ACanvas: TCanvas; AColor: string);
    procedure DrawCellBack(ACanvas: TCanvas; R: TRect; AIndex: integer);
    procedure ColorsChange(Sender: TObject);
+   function GetColorUnderCursor: TColor; override;
+   function GetHintStr(X, Y: Integer): String; override;
+   function GetIndexUnderCursor: integer;
    procedure Resize; override;
    procedure SelectCell(i: integer);
 //   procedure CreateWnd; override;
@@ -103,11 +106,8 @@ type
   public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
-   function GetColorUnderCursor: TColor;
    function GetSelectedCellRect: TRect;
-   function GetIndexUnderCursor: integer;
+   property ColorUnderCursor;
-
-   property ColorUnderCursor: TColor read GetColorUnderCursor;
    property VisibleRowCount: integer read FRowCount;
    property RowCount: integer read GetTotalRowCount;
    property ColCount: integer read FColCount;
@@ -207,7 +207,7 @@ begin
   FColors := TStringList.Create;
   (FColors as TStringList).OnChange := ColorsChange;
   FTotalCells := 0;
-  FHintFormat := 'RGB(%r, %g, %b)'#13'Hex: %hex';
+  FHintFormat := 'RGB(%r, %g, %b)'#13'Hex: #%hex';
   FAutoHeight := false;
   FMinColors := 0;
   FMaxColors := 0;
@@ -838,6 +838,22 @@ begin
       Result := mbStringToColor(FColors.Strings[FIndex]);
 end;
 
+function TmbColorPalette.GetHintStr(X, Y: Integer): String;
+var
+  idx: Integer;
+begin
+  idx := GetIndexUnderCursor;
+  if FIndex < FNames.Count then
+    Result := FNames.Strings[FIndex]
+  else
+  if SameText(FColors.Strings[idx], 'clCustom') or
+     SameText(FColors.Strings[idx], 'clTransparent')
+  then
+    Result := StringReplace(FColors.Strings[idx], 'cl', '', [rfReplaceAll])
+  else
+    Result := FormatHint(FHintFormat, ColorUnderCursor);
+end;
+
 function TmbColorPalette.GetIndexUnderCursor: integer;
 begin
   Result := -1;
@@ -1009,21 +1025,15 @@ begin
         // show that we want a hint
         Result := 0;
         ReshowTimeout := 1;
-        HideTimeout := 5000;
+        HideTimeout := Application.HintHidePause; // was: 5000
         clr := GetColorUnderCursor;
         //fire event
         Handled := false;
         if Assigned(FOnGetHintText) then
           FOnGetHintText(clr, GetIndexUnderCursor, HintStr, Handled);
-        if Handled then Exit;
         //do default
-        if FIndex < FNames.Count then
+        if not Handled then
-          HintStr := FNames.Strings[FIndex]
+          HintStr := GetHintStr(CursorPos.X, CursorPos.Y);
-        else
-        if SameText(FColors.Strings[GetIndexUnderCursor], 'clCustom') or SameText(FColors.Strings[GetIndexUnderCursor], 'clTransparent') then
-          HintStr := StringReplace(FColors.Strings[GetIndexUnderCursor], 'cl', '', [rfReplaceAll])
-        else
-          HintStr := FormatHint(FHintFormat, GetColorUnderCursor);
       end;
     end;
   end;

components/mbColorLib/mbColorPickerControl.pas

@@ -36,7 +36,9 @@ type
     mx, my, mdx, mdy: integer;
     FOnChange: TNotifyEvent;
     procedure CreateGradient; override;
-    function GetHintText: String; override;
+//    function GetColorAtPoint(x, y: integer): TColor; override;
+//    function GetHintText: String; override;
+    function GetHintStr(X, Y: Integer): String; override;
     function GetSelectedColor: TColor; virtual;
     procedure SetSelectedColor(C: TColor); virtual;
     procedure InternalDrawMarker(X, Y: Integer; C: TColor);
@@ -59,11 +61,7 @@ type
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
   public
     constructor Create(AOwner: TComponent); override;
-    function GetColorAtPoint(x, y: integer): TColor; dynamic;
+    property ColorUnderCursor;
-    function GetHexColorAtPoint(X, Y: integer): string;
-    function GetColorUnderCursor: TColor;
-    function GetHexColorUnderCursor: string;
-    property ColorUnderCursor: TColor read GetColorUnderCursor;
     property Manual: boolean read FManual;
   published
     property SelectedColor: TColor read GetSelectedColor write SetSelectedColor;
@@ -92,6 +90,7 @@ type
     property DragKind;
     property Constraints;
     property OnContextPopup;
+    property OnGetHintStr;
     property OnMouseDown;
     property OnMouseMove;
     property OnMouseUp;
@@ -210,11 +209,11 @@ begin
   end;
 {$ENDIF}
 end;
-
+                         (*
 function TmbCustomPicker.GetHintText: String;
 begin
   Result := FormatHint(FHintFormat, GetColorUnderCursor)
-end;
+end;                       *)
 
 function TmbCustomPicker.GetSelectedColor: TColor;
 begin
@@ -227,26 +226,6 @@ begin
   //handled in descendents
 end;
 
-function TmbCustomPicker.GetColorAtPoint(x, y: integer): TColor;
-begin
-  Result := Canvas.Pixels[x, y];  // valid for most descendents
-end;
-
-function TmbCustomPicker.GetHexColorAtPoint(X, Y: integer): string;
-begin
-  Result := ColorToHex(GetColorAtPoint(x, y));
-end;
-
-function TmbCustomPicker.GetColorUnderCursor: TColor;
-begin
-  Result := GetColorAtPoint(mx, my);
-end;
-
-function TmbCustomPicker.GetHexColorUnderCursor: string;
-begin
-  Result := ColorToHex(GetColorAtPoint(mx, my));
-end;
-
 procedure TmbCustomPicker.InternalDrawMarker(X, Y: Integer; C: TColor);
 begin
   case MarkerStyle of
@@ -256,24 +235,41 @@ begin
     msCrossCirc : DrawSelCrossCirc(x, y, Canvas, c);
   end;
 end;
-             (*
+
+function TmbCustomPicker.GetHintStr(X, Y: Integer): String;
+begin
+  Result := FormatHint(FHintFormat, GetColorUnderCursor);
+end;
+
+                 (*
 procedure TmbCustomPicker.CMHintShow(var Message: TCMHintShow);
+var
+  cp: TPoint;
 begin
   if GetColorUnderCursor <> clNone then
     with TCMHintShow(Message) do
       if not ShowHint then
         Message.Result := 1
       else
+      begin
+        cp := HintInfo^.CursorPos;
+        HintInfo^.ReshowTimeout := 0;  // was: 1
+        HintInfo^.HideTimeout := Application.HintHidePause;  // was: 5000
+        HintInfo^.HintStr := FormatHint(FHintFormat, GetColorUnderCursor);
+        HintInfo^.CursorRect := Rect(cp.X, cp.Y, cp.X+1, cp.Y+1);
+        Result := 0;    // 0 means: show hint
+      end;
+{
         with HintInfo^ do
         begin
           Result := 0;
           ReshowTimeout := 1;
           HideTimeout := 5000;
           HintStr := FormatHint(FHintFormat, GetColorUnderCursor);;
-        end;
+        end; }
   inherited;
-end;       *)
+end;
-
+              *)
 procedure TmbCustomPicker.MouseMove(Shift: TShiftState; X, Y: Integer);
 begin
   inherited;

components/mbColorLib/mbColorTree.pas

@@ -10,7 +10,7 @@ interface
 
 uses
   {$IFDEF FPC}
-  LCLIntf, LCLType, LMessages,
+  LCLIntf, LCLType,
   {$ELSE}
   Windows, Messages,
   {$ENDIF}

components/mbColorLib/mbTrackBarPicker.pas

@@ -40,6 +40,8 @@ type
   TSliderPlacement = (spBefore, spAfter, spBoth);
   TSelIndicator = (siArrows, siRect);
 
+  { TmbTrackBarPicker }
+
   TmbTrackBarPicker = class(TmbBasicPicker)
   private
     mx, my: integer;
@@ -85,15 +87,15 @@ type
     procedure CreateWnd; override;
     procedure Execute(tbaAction: integer); dynamic;
     function GetArrowPos: integer; dynamic;
-    function GetHintText: string; override;
+//    function GetColorUnderCursor: TColor; override;
+    function GetHintPos(X, Y: Integer): TPoint; override;
+    function GetHintStr(X, Y: Integer): String; override;
     function GetSelectedValue: integer; virtual; abstract;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
     procedure MouseLeave; override;
     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
     function MouseOnPicker(X, Y: Integer): Boolean; override;
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
-    function ShowHintWindow(APoint: TPoint; AText: String): Boolean; override;
-//    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
     procedure WheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
     procedure WheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
     {$IFDEF DELPHI}
@@ -143,6 +145,7 @@ type
     property Constraints;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
     property OnContextPopup;
+    property OnGetHintStr;
     property OnMouseDown;
     property OnMouseMove;
     property OnMouseUp;
@@ -762,18 +765,63 @@ begin
   if not FInherited and Assigned(OnKeyDown) then
     OnKeyDown(Self, Message.CharCode, Shift);
 end;
-                                  (*
+
+function TmbTrackBarPicker.GetHintPos(X, Y: Integer): TPoint;
+begin
+  case FLayout of
+    lyHorizontal:
+      Result := Point(X - 8, Height + 2);
+    lyVertical:
+      Result := Point(Width + 2, Y - 8);
+  end;
+end;
+
+function TmbTrackBarPicker.GetHintStr(X, Y: Integer): string;
+begin
+  Result := inherited GetHintStr(X, Y);
+  if Result = '' then
+    Result := ReplaceFlags(FHintFormat, ['%value', '%h', '%s', '%l', '%v', '%c',
+      '%m', '%y', '%k', '%r', '%g', '%b'], GetSelectedValue);
+end;
+            (*
 procedure TmbTrackBarPicker.CMHintShow(var Message: TCMHintShow);
+var
+  cp: TPoint;
 begin
   with TCMHintShow(Message) do
     if not ShowHint then
-      Message.Result := 1
+      Message.Result := 1      // 1 means: hide hint
     else
+    begin
+      cp := HintInfo^.CursorPos;
+      HintInfo^.ReshowTimeout := 0;  // was: 1
+      HintInfo^.HideTimeout := Application.HintHidePause;  // was: 5000
+      HintInfo
+      case FLayout of
+        lyHorizontal:
+          HintInfo^.HintPos := ClientToScreen(Point(cp.X - 8, Height + 2));
+        lyVertical:
+          HintInfo^.HintPos := ClientToScreen(Point(Width +2, cp.Y - 8));
+      end;
+      HintInfo^.HintStr := GetHintStr;
+      HintInfo^.CursorRect := Rect(cp.X, cp.Y, cp.X+1, cp.Y+1);
+      Result := 0;    // 0 means: show hint
+    end;
+  inherited;
+end;          *)
+
+{
+
       with HintInfo^ do
       begin
+        if HintControl <> self then
+        begin
+          Message.Result := -1;
+          exit;
+        end;
         Result := 0;
         ReshowTimeout := 1;
-        HideTimeout := 5000;
+        HideTimeout := 0; //5000;
         if FLayout = lyHorizontal then
           HintPos := ClientToScreen(Point(CursorPos.X - 8, Height + 2))
         else
@@ -781,8 +829,8 @@ begin
         HintStr := GetHintStr;
       end;
   inherited;
-end;           *)
+end;
-
+ }
 procedure TmbTrackBarPicker.CMGotFocus(
   var Message: {$IFDEF FPC}TLMessage{$ELSE}TCMGotFocus{$ENDIF});
 begin
@@ -885,11 +933,12 @@ begin
   //handled in descendants
 end;
 
+                           (*
 function TmbTrackBarPicker.GetHintText: string;
 begin
   Result := ReplaceFlags(FHintFormat, ['%value', '%h', '%s', '%l', '%v', '%c',
   '%m', '%y', '%k', '%r', '%g', '%b'], GetSelectedValue);
-end;
+end;                         *)
 
 procedure TmbTrackBarPicker.SetBevelInner(Value: TBevelCut);
 begin
@@ -927,11 +976,12 @@ begin
   end;
 end;
 
+(*
 function TmbTrackbarPicker.ShowHintWindow(APoint: TPoint; AText: String): Boolean;
 begin
   Result := inherited;
   if Result then
     FHintShown := true;
 end;
-
+  *)
 end.