Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to display dynamic text along with the mouse cursor

Tags:

delphi

While a user is re-sizing a form, in XE2 I would like to display the current form size alongside the current mouse cursor. I would use the OnResize event.

In other words: I need ideas on how to display dynamic text (e.g. x,y coordinates like the 300, 250 in the image below) along with the mouse cursor as a user moves their mouse.

enter image description here

One approach would be to mock up a .cur file and assign it to the cursor in OnResize. That seems cumbersome and might be quite slow (and I have no idea yet of the file's contents)

Another idea would be to display some transparent text (what component would do that?) that I set .Top, .Left in the OnResize event.

One concern I have is how I would detect when the re-sizing operation is complete so I could revert to the standard mouse cursor.

Any suggestions a direction to proceed?

like image 926
RobertFrank Avatar asked Sep 13 '12 13:09

RobertFrank


2 Answers

Update:

Here is an updated version, where was removed the hint animation part (since I feel you need to display the hint immediately for your purpose) and where was added double buffering (due to frequent updates of the hint) to prevent flickering and also a decent alpha blending (just for curiosity).

Thanks to @NGLN fixed a missing unassigning of a hint window variable!

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TAlphaHintWindow = class(THintWindow)
  private
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ActivateHint(Rect: TRect; const AHint: string); override;
  end;

type
  TForm1 = class(TForm)
  private
    FSizeMove: Boolean;
    FHintWindow: TAlphaHintWindow;
    procedure WMEnterSizeMove(var AMessage: TMessage); message WM_ENTERSIZEMOVE;
    procedure WMSize(var AMessage: TWMSize); message WM_SIZE;
    procedure WMExitSizeMove(var AMessage: TMessage); message WM_EXITSIZEMOVE;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TAlphaHintWindow }

constructor TAlphaHintWindow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  // window might be updated quite frequently, so enable double buffer
  DoubleBuffered := True;
end;

procedure TAlphaHintWindow.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  // include the layered window style (for alpha blending)
  Params.ExStyle := Params.ExStyle or WS_EX_LAYERED;
end;

procedure TAlphaHintWindow.CreateWindowHandle(const Params: TCreateParams);
begin
  inherited CreateWindowHandle(Params);
  // value of 220 here is the alpha (the same as form's AlphaBlendValue)
  SetLayeredWindowAttributes(Handle, ColorToRGB(clNone), 220, LWA_ALPHA);
end;

procedure TAlphaHintWindow.ActivateHint(Rect: TRect; const AHint: string);
var
  Monitor: TMonitor;
begin
  // from here was just stripped the animation part and fixed one bug
  // (setting a hint window top position when going off screen; it is
  // at least in Delphi 2009 with the most recent updates)
  Caption := AHint;
  Inc(Rect.Bottom, 4);
  UpdateBoundsRect(Rect);
  Monitor := Screen.MonitorFromPoint(Point(Rect.Left, Rect.Top));
  if Width > Monitor.Width then
    Width := Monitor.Width;
  if Height > Monitor.Height then
    Height := Monitor.Height;
  if Rect.Top + Height > Monitor.Top + Monitor.Height then
    Rect.Top := (Monitor.Top + Monitor.Height) - Height;
  if Rect.Left + Width > Monitor.Left + Monitor.Width then
    Rect.Left := (Monitor.Left + Monitor.Width) - Width;
  if Rect.Left < Monitor.Left then
    Rect.Left := Monitor.Left;
  if Rect.Top < Monitor.Top then
    Rect.Top := Monitor.Top;
  ParentWindow := Application.Handle;
  SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, Width, Height,
    SWP_NOACTIVATE);
  ShowWindow(Handle, SW_SHOWNOACTIVATE);
  Invalidate;
end;

procedure TAlphaHintWindow.CMTextChanged(var Message: TMessage);
begin
  // do exactly nothing, because we're adjusting the size by ourselves
  // and the ancestor would just autosize the window by the text; text
  // or if you want Caption, is updated only by calling ActivateHint
end;

{ TForm1 }

procedure TForm1.WMEnterSizeMove(var AMessage: TMessage);
begin
  inherited;
  FSizeMove := True;
end;

procedure TForm1.WMSize(var AMessage: TWMSize);
var
  CurPos: TPoint;
begin
  inherited;
  if FSizeMove and GetCursorPos(CurPos) then
  begin
    if not Assigned(FHintWindow) then
      FHintWindow := TAlphaHintWindow.Create(nil);
    FHintWindow.ActivateHint(
      Rect(CurPos.X + 20, CurPos.Y - 20, CurPos.X + 120, CurPos.Y + 30),
      'Current size' + sLineBreak +
      'Width: ' + IntToStr(Width) + sLineBreak +
      'Height: ' + IntToStr(Height));
  end;
end;

procedure TForm1.WMExitSizeMove(var AMessage: TMessage);
begin
  inherited;
  FHintWindow.Free;
  FHintWindow := nil;
  FSizeMove := False;
end;

end.

And the result at form sizing (quite a lot transparent to my taste :-)

enter image description here

like image 159
TLama Avatar answered Sep 25 '22 02:09

TLama


Does it really need to be transparent? Keep in mind that text can be hard to read over certain backgrounds.

Instead, consider showing a tool-tip window. Create a THintWindow control, set its caption and position, and show it.

When you receive a wm_ExitSizeMove message, hide or destroy the window.

like image 40
Rob Kennedy Avatar answered Sep 24 '22 02:09

Rob Kennedy