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