Search code examples
delphiwindows-messages

How do I program a resize handle on a delphi TFrame?


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?


Solution

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