在某些组件上更改鼠标光标而不影响其他光标设置代码
我在Delphi XE2中使用DevExpress QuantumGrid(MasterView)的古代前驱,并希望某些单元有效地充当超链接(将鼠标光标从将crDefault设置为crHandPoint,并在点击时触发一个操作)。在某些组件上更改鼠标光标而不影响其他光标设置代码
网格组件的配置是这样的,单个单元格不是它们自己的组件,我需要从鼠标光标坐标中找到单元格并从那里设置光标。
我想我需要在我的网格对象上设置一些事件来达到这个目的,但我对这些事件如何与代码进行交互有点不舒服,这些事件在做长时间运行时将光标设置为沙漏目前使用IDisposible进行处理以在完成时将光标恢复为原始值),并且希望在我开始之前仔细检查是否有更好的方法来完成此操作,然后找到一大堆边缘案例,将鼠标光标置于错误状态。
我想我需要重写:
- omMouseMove - 获得XY坐标,并设置光标到手动/箭头
- onmousedown事件 - 获得XY坐标如果存在“激活”超链接(可能还原为箭头?超链接通常会打开一个新窗口,并且调用的代码可能会将光标更改为沙漏)
- onMouseLeave - 将光标重置为箭头(此事件实际上并未公开,所以 认为我需要手动处理消息)
这种功能在TButton上是默认的,但我在VCL中看不到它是如何实现的,并且可能是底层Windows控件的一个功能。
我实际上在浏览SO时发现了解决方案。
,我忘了成分通常有自己的Cursor属性,这是他们如何设定正确的鼠标光标的类型时,指针在他们(即按钮的行为)
通过重写的MouseMove改变光标crHandPoint
如果它超过了超链接单元格,并且存储旧的游标属性以恢复为不超过超链接似乎可以正常工作(并且独立于在长时间运行的代码中设置的screen.cursor)。我需要完成代码以确认它能正常工作,所以我现在不会回答这个问题,直到我确认所有事情都可以按照我的预期工作。
编辑:添加一些代码。我决定使用一个拦截器类而不是子类化网格,并且必须注册控件 - 我只会在一个应用程序的一两个地方使用它,并且无需设置其他人的机器。
TdxMasterView = class(dxMasterView.TdxMasterView)
private
FDefaultCursor: TCursor;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
public
constructor Create(AOwner: TComponent); override;
end;
constructor TdxMasterView.Create(AOwner: TComponent);
begin
inherited create(AOwner);
FDefaultCursor := self.Cursor;
end;
procedure TdxMasterView.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
lvHitTestCode: TdxMasterViewHitTestCode;
lvNode : TdxMasterViewNode;
lvColumn: TdxMasterViewColumn;
lvRowIndex, lvColIndex: integer;
begin
inherited;
lvHitTestCode := self.GetHitTestInfo(Point(X,Y),
lvNode,
lvColumn,
lvRowIndex,
lvColIndex);
if (lvHitTestCode = htContent) and (lvColumn is TMasterViewClickableColumn) then
begin
TMasterViewClickableColumn(lvColumn).onClickContentCell(lvNode);
end;
end;
procedure TdxMasterView.MouseMove(Shift: TShiftState; X, Y: Integer);
var
lvHitTestCode: TdxMasterViewHitTestCode;
lvNode : TdxMasterViewNode;
lvColumn: TdxMasterViewColumn;
lvRowIndex, lvColIndex: integer;
begin
inherited;
lvHitTestCode := self.GetHitTestInfo(Point(X,Y),
lvNode,
lvColumn,
lvRowIndex,
lvColIndex);
if (lvHitTestCode = htContent) and (lvColumn is TMasterViewClickableColumn) then
begin
self.cursor := TMasterViewClickableColumn(lvColumn).cursorOnMouseOver;
end
else
begin
self.cursor := self.FDefaultCursor;
end;
end;
我敢打赌,网格本身正在处理'WM_SETCURSOR'消息,然后是当消息处理器的'HitTest'参数是'HTCLIENT'时,一些命中测试测试。如果是的话,我会遵循这种方式,只是延长命中测试方法,并在伪代码中执行类似if(Msg.HitTest = HTCLIENT)和(GetHitTest(
@维多利亚它看起来来自TControl祖先的'Cursor'属性只是WM_SETCURSOR窗口消息的一个包装。该属性具有一个setter,用于处理对WM_SETCURSOR的调用(如果它发生更改)。我刚刚制作了一个特殊的FOriginalCursor属性来保存旧的游标,并让VCL处理必要的调用。我将编辑我的答案来弹出一些代码,但我认为这是更简单的解决方案。 –
我以为你正在修改网格原始代码。如果是这样,你可以按照我写的内容(就像那样可能存在的东西)。正如我在我的回答中所提到的,在WM_SETCURSOR消息处理程序中调用'inherited'“默认”为默认的'Cursor'。它不是一个包装。消息传递系统请求游标,并由您自己设置,或者调用'inherited'来让VCL执行其默认作业。 – Victoria
这是我更喜欢的场景。光标从WM_SETCURSOR消息处理程序中设置,后端工作由标志标记。链接点击然后从MouseDown方法覆盖处理。请注意,光标仅在此控件中更改(当鼠标光标悬停在控件上时)。在伪代码:
type
THitCode =
(
hcHeader,
hcGridCell,
hcHyperLink { ← this is the extension }
);
THitInfo = record
HitRow: Integer;
HitCol: Integer;
HitCode: THitCode;
end;
TMadeUpGrid = class(TGridAncestor)
private
FWorking: Boolean;
procedure DoStartWork;
procedure DoFinishWork;
procedure UpdateCursor;
procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
public
function GetHitTest(X, Y: Integer): THitInfo; override;
end;
implementation
procedure TMadeUpGrid.DoStartWork;
begin
FWorking := True;
UpdateCursor;
end;
procedure TMadeUpGrid.DoFinishWork;
begin
FWorking := False;
UpdateCursor;
end;
procedure TMadeUpGrid.UpdateCursor;
begin
Perform(CM_CURSORCHANGED, 0, 0); { ← triggers WM_SETCURSOR handler if needed }
end;
procedure TMadeUpGrid.WMSetCursor(var Msg: TWMSetCursor);
var
P: TPoint;
HitInfo: THitInfo;
begin
{ the mouse is inside the control client rect, inherited call here should
"default" to the Cursor property cursor type }
if Msg.HitTest = HTCLIENT then
begin
GetCursorPos(P);
P := ScreenToClient(P);
HitInfo := GetHitTest(P.X, P.Y);
{ if the mouse is hovering a hyperlink or the grid backend is working }
if FWorking or (HitInfo.HitCode = hcHyperLink) then
begin
{ here you can setup the "temporary" cursor for the hyperlink, or
for the working grid backend }
if not FWorking then
SetCursor(Screen.Cursors[crHandPoint])
else
SetCursor(Screen.Cursors[crHourGlass]);
{ tell the messaging system that this message has been handled }
Msg.Result := 1;
end
else
inherited;
end
else
inherited;
end;
procedure TMadeUpGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
HitInfo: THitInfo;
begin
if Button = mbLeft then
begin
HitInfo := GetHitTest(X, Y);
{ the left mouse button was pressed when hovering the hyperlink, so set
the working flag, trigger the WM_SETCURSOR handler "manually" and do the
navigation; when you finish the work, call DoFinishWork (from the main
thread context) }
if HitInfo.HitCode = hcHyperLink then
begin
DoStartWork;
DoSomeNavigation(HitInfo.HitRow, HitInfo.HitCol);
end;
end;
end;
function TMadeUpGrid.GetHitTest(X, Y: Integer): THitInfo;
begin
{ fill the Result structure properly }
end;
手柄['WM_SETCURSOR'(https://msdn.microsoft.com/en-us/library/windows/desktop/ms648382.aspx) –
也许这将帮助:https://开头堆栈溢出。com/questions/19257237/reset-cursor-in-wm-setcursor-handler-properly –
或者这个https://*.com/q/19570880/8041231 – Victoria