1

我使用以下帮助程序来防止屏幕移动表单，并且大部分时间都可以正常工作。但是，如果我在 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.
4

0 回答 0