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.
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?
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 :-)
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.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With