Delphi в Интернет, блог Delphi программистов

Помнится в одном из постов про 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 в котором и описан рассмотренный в статье класс. Скачивайе.

UPDATE:

Компонент TMyRibbonGroup с возможностью показа ScreenTip для кнопки ВialogAction. Для установки компонента создайте пустрой bpl, поместите файл MyRibbonGroup.pas в проект и выберите в меню "Install".

Под постом

Сегодня первый пост в котором публикуются обзоры IT-блого в рамках Акции.

И самым активным блогом за прошедшие сутки стал блог Александа Божко "Delphi 2010"

В блоге "Delphi 2010" вы всегда сможете найти много интересной и полезной информации о Delphi, приемах программирования и обо всем, что с программированием связано. В числе прочих статей, наибольший интерес уменя, как постоянного посетителя и читателя этого блога, вызвали статьи про новый RTTI Delphi 2010 (перевод цикла статей) и серия постов про редизайн интерфейса приложения в которых автор делился опытом работы с компонентами DevExpress.

Делись!	Загружай!	Плюсуй!
	Отправить PDF на

Комментарии (6)

• angryvitum пишет:
  24 Июл 2010 в 12:01 пп

  А нельзя ли использовать «метод Geo» в этом случае? Тогда, наверное, не пришлось бы потом динамически создавать элементы на Ribbon…

• Vlad пишет:
  24 Июл 2010 в 12:56 пп

  про метод читал в Королевстве, но, никогда не использовал :) Мне проще динамически создать элементы Ribbon’а, тем более, что проблем с их созданием не так уж и много.

• Александр Божко пишет:
  24 Июл 2010 в 4:11 пп

  Влад, спасибо за обзор моего блога.

  Кстати, сейчас начал работать с родными Ribbon’ами и сразу появились вопросы. Так, что возможно. в ближайшем будущем, подкину материал к посту о глюках.

• Vlad пишет:
  24 Июл 2010 в 5:17 пп

  Спасибо, Александр. Буду премного благодарен за материал, т.к. я его можно сказать коллекционирую в последнее время :)

• Егор пишет:
  25 Июл 2010 в 10:37 пп

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

• Vlad пишет:
  26 Июл 2010 в 1:37 пп

  Егор, к посту UPDATE добавил. А в Справочник видимо компонент попадет после того как будет начата работа над второй частью :)

Ваш ответ