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

Nikita Vasin 发表于 Dev

尼基塔·瓦辛（Nikita Vasin）

目标是暂时将窗口缩小（向上滚动），而无需使其原始大小。

我试图在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发布答案，但是由于某种原因，在我调用此窗口后，窗口将转换为“经典”视图，而没有阴影等。

Dsm

您将遇到的一个问题（尤其是移动问题）是将排队等待多个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.