Nikita Vasin
Nikita Vasin

Reputation: 125

Delphi: Resizing winapi window on move

The goal is to make window small (roll up) when you drag it, without making it original size, for now.

I tried to change window size in WM_MOVING call, but it just flickers like hell (changes size to small one, then in the next frame - changes size to original, repeat every 2 frames).

And if i set a flag, nothing happens, original size of the window remains.

  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;

Update 2: Full app code here, with a lot of unused variables and no error handling:

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.

Update 3: Also, I've seen somebody post an answer using SetWindowRgn, but for some reason after i call this one, window converts to "Classic" view, without shadows etc.

Upvotes: 2

Views: 1992

Answers (1)

Dsm
Dsm

Reputation: 6013

One of the issues that you will have, particularly with moving, is that several WM_MOVING message will be queued up, each containing the size of the window you are resizing, so when you resize the window you will get WM_SIZING messages queued behind a message that contains the original size. So when the resizing occurs, because the message was in a queue there will already be a WM_MOVING message behind it in the message queue with the original size.

Another, and probably more significant, problem with your code is that you do not set the result when processing WM_COMMAND or WM_MOVING message, meaning that in all probability default processing also occurs, exacerbating the problem. You should always check your warnings!

What I would try is modifying the lrect structure pointed to in lparam parameter and pass on to DefWindowProc, rather than trying to resize the window yourself.

Edit

Here is some brief code showing you how to do it:

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.

Upvotes: 2

Related Questions