在某些组件上更改鼠标光标而不影响其他光标设置代码

Question

我在Delphi XE2中使用DevExpress QuantumGrid（MasterView）的古代前驱，并希望某些单元有效地充当超链接（将鼠标光标从将crDefault设置为crHandPoint，并在点击时触发一个操作）。

网格组件的配置是这样的，单个单元格不是它们自己的组件，我需要从鼠标光标坐标中找到单元格并从那里设置光标。

我想我需要在我的网格对象上设置一些事件来达到这个目的，但我对这些事件如何与代码进行交互有点不舒服，这些事件在做长时间运行时将光标设置为沙漏目前使用IDisposible进行处理以在完成时将光标恢复为原始值），并且希望在我开始之前仔细检查是否有更好的方法来完成此操作，然后找到一大堆边缘案例，将鼠标光标置于错误状态。

我想我需要重写：

• omMouseMove - 获得XY坐标，并设置光标到手动/箭头
• onmousedown事件 - 获得XY坐标如果存在“激活”超链接（可能还原为箭头？超链接通常会打开一个新窗口，并且调用的代码可能会将光标更改为沙漏）
• onMouseLeave - 将光标重置为箭头（此事件实际上并未公开，所以 认为我需要手动处理消息）

这种功能在TButton上是默认的，但我在VCL中看不到它是如何实现的，并且可能是底层Windows控件的一个功能。

Answer 1

我实际上在浏览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; 

Answer 2

这是我更喜欢的场景。光标从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;