我使用以下帮助程序来防止窗体移动,并且大部分时间都正常工作。但是如果我在MDI应用程序中打开一个wsNormal表单,那么表单可能会显示它应该是的区域。然后我可以稍微移动它,然后这里的单位接管并将其移动到位。 我现在的问题是:我怎么能阻止这种情况发生,或者向表格发送一条消息说它正在移动,这样她就可以完成工作。
unit U_FormsMove;
interface
uses
Messages, Windows, Forms;
{$M+}
type
TForm = class(Forms.TForm)
private
protected
procedure WMMoving(var message : TWMMoving); message WM_MOVING;
published
public
end;
implementation
function GetMovementArea: TRect;
var
MovementRect: TRect;
begin
if Application.MainForm.FormStyle = fsMDIForm then
Windows.GetWindowRect(Application.MainForm.ClientHandle, MovementRect)
else
SystemParametersInfo(SPI_GETWORKAREA, 0, @MovementRect, 0);
if MovementRect.Top < 150 then
MovementRect.Top := 150;
MovementRect.Top := MovementRect.Top + 5;
MovementRect.Left := MovementRect.Left + 5;
MovementRect.Right := MovementRect.Right - 5;
MovementRect.Bottom := MovementRect.Bottom - 5;
Result := MovementRect;
end;
{ TFormHelper }
procedure TForm.WMMoving(var Message: TWMMoving);
var
rec: ^TRect;
wrk: TRect;
begin
wrk := GetMovementArea;
rec := Pointer(Message.DragRect);
if rec^.Left < wrk.Left then
begin
rec^.Right := rec^.Right - (rec^.Left - wrk.Left);
rec^.Left := wrk.Left;
end
else if rec^.Right > wrk.Right then
begin
rec^.Left := rec^.Left - (rec^.Right - wrk.Right);
rec^.Right := wrk.Right;
end;
if rec^.Top < wrk.Top then
begin
rec^.Bottom := rec^.Bottom - (rec^.Top - wrk.Top);
rec^.Top := wrk.Top;
end
else if rec^.Bottom > wrk.Bottom then
begin
rec^.Top := rec^.Top - (rec^.Bottom - wrk.Bottom);
rec^.Bottom := wrk.Bottom;
end;
end;
end.