Ribbon Controls в Delphi. ScreenTip для кнопки DialogAction группы.

Помнится в одном из постов про Ribbon Controls в Delphi, а точнее в посте «Ribbon Controls шаг за шагом. Шаг 3 – работа со ScreenTips.» я затрагивал момент работы с подсказками Ribbon применительно к TRibbonGroup. Тогда решение поставленной задачи, а именно — показ подсказки в момент наведения курсора мыши на кнопку DialogAction ограничилось тем, что смогли нам дать разработчики Delphi в готовом виде. Получилось, конечно не совсем то, что ожидалось, но другого решения на тот момент у меня не было.
На данный момент мы с Вами уже знаем как создавать элементы управления «на лету», поэтому можно рассмотреть задачу работы с DialogAction уже чуть более детально и добиться точного решения.
В начале рассмотрим суть проблемы.

Если вы запустите MS Word 2007 и наведете курсор мыши на кнопку DialogAction первой же группы (буфер обмена), то увидите вот такую красивую подсказку:

Причём, обратите внимание, что подсказка появляет только когда курсор мыши находится над кнопкой. Когда курсор перемещается по заголовку группы — подсказки нет.
В Delphi же дела обстоят несколько иначе — подсказка (TScreenTipsPopup) ассоциируется не с кнопкой DialogAction, а сразу со всей группой. И не важно где находится курсор мыши — подсказка упорно вываливается каждый раз как курсор попадает в область группы. А ведь хочется так как у всех. Так как надо.
Вот в этом и состоит наша сегодняшняя задача — отобразить подсказку именно для DialogAction.
Для решения поставленной задачи нам понадобятся:

1. 1 TActionManager
2. 1 TRibbon
3. 1 TScreenTipsManager
4. 1 TScreenTipsPopup

Надеюсь, что Вы уже в курсе как работать с этими компонентами и представляете себе (хотя бы примерно) их «внутренности». Если нет, то советую сначала ознакомиться со статьями по Ribbon Controls в блоге или отложть чтение этого поста до выхода справочника по Delphi (он уже пишется во всю — скоро будет готов).

Размещаем компоненты на форме, указываем необходимые свойства, а также создаем одно действие в Action Manager, назовем его «act_dialog» — оно и будет у нас находится в DialogAction группы Ribbon.

Теперь немного разберемся с тем, почему нельзя «повесить» новую подсказку на кнопку DialogAction группы? Говоря кратко, действия разворачиваются следующим образом: по умолчанию текст подсказки выбирается из свойства Hint для TAction, затем, в момент наведения курсора мыши на объект показывается подсказка и срабатывает событие OnHint все у того же TAction.

Казалось бы все должно быть логично — при определении свойства DialogAction мы в Object Inspector явно указываем TAction, следовательно есть и Hint и должно быть событие OnHint. Оказывается нет. Откройте модуль Ribbon.pas и найдите в нем описание класса TCustomRibbonGroup — предка TRibbonGroup:

TCustomRibbonGroup = class(TCustomActionControlBar, IRibbonGroup,
    IRibbonBarKeyTip, IRibbonKeyTip)
  public
    [...]
  private
    [...]
    FDialogAction: TContainedAction;
    [...]
  protected
    [...]
    procedure DrawShowDialogButton; virtual;
    [...]
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    [...]
    property DialogAction: TContainedAction read FDialogAction write SetDialogAction;
    [...]
end;

свойство DialogAction представляет собой объект TContainedAction. Если Вы посмотрите, что это за объект и какие он имеет свойства, то убедитесь, что у этого объекта нет ни свойства Hint, ни соответственно события OnHint, а сама кнопка, которую мы видим в программе никак не контейнер для объекта (как в самой группе), а просто скин, натянутый поверх заголовка.

Собственно это есть причина того, почему подсказка ассоциируется сразу со всей группой.
Ближайшим наследником TContainedAction у которого есть необходимые нам свойства является объект TCustomAction.

Следовательно, мы можем поступить следующим образом — создать собственного наследника от TCustomRibbonGroup и сделать у него свойство DialogAction таким, какое нам необходимо, а именно TCustomAction.

type
  TMyRibbonGroup = class(TCustomRibbonGroup)
  private
    FDialogAction: TCustomAction;
    procedure SetDialogAction(const Value: TCustomAction);
  public
    constructor Create(AOwner:TComponent);override;
  published
    property DialogAction: TCustomAction read FDialogAction write SetDialogAction;
end;
 
procedure TMyRibbonGroup.SetDialogAction(const Value: TCustomAction);
begin
 inherited DialogAction:=Value;
 if FDialogAction <> Value then
  begin
    if FDialogAction <> nil then
      FDialogAction.RemoveFreeNotification(Self);
    FDialogAction := Value;
    FDialogAction.FreeNotification(Self);
    Invalidate;
  end;
end;

Теперь нам необходимо решить вопрос: как мы узнаем, что курсор находится именно над кнопкой DialogAction, а не на заголовке или ещё где-либо? Определим следующие методы в нашем новом классе:

