Change mouse cursor when over certain components without affecting other cursor-setting code

Question

I'm using an ancient precursor to the DevExpress QuantumGrid (MasterView) in Delphi XE2 and would like certain cells to effectively act as hyperlinks (change the mouse cursor from crDefault to crHandPoint when over them and trigger an action on click).

The configuration of the grid component is such that individual cells are not their own component, and I will need to find the cell from the mouse cursor coordinates and set the cursor from there.

I think I need to set a few events on my grid object to achieve this, but I'm a little uncomfortable about how these events will interact with code that sets the cursor to an hourglass when doing long-running operations (currently handled using IDisposible to set the cursor back to original when finished) and want to double-check whether there's a better way of doing this before I get started and then find a tonne of edge-cases that leave the mouse cursor in the wrong state.

I think I need to override:

• omMouseMove - get XY co-ordinates and set the cursor to hand/arrow
• onMouseDown - get XY co-ordinates and 'activate' hyperlink if present (possibly revert to arrow? The hyperlink will usually open a new window and the code called may change the cursor to an hourglass)
• onMouseLeave - reset cursor to arrow (this event isn't actually exposed, so think I'll need to handle messages manually)

This kind of functionality comes as default on a TButton, but I couldn't see in the VCL how it's achieved at first glance, and may be a feature of the underlying Windows control.

Answer 1

I've actually found the solution while browsing around SO.

I'd forgotten that components usually have their own Cursor property, which is how they set the correct mouse cursor type when the pointer is over them (i.e. button behaviour)

By overriding MouseMove to change the cursor to crHandPoint if it's over a hyperlink cell and storing the old cursor property to revert to if it's not over a hyperlink seems to work fine (and separate to the screen.cursor which is set in the long-running code). I need to finish off the code to confirm that it works correctly, so I'll leave the question unanswered for now until I can confirm that everything works as I expected.

edit: adding some code. I've decided to use an interceptor class rather than subclassing the grid and having to register the control - I'll only be using it in one or two places in one app and it saves having to set up everyone else's machines.

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

This is a scenario I would prefer. The cursor is set from the WM_SETCURSOR message handler and backend work signalled by a flag. Link click is then handled from the MouseDown method override. Note that the cursor is changed only for this control (when the mouse cursor hovers the control). In pseudocode:

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;