delphi - 向第三方组件添加类似 OnHint 的功能

Question

由于外观原因，我正在维护的应用程序使用了 DevExpress 中的一个古老组件，该组件早于其当前的网格控件(如果您感兴趣，请使用 TdxMasterView)。我想要做的是有一个显示当前单元格文本的工具提示，但是该组件没有公开 OnHint 事件。

我已经能够使用 MouseMove 事件获得所需的功能，但是由于代码要求它将鼠标光标转换为单元格，然后检索内容，我认为这对于以下事件来说代码太多如此频繁地触发(尽管它在操作中并没有感觉太滞后)。

组件本身源自TCustomControl，因此具有基本的Hint和ShowHint属性，但是我认为我想要的是能够公开或添加仅在显示提示气泡时才会触发的事件(即 OnHint 事件或等效事件)。获得正确文本所需的只是鼠标的 X 和 Y 坐标。这似乎与 TControlAction 相关，但是我不完全确定它是如何工作的，因为乍一看代码并不能立即清楚，并且组件也没有公开它。

有没有人有任何示例代码，可以实现类似的效果？我可以访问底层源代码，因此可以根据需要对其进行一些修改(DevExpress 永远不会发布对此代码的更新，因此这样做的正常风险并不真正适用)，但我更喜欢通过辅助函数来工作、windows 消息或某种装饰器(如果可能的话)。

我想另一个选择是有一个计时器来启用/禁用该事件，但这似乎是一个有点糟糕(如果简单)的解决方案。

Answer 1

实现过程 CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; 在您的代码中。

procedure TMyComponent.CMHintShow(var Message: TCMHintShow);
var
  CellIdx: Integer;
  Handled: Boolean;
  HintStr: string;
  LHintInfo: PHintInfo;
begin
  Message.Result := 1; // Don't show the hint
  if Message.HintInfo.HintControl = Self then
  begin
    with Message.HintInfo.CursorPos do
    begin
      CellIdx := ImageAtPos(X, Y);
    end;

    Handled := False;
    HintStr := '';
    if Assigned(FOnGetHint) then
      FOnGetHint(Self, CellIdx, HintStr, Handled);
    LHintInfo := Message.HintInfo;
    if (CellIdx <> -1) then
    begin
      if not Handled then
        HintStr := Hint;
      LHintInfo.CursorRect := GetCellRect(CellIdx);
      Handled := True;
    end;
    if Handled then
    begin
      LHintInfo.HintStr := HintStr;
      Message.Result := 0; // Show the hint
    end;
  end;
end;