拦截delphi上的提示事件

Question

我试图在组件内部的运行时临时更改提示文本,而不更改Hint属性本身.

我试过捕捉CM_SHOWHINT,但这个事件似乎只是形成,而不是组件本身.

插入CustomHint也不起作用,因为它从Hint属性中获取文本.

我的组件是后代 TCustomPanel

这是我正在尝试做的事情:

procedure TImageBtn.WndProc(var Message: TMessage);
begin
  if (Message.Msg = CM_HINTSHOW) then
    PHintInfo(Message.LParam)^.HintStr := 'CustomHint';
end;

我在互联网上找到了这个代码,不幸的是它不起作用.

Answer 1

CM_HINTSHOW确实正是你所需要的.这是一个简单的例子:

type
  TButton = class(Vcl.StdCtrls.TButton)
  protected
    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
  end;

  TMyForm = class(TForm)
    Button1: TButton;
  end;

....

procedure TButton.CMHintShow(var Message: TCMHintShow);
begin
  inherited;
  if Message.HintInfo.HintControl=Self then
    Message.HintInfo.HintStr := 'my custom hint';
end;

问题中的代码无法调用inherited,这可能是失败的原因.或者类声明可能省略了override指令WndProc.无论如何,我在这个答案中的方式更清晰.

Answer 2

您可以使用OnShowHint事件

• http://docwiki.embarcadero.com/Libraries/XE3/en/Vcl.Forms.TApplication.OnShowHint
• http://docwiki.embarcadero.com/Libraries/XE3/en/Vcl.AppEvnts.TCustomApplicationEvents.OnShowHint

它有HintInfo参数:http://docwiki.embarcadero.com/Libraries/XE3/en/Vcl.Forms.THintInfo

该参数允许您查询提示控件,提示文本和所有上下文 - 并在需要时覆盖它们.

如果你想过滤哪些组件改变提示你可以,例如,声明某种类型的ITemporaryHint界面

type 
  ITemporaryHint = interface 
  ['{1234xxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}']
    function NeedCustomHint: Boolean;
    function HintText: string;
  end;

然后,您可以稍后检查任何组件,无论它们是否实现该接口

procedure TForm1.DoShowHint(var HintStr: string; var CanShow: Boolean;
  var HintInfo: THintInfo);
var
  ih: ITemporaryHint;
begin
  if Supports(HintInfo.HintControl, {GUID for ITemporaryHint}, ih) then
    if ih.NeedCustomHint then
      HintInfo.HintStr := ih.HintText;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.ShowHint := True;
  Application.OnShowHint := DoShowHint;
end;