function TMyRibbonGroup.GetCaptionRect: TRect;
begin
  Result := Rect(1, Height - GetCaptionHeight - 1, Width - 2, Height - 2);
end;
 
function TMyRibbonGroup.GetDialogButtonRect: TRect;
begin
  Result := GetCaptionRect;
  Result.Left := Result.Right - 15;
  Result.Bottom := Result.Top + 14;
end;

Исходя из названий методов уже должно быть понятно, что метод GetCaptionRect возвращает нам TRect для всего заголовка группы, а GetDialogButtonRect — TRect только для кнопки.

Теперь нам остается создать у нашего класса два события OnMouseMove — чтобы определить, что курсор движется по группе и ещё одно, например OnHotDialogButton — чтобы поймать момент, когда курсор находится в области кнопки.
Определим в классе следующие поля:

type
  TOnHotDialogButton = TNotifyEvent;
 
TMyRibbonGroup = class(TCustomRibbonGroup)
  private
    FDialogAction: TCustomAction;
    FOnMouseMove: TMouseMoveEvent;//мышь движется по области группы
    FDialogButtonHot: boolean; //указывает на то, что кнопка выделена
    FOnHotDialogButton:TOnHotDialogButton; //мышь находится на кнопке
[..]
end;

В TCustomRibbonGroup есть следующий метод:

  procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer);override;

Воспользуемся им для решения нашей задачи:

type
  TMyRibbonGroup = class(TCustomRibbonGroup)
  private
    [...]
     procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
  protected
    [...]
  end;
 
procedure TMyRibbonGroup.MouseMove(Shift: TShiftState; X, Y: Integer);
var  LPt: TPoint;
begin
  inherited;
  if Assigned(FOnMouseMove) then
    FOnMouseMove(Self,Shift, X, Y);
  if (FDialogAction <> nil) then
   begin
     LPt := Point(X, Y);
     FDialogButtonHot:= not DesignMode and PtInRect(GetDialogButtonRect, LPt);
   end;
  if FDialogButtonHot then
    if Assigned(FOnHotDialogButton) then
      begin
        FOnHotDialogButton(Self);
      end;
end;

Теперь остается только воспользоваться нашими наработками. Во первых, создадим обработчики события для нашего компонента:

type
  TForm6 = class(TForm)
    [..]
    procedure act_dialogExecute(Sender: TObject);
  private
    procedure HintDialog(Sender: TObject);
    procedure MouseMove(Sender: TObject;Shift: TShiftState; X, Y: Integer);
  public
    { Public declarations }
  end;
 
var
  Form6: TForm6;
  MyGroup: TMyRibbonGroup;
 
implementation
 
procedure TForm6.act_dialogExecute(Sender: TObject);
begin
  ShowMessage('Its MyActionDialog!')
end;
 
procedure TForm6.HintDialog(Sender: TObject);
begin
  ScreenTipsPopup1.Action:=act_dialog; //определили попапу действие
  ScreenTipsPopup1.Associate:=MyGroup //ассоциировали попап с группой
end;
 
procedure TForm6.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  Ribbon1.DocumentName:=IntToStr(X)+' '+IntToStr(Y);
end;

Теперь у ScreenTipManager’а определяем обработчик события OnShowScreenTip:

procedure TForm6.ScreenTipsManager1ShowScreenTip(Manager: TObject;
  Action: TBasicAction; var ShowScreenTip: Boolean);
begin
  ShowScreenTip:=MyGroup.DialogButtonHot; //показываем подсказку если кнопка выделена
end;

Так как я не собираюсь сейчас в посте разрабатывать новый офис, то обработчик у меня прост как 3 копейки. Вам же, в случае работы с большим приложением придётся этот обработчик немного усложнить, чтобы остальные подсказки, определенные в менеджере показывались.

Теперь нам остается только создать новую группу и определить у неё DialogAction. Сделать это можно, например так (по клику на кнопке Button1):

procedure TForm6.Button1Click(Sender: TObject);
var
    RibbonTabItem:TRibbonTabItem;
    a:TActionClientItem;
begin
  RibbonTabItem:=TRibbonTabItem.Create(Ribbon1.Tabs);//создали вкладку
  MyGroup:=TMyRibbonGroup.Create(RibbonTabItem.page);//создали группу
  RibbonTabItem.Page.AddGroup(MyGroup);//поместили группу на вкладку
  MyGroup.Parent:=RibbonTabItem.Page;//определили родителя
 
  MyGroup.Caption:='MyGroup';//дали название группе
 
  MyGroup.DialogAction:=act_dialog;//назначили действие кнопке
  MyGroup.OnHotDialogButton:=HintDialog;//определили событие
  MyGroup.OnMOuseMove:=MouseMove;//определили событие
end;

Теперь запускаем приложение и любуемся результатом — когда курсор попадает на кнопку DialogAction появляется подсказка, в остальных случаях её нет. Что и требовалось доказать сделать.

На всякий случай выкладуваю архив с готовым приложением, а также модулем MyRibbonGroup в котором и описан рассмотренный в статье класс. .