Search code examples
delphibuttondelphi-xe2

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


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.


Solution

  • 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;