Reputation: 125
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
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.
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