向第三方组件添加类似 OnHint 的功能
Adding OnHint-like functionality to a third party component
由于外观原因,我正在维护的应用程序使用了 DevExpress 中的一个古老组件,该组件早于其当前的网格控件(如果您感兴趣,则为 TdxMasterView)。我想要做的是有一个显示当前单元格文本的工具提示,但是这个组件没有公开 OnHint 事件。
我已经能够使用 MouseMove 事件获得我需要的功能,但是由于代码需要它将鼠标光标转换为单元格然后检索内容我认为这对于一个事件来说代码太多了被如此频繁地触发(尽管它在操作中不会感觉太迟钝)。
组件本身派生自 TCustomControl
,因此具有基本的 Hint
和 ShowHint
属性,但是我想我想要的是能够公开或添加一个仅当显示提示气泡时才会触发的事件(即 OnHint 事件或等效事件)。要获得正确的文本,我只需要鼠标的 X 和 Y 坐标。这似乎与 TControlAction
相关联,但是我不完全确定它是如何工作的,因为乍一看代码并不是很清楚,而且它没有被组件公开。
有没有人有实现类似功能的示例代码?我可以访问底层源代码,因此可以根据需要对其进行一些修改(DevExpress 永远不会发布对此代码的更新,因此这样做的正常风险并不适用),但我更愿意通过辅助函数工作, windows 消息或某种装饰器(如果可能的话)。
我想另一个选择是为 enable/disable 事件设置一个计时器,但这似乎有点糟糕(如果简单的话)解决方案。
在您的代码中实现 procedure 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;
由于外观原因,我正在维护的应用程序使用了 DevExpress 中的一个古老组件,该组件早于其当前的网格控件(如果您感兴趣,则为 TdxMasterView)。我想要做的是有一个显示当前单元格文本的工具提示,但是这个组件没有公开 OnHint 事件。
我已经能够使用 MouseMove 事件获得我需要的功能,但是由于代码需要它将鼠标光标转换为单元格然后检索内容我认为这对于一个事件来说代码太多了被如此频繁地触发(尽管它在操作中不会感觉太迟钝)。
组件本身派生自 TCustomControl
,因此具有基本的 Hint
和 ShowHint
属性,但是我想我想要的是能够公开或添加一个仅当显示提示气泡时才会触发的事件(即 OnHint 事件或等效事件)。要获得正确的文本,我只需要鼠标的 X 和 Y 坐标。这似乎与 TControlAction
相关联,但是我不完全确定它是如何工作的,因为乍一看代码并不是很清楚,而且它没有被组件公开。
有没有人有实现类似功能的示例代码?我可以访问底层源代码,因此可以根据需要对其进行一些修改(DevExpress 永远不会发布对此代码的更新,因此这样做的正常风险并不适用),但我更愿意通过辅助函数工作, windows 消息或某种装饰器(如果可能的话)。
我想另一个选择是为 enable/disable 事件设置一个计时器,但这似乎有点糟糕(如果简单的话)解决方案。
在您的代码中实现 procedure 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;