如何在 delphi TFrame 上编写调整大小句柄?
How do I program a resize handle on a delphi TFrame?
我有一个 TFrame,我希望能够通过单击并拖动右下角来调整它的大小。功能应该是;
当鼠标移到右下角时,光标应该会改变以反映可以调整框架的大小。如果不在底角,光标应该是标准箭头。
运行时框架顶部会有控件,所以我不能使用 OnMouseMove 事件。所以我用这个;
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;
然而,一旦光标设置为 crSizeNWSE,我的程序就会停止接收 WM_SETCURSOR windows 消息。
当光标未设置为默认箭头时,我可以收到不同的 windows 消息吗?
并不是框架停止接收 WM_SETCURSOR
消息,而是光标卡在 crSizeNWSE 上。当您切换回 crDefault
设置为 Screen.Cursor
时,发生的是 VCL 向框架发送 WM_SETCURSOR
以设置默认光标。实际上没有光标被设置。如果你想改变它,必须设置一个光标,将最后一部分替换为:
// 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;
作为替代方案,您可以处理 WM_NCHITTEST
以将区域定义为调整大小的区域,然后框架的默认 window 过程将在处理 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;
作为一个额外的好处,您不必编写额外的代码来调整框架的大小。
我有一个 TFrame,我希望能够通过单击并拖动右下角来调整它的大小。功能应该是;
当鼠标移到右下角时,光标应该会改变以反映可以调整框架的大小。如果不在底角,光标应该是标准箭头。
运行时框架顶部会有控件,所以我不能使用 OnMouseMove 事件。所以我用这个;
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;
然而,一旦光标设置为 crSizeNWSE,我的程序就会停止接收 WM_SETCURSOR windows 消息。
当光标未设置为默认箭头时,我可以收到不同的 windows 消息吗?
并不是框架停止接收 WM_SETCURSOR
消息,而是光标卡在 crSizeNWSE 上。当您切换回 crDefault
设置为 Screen.Cursor
时,发生的是 VCL 向框架发送 WM_SETCURSOR
以设置默认光标。实际上没有光标被设置。如果你想改变它,必须设置一个光标,将最后一部分替换为:
// 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;
作为替代方案,您可以处理 WM_NCHITTEST
以将区域定义为调整大小的区域,然后框架的默认 window 过程将在处理 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;
作为一个额外的好处,您不必编写额外的代码来调整框架的大小。