spktoolbar: Implement hints. Issue #39022, patch by michalgw.

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

components/spktoolbar/SpkToolbar/SpkToolbar.pas

@@ -330,6 +330,8 @@ type
     { Message is received when mouse left the region of component }
     procedure CMMouseLeave(var msg: TLMessage); message CM_MOUSELEAVE;
 
+    procedure CMHintShow(var Message: TLMessage); message CM_HINTSHOW;
+
     // **************************
     // *** Designtime and LFM ***
     // **************************
@@ -480,6 +482,8 @@ type
     // *** Menu Button ***
     procedure DoMenuButtonClick;
 
+    function ElementAt(X, Y: Integer): TSpkComponent;
+
   published
 
     { Component background color }
@@ -543,6 +547,7 @@ type
     property ShowHint;
     property Visible;
     property OnResize;
+    property OnShowHint;
 
   end;
 
@@ -550,7 +555,7 @@ type
 implementation
 
 uses
-  LCLIntf, Themes;
+  LCLIntf, Themes, spkt_Buttons;
 
 
 { TSpkToolbarDispatch }
@@ -641,6 +646,33 @@ begin
   MouseLeave;
 end;
 
+procedure TSpkToolbar.CMHintShow(var Message: TLMessage);
+var
+  PanelIdx, ItemIdx: Integer;
+begin
+  inherited;
+  if TabIndex >= 0 then
+  begin
+    PanelIdx := Tabs[TabIndex].FindPaneAt(TCMHintShow(Message).HintInfo^.CursorPos.X,
+      TCMHintShow(Message).HintInfo^.CursorPos.Y);
+    if PanelIdx >= 0 then
+    begin
+      ItemIdx := Tabs[TabIndex].Panes[PanelIdx].FindItemAt(TCMHintShow(Message).HintInfo^.CursorPos.X,
+        TCMHintShow(Message).HintInfo^.CursorPos.Y);
+      if ItemIdx >= 0 then
+        with Tabs[TabIndex].Panes[PanelIdx].Items[ItemIdx], TCMHintShow(Message) do
+        begin
+          HintInfo^.HintStr := Hint;
+          HintInfo^.CursorRect := Rect.ForWinAPI;
+          if Tabs[TabIndex].Panes[PanelIdx].Items[ItemIdx] is TSpkBaseButton then
+            with Tabs[TabIndex].Panes[PanelIdx].Items[ItemIdx] as TSpkBaseButton do
+              if (ActionLink <> nil) then
+                ActionLink.DoShowHint(HintInfo^.HintStr);
+        end;
+    end;
+  end;
+end;
+
 constructor TSpkToolbar.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
@@ -2621,4 +2653,26 @@ begin
     FOnMenuButtonClick(self);
 end;
 
+function TSpkToolbar.ElementAt(X, Y: Integer): TSpkComponent;
+var
+  PaneIdx, ItemIdx: Integer;
+begin
+  if TabIndex < 0 then
+    Result := nil
+  else
+  begin
+    PaneIdx := Tabs[TabIndex].FindPaneAt(X, Y);
+    if PaneIdx < 0 then
+      Result := Tabs[TabIndex]
+    else
+    begin
+      ItemIdx := Tabs[TabIndex].Panes[PaneIdx].FindItemAt(X, Y);
+      if ItemIdx < 0 then
+        Result := Tabs[TabIndex].Panes[PaneIdx]
+      else
+        Result := Tabs[TabIndex].Panes[PaneIdx].Items[TabIndex];
+    end;
+  end;
+end;
+
 end.

components/spktoolbar/SpkToolbar/spkt_BaseItem.pas

@@ -16,7 +16,7 @@ unit spkt_BaseItem;
 interface
 
 uses
-  Graphics, Classes, Controls,
+  Graphics, Classes, Controls, LCLType,
   SpkMath, spkt_Appearance, spkt_Dispatch, spkt_Types;
 
 type
@@ -26,8 +26,11 @@ type
 
   TSpkItemGroupBehaviour = (gbSingleItem, gbBeginsGroup, gbContinuesGroup, gbEndsGroup);
 
+  { TSpkBaseItem }
+
   TSpkBaseItem = class abstract(TSpkComponent)
   private
+    FHint: TTranslateString;
   protected
     FRect: T2DIntRect;
     FToolbarDispatch: TSpkBaseToolbarDispatch;
@@ -52,6 +55,8 @@ type
     procedure SetImagesWidth(const Value: Integer);
     procedure SetLargeImagesWidth(const Value: Integer);
 
+    function IsHintStored: Boolean; virtual;
+
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
@@ -83,6 +88,7 @@ type
   published
     property Visible: boolean read FVisible write SetVisible default true;
     property Enabled: boolean read FEnabled write SetEnabled default true;
+    property Hint: TTranslateString read FHint write FHint stored IsHintStored;
   end;
 
   TSpkBaseItemClass = class of TSpkBaseItem;
@@ -170,6 +176,11 @@ begin
   FRect := Value;
 end;
 
+function TSpkBaseItem.IsHintStored: Boolean;
+begin
+  Result := True;
+end;
+
 procedure TSpkBaseItem.SetVisible(const Value: boolean);
 begin
   if Value <> FVisible then

components/spktoolbar/SpkToolbar/spkt_Buttons.pas

@@ -28,6 +28,8 @@ type
 
   TSpkBaseButton = class;
 
+  { TSpkButtonActionLink }
+
   TSpkButtonActionLink = class(TActionLink)
   protected
     FClient: TSpkBaseButton;
@@ -40,13 +42,16 @@ type
     procedure SetImageIndex(Value: integer); override;
     procedure SetVisible(Value: Boolean); override;
     procedure SetOnExecute({%H-}Value: TNotifyEvent); override;
+    procedure SetHint(const Value: string); override;
   public
+    function DoShowHint(var HintStr: string): Boolean; virtual;
     function IsCaptionLinked: Boolean; override;
     function IsCheckedLinked: Boolean; override;
     function IsEnabledLinked: Boolean; override;
     function IsGroupIndexLinked: Boolean; override;
     function IsImageIndexLinked: Boolean; override;
     function IsVisibleLinked: Boolean; override;
+    function IsHintLinked: Boolean; override;
   end;
 
 
@@ -102,6 +107,8 @@ type
     procedure SetEnabled(const Value: boolean); override;
     procedure SetRect(const Value: T2DIntRect); override;
 
+    function IsHintStored: Boolean; override;
+
     property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default false;
     property ButtonKind: TSpkButtonKind read FButtonKind write SetButtonKind default bkButton;
     property Checked: Boolean read GetChecked write SetChecked default false;
@@ -121,6 +128,8 @@ type
 
     function GetRootComponent: TComponent;
 
+    property ActionLink: TSpkButtonActionLink read FActionLink;
+
   published
     property Action: TBasicAction read GetAction write SetAction;
     property Caption: string read FCaption write SetCaption;
@@ -264,6 +273,12 @@ begin
             (FClient.Visible = (Action as TCustomAction).Visible);
 end;
 
+function TSpkButtonActionLink.IsHintLinked: Boolean;
+begin
+  Result := inherited IsHintLinked and Assigned(FClient) and
+            (FClient.Hint = (Action as TCustomAction).Hint);
+end;
+
 procedure TSpkButtonActionLink.SetCaption(const Value: string);
 begin
   if IsCaptionLinked then
@@ -305,6 +320,28 @@ begin
 //       TControl.Click executes Action
 end;
 
+procedure TSpkButtonActionLink.SetHint(const Value: string);
+begin
+  if IsHintLinked then
+    FClient.Hint := Value;
+end;
+
+function TSpkButtonActionLink.DoShowHint(var HintStr: string): Boolean;
+begin
+  Result := True;
+  if Action is TCustomAction then
+  begin
+    if TCustomAction(Action).DoHint(HintStr)
+    and Application.HintShortCuts
+    and (TCustomAction(Action).ShortCut <> scNone) then
+    begin
+      if HintStr <> '' then
+        HintStr := Format('%s (%s)', [HintStr,
+                               ShortCutToText(TCustomAction(Action).ShortCut)]);
+    end;
+  end;
+end;
+
 procedure TSpkButtonActionLink.SetVisible(Value: Boolean);
 begin
   if IsVisibleLinked then
@@ -348,11 +385,8 @@ begin
     if not CheckDefaults or Enabled then
       Enabled := newAction.Enabled;
 
-    {  wp: !!! Hints not yet supported !!!
-
     if not CheckDefaults or (Hint = '') then
       Hint := newAction.Hint;
-    }
 
     if not CheckDefaults or Visible then
       Visible := newAction.Visible;
@@ -898,6 +932,11 @@ begin
   CalcRects;
 end;
 
+function TSpkBaseButton.IsHintStored: Boolean;
+begin
+  Result := (FActionLink = nil) or not FActionLink.IsHintLinked;
+end;
+
 function TSpkBaseButton.SiblingsChecked: Boolean;
 var
   i: Integer;

components/spktoolbar/SpkToolbar/spkt_Tab.pas

@@ -73,9 +73,6 @@ type
     // *** Sets the appropriate appearance tiles ***
     procedure SetPaneAppearance; inline;
 
-    // *** Sheet search ***
-    function FindPaneAt(x, y: integer): integer;
-
     // *** Designtime and LFM support ***
     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
     procedure DefineProperties(Filer: TFiler); override;
@@ -111,6 +108,9 @@ type
     procedure MouseMove(Shift: TShiftState; X, Y: Integer);
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
 
+    // *** Sheet search ***
+    function FindPaneAt(x, y: integer): integer;
+
     // *** Dispatcher event handling ***
     procedure NotifyAppearanceChanged;