Delphi：在移动时调整winapi窗口的大小

Question

目前的目标是在拖动窗口时使窗口变小（卷起），而不是使其变为原始大小。

我试图在 WM_MOVING 调用中更改窗口大小，但它只是像地狱一样闪烁（将大小更改为小，然后在下一帧 - 将大小更改为原始大小，每 2 帧重复一次）。

如果我设置了一个标志，没有任何反应，窗口的原始大小保持不变。

  WM_MOVING:
    begin
    if(Moving) = false then
      begin
        GetWindowRect(Window, move_rect);
        SetWindowPos(Window, 0, 0, 0, move_rect.Width, 0, SWP_NOMOVE or SWP_NOZORDER);
        Moving := true;
      end;
    end;

更新 2：这里有完整的应用程序代码，有很多未使用的变量并且没有错误处理：

unit Unit1;

interface

uses
   System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms,
   Vcl.Dialogs, Vcl.StdCtrls, System.JSON, winapi.Windows, winapi.Messages, SysUtils;

type
  TForm1 = class(TForm)
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  test_window : TWndClassEx;
  Window, parentHWND : HWND;
  mmsg:  msg;
  Button, Label1 :   hwnd;
  moving_flag : bool;
  move_x, move_y : integer;
  move_rect : TRect;
  window_rolled : bool;

implementation

{$R *.dfm}

function WindowProc(wnd: hwnd; msg: integer; wparam: wparam; lparam: lparam):lresult;stdcall;
var
  hRegX: HRGN;
  WindowRect: TRect;
  int_x, int_y : integer;
  p_rect : Prect;
begin
  case msg of
  WM_DESTROY:
    begin
      PostQuitMessage(0);
      Button := 0;
      label1 := 0;
      result := 0;
      Window := 0;
      exit;
    end;
  WM_COMMAND:
    begin
    case LoWord( wParam ) of
      1: MessageBox(Window,'Button','Title',0);
    end;
    end;
  WM_MOVING:
    begin
      if(moving_flag) = false then
      begin
        GetWindowRect(Window, move_rect);
        SetWindowPos(Window, 0, 0, 0, move_rect.Width, 0, SWP_NOMOVE or SWP_NOZORDER);
      moving_flag := true;
      end;
    end;
  //WM_MOUSEMOVE:
  //WM_LBUTTONDOWN:
  WM_EXITSIZEMOVE:
    begin

    end;
  else
    result := DefWindowProc(wnd,msg,wparam,lparam);
  end;
end;

procedure CreateWinApiForm;
begin
  if Window = 0 then
  begin
  test_window.cbSize := sizeof(test_window);
  test_window.style := 0;
  test_window.lpfnWndProc := @windowproc;
  test_window.hInstance :=  hInstance;
  test_window.hIcon := LoadIcon(hInstance,'MAINICON');
  test_window.hCursor := LoadCursor(0,IDC_ARROW);
  test_window.hbrBackground := COLOR_BTNFACE+1;
  test_window.lpszClassName := 'MyWindow';
  if winapi.windows.registerclassEx(test_window) = 0 then
  MessageBox(0, 'Error registering window', 'Title', MB_OK);
  Window := CreateWindowEx(0, test_window.lpszClassName, 'Random text', WS_CAPTION or WS_MINIMIZEBOX or WS_SYSMENU, 300, 300, 350, 130, 0, 0, hInstance, nil);
  GetWindowRect(Window, move_rect);
  label1:=CreateWindow('static','Label?',WS_VISIBLE or WS_CHILD or BS_TEXT,6,25,330,40, Window,2,hInstance,nil);
  Button:=CreateWindow('button','Button',WS_VISIBLE or WS_CHILD,6,73,110,25, Window,1,hInstance,nil);

  ShowWindow(Window, SW_Show);

  end
  else
    MessageBox(0, 'Window already exists', 'title', MB_OK);


end;

procedure TForm1.Button2Click(Sender: TObject);
begin
CreateWinApiForm;
while getmessage(mmsg,0,0,0) do
  begin
    translatemessage(mmsg); 
    dispatchmessage(mmsg); 
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Window := 0;
  move_x := 0;
  move_y := 0;
  moving_flag := false;
  window_rolled := false;
end;

end.

更新 3：另外，我看到有人使用 SetWindowRgn 发布了答案，但由于某种原因，在我调用这个之后，窗口转换为“经典”视图，没有阴影等。

Answer 1

您将遇到的一个问题，尤其是在移动时，会出现多个 WM_MOVING 消息排队，每个消息都包含您正在调整大小的窗口的大小，因此当您调整窗口大小时，您将收到排队的 WM_SIZING 消息包含原始大小的消息。因此，当发生调整大小时，因为消息在队列中，所以在消息队列中已经有一条 WM_MOVING 消息在它后面，具有原始大小。

您的代码的另一个可能更重要的问题是您在处理 WM_COMMAND 或 WM_MOVING 消息时没有设置结果，这意味着很可能还会发生默认处理，从而加剧了问题。你应该经常检查你的警告！

我会尝试修改 lparam 参数中指向的 lrect 结构并传递给 DefWindowProc，而不是尝试自己调整窗口大小。

编辑

这里有一些简短的代码向您展示如何做到这一点：

unit UnitTest;

interface

uses
  Windows;

type
  Rect = record
    left, top, right,  bottom : LONG;
  end;

type
  PRect = ^Rect;

implementation

function WindowProc(wnd: hwnd; msg: integer; wparam: wparam; lparam: lparam):lresult;stdcall;
var
  iRect : PRect;
begin
  //case msg of
  //WM_MOVING:
    begin
      iRect := pRect( lparam );
      iRect.Top := 0; // etc...
      result := DefWindowProc(wnd,msg,wparam,lparam);
    end;
//  end;
//  else
//    result := DefWindowProc(wnd,msg,wparam,lparam);
//  end;
end;

end.