델파이 : 이동시 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 메시지가 크기를 조정할 창의 크기이므로 resiz를 할 때 창에서 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.