How to get mouse cursor dimensions on Delphi?

Question

I use Toolbar2000 component. It shows button's hint below correct position with system scale > 100%. So, I need to set HintPos manually. I have Mouse.CursorPos. But hint should be displayed below mouse cursor image.

How to get mouse cursor dimensions?

Answer 1

This is Windows 7 issue and there is no proper solution. GetSystemMetrics(SM_CYCURSOR) returns size of cursor image with background. And it seems this value is much more incorrect with system scale >100%. Delphi XE2 shows a hint on incorrect position too. But it's interesting to note that Explorer shows a hint on the correct position.

Answer 2

You should ask Windows for System Metrics - see http://msdn.microsoft.com/en-us/library/windows/desktop/ms724385.aspx

However if user installed something like Stardock CursorFX those values would not match what the user really sees and what behavior he expects from programs.

That seems to be one of Win32 API limitations, that the value cannot be changed apart of few relatively small standard values from old approved set.

Answer 3

You can create an Icon, use GetCursor to set the handle, additional information can be retrieved with GetIconInfo. This will even work if userdefined cursors are shown, which might have nearly any size.

var
  ico: TIcon;
  IcoInfo: TIconInfo;
begin
  ico := TIcon.Create;
  try
    ico.Handle := GetCursor;
    try
      GetIconInfo(ico.Handle, IcoInfo);
      Caption := Format('Width %d, Height %d HotSpotX %d, HotSpotY %d',
        [ico.Width, ico.Height, IcoInfo.xHotspot, IcoInfo.yHotspot]);
    finally
      ico.ReleaseHandle;
    end;
  finally
    ico.Free;
  end;
end;


// Just as example for an very unusual cursor
procedure TForm1.Button1Click(Sender: TObject);
var
  IconInfo: TIconInfo;
  AndMask, Bmp: TBitmap;
  w, h: Integer;
begin
  w := Screen.Width * 2;
  h := Screen.Height * 2;

  // Creation And Mask
  AndMask := TBitmap.Create;
  AndMask.Monochrome := True;
  AndMask.Height := h;
  AndMask.Width := w;

  // Draw on And Mask
  AndMask.Canvas.Brush.Color := clWhite;
  AndMask.Canvas.FillRect(AndMask.Canvas.ClipRect);

  AndMask.Canvas.Pen.Color := clwhite;
  AndMask.Canvas.Pen.Width := 5;
  AndMask.Canvas.MoveTo(w div 2, 0);
  AndMask.Canvas.LineTo(w div 2, h);
  AndMask.Canvas.MoveTo(0, h div 2);
  AndMask.Canvas.LineTo(w, h div 2);

  {Create the "XOr" mask}
  Bmp := TBitmap.Create;

  Bmp.Width := w;
  Bmp.Height := h;

  {Draw on the "XOr" mask}
  Bmp.Canvas.Brush.Color := clblack;
  Bmp.Canvas.FillRect(Rect(0, 0, w, h));
  Bmp.Canvas.Pen.Color := clwhite;
  Bmp.Canvas.Pen.Width := 5;
  Bmp.Canvas.MoveTo(w div 2, 0);
  Bmp.Canvas.LineTo(w div 2, h);
  Bmp.Canvas.MoveTo(0, h div 2);
  Bmp.Canvas.LineTo(w, h div 2);


  IconInfo.fIcon := true;
  IconInfo.xHotspot := w div 2;
  IconInfo.yHotspot := h div 2;
  IconInfo.hbmMask := AndMask.Handle;
  IconInfo.hbmColor :=  Bmp.Handle;

  Screen.Cursors[1]:= CreateIconIndirect(IconInfo);
  Screen.Cursor:=1;

end;