I have a TFrame that I want to be able to resize by clicking and dragging the bottom-right corner. The functionality should be;
When the mouse moves over the bottom-right corner the cursor should change to reflect that the frame can be resized. If not over the bottom corner the cursor should be the standard arrow.
There will be controls on top of the frame at runtime so I can't use the OnMouseMove event. So I use this;
private
procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
procedure TfraApplet.WMSetCursor(var Msg: TWMSetCursor);
var
Point: TPoint;
begin
Point := ScreenToClient(Mouse.CursorPos);
Label1.Caption := 'X:' + IntToStr(Point.X) + ' Y:' + IntToStr(Point.Y);
// Resize area (bottom right)
if (Point.X >= (Width - 10)) and (Point.Y >= (Height - 10)) then
Screen.Cursor := crSizeNWSE
else
Screen.Cursor := crDefault;
end;
However as soon as the cursor gets set to crSizeNWSE my programs stops receiving the WM_SETCURSOR windows message.
Is there a different windows message I can receive when the cursor is not set as the default arrow?
It's not that the frame stops receiving WM_SETCURSOR
messages, it's that he cursor gets stuck set at crSizeNWSE. When you switch back to setting crDefault
to Screen.Cursor
, what happens is that the VCL sends a WM_SETCURSOR
to the frame to have it set the default cursor. In effect no cursor ever becomes set. A cursor have to be set if you want it to be changed from the previous one, replace the last part with:
// Resize area (bottom right)
if (Point.X >= (Width - 10)) and (Point.Y >= (Height - 10)) then begin
winapi.Windows.SetCursor(Screen.Cursors[crSizeNWSE]);
Message.Result := 1;
end else
inherited;
As an alternative, you can handle WM_NCHITTEST
to define the area as a sizing area, and then the default window procedure of the frame will set the appropriate cursor when it's handling WM_SETCURSOR
:
procedure TfraApplet.WMNCHitTest(var Message: TWMNCHitTest);
var
Point: TPoint;
begin
Point := ScreenToClient(SmallPointToPoint(Message.Pos));
Label1.Caption := 'X:' + IntToStr(Point.X) + ' Y:' + IntToStr(Point.Y);
// Resize area (bottom right)
if (Point.X >= (Width - 10)) and (Point.Y >= (Height - 10)) then
Message.Result := HTBOTTOMRIGHT
else
inherited;
end;
As an added benefit you won't have to write additional code for resizing the frame.