Recent

Author Topic: Distinguish between a form resize through code and a user-initiated resize  (Read 1467 times)

trab10

  • Newbie
  • Posts: 4
I have a form that automatically resizes (height) based on the varying contents of a listbox.  However, if the user manually sets the form height (by dragging with the mouse), then the program should respect that choice and stop the auto-sizing behavior.

I've set up a private boolean called ManualSized, set to False at default, and have a handler for the form's OnResize event to change ManualSized to True.  The auto-resize code looks at the boolean, and skips resizing if it's True, but OnResize is called regardless of whether the resize is from User action, or from code, so once it "autoresizes", ManualSized is set to True, and no more auto-sizing happens.

Is there a way to distinguish between a coded form resize and a user-initiated resize?

Thanks,

bart

Lazarus 3.2 release version, FPC 3.2.2 Win64
Windows 10

Handoko

  • Hero Member
  • *****
  • Posts: 5214
  • My goal: build my own game engine using Lazarus
Hello trab10,
Welcome to the forum.

This works on Ubuntu, I haven't tried but I believe it should work on Windows too:

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, Forms, Dialogs, StdCtrls;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     Label1: TLabel;
  17.     procedure Button1Click(Sender: TObject);
  18.     procedure FormCreate(Sender: TObject);
  19.     procedure FormResize(Sender: TObject);
  20.   private
  21.     FCodeResizeEnabled: Boolean;
  22.     FResizingByCode:    Boolean;
  23.   end;
  24.  
  25. var
  26.   Form1: TForm1;
  27.  
  28. implementation
  29.  
  30. {$R *.lfm}
  31.  
  32. { TForm1 }
  33.  
  34. procedure TForm1.Button1Click(Sender: TObject);
  35. begin
  36.   if not(FCodeResizeEnabled) then
  37.   begin
  38.     ShowMessage('User resizing already performed,' + LineEnding +
  39.       'code resizing is not allowed');
  40.     Exit;
  41.   end;
  42.   FResizingByCode := True;
  43.   Width           := Random(400) + 400;
  44.   Height          := Random(300) + 300;
  45.   Application.ProcessMessages;
  46.   FResizingByCode := False;
  47. end;
  48.  
  49. procedure TForm1.FormCreate(Sender: TObject);
  50. begin
  51.   FCodeResizeEnabled := True;
  52.   FResizingByCode    := False;
  53. end;
  54.  
  55. procedure TForm1.FormResize(Sender: TObject);
  56. const
  57.   FirstTime: Boolean = True;
  58. begin
  59.   if FirstTime then
  60.   begin
  61.     FirstTime := False;
  62.     Exit;
  63.   end;
  64.   if not(FResizingByCode) then // resizing is perform by user
  65.     FCodeResizeEnabled := False;
  66. end;
  67.  
  68. end.

jamie

  • Hero Member
  • *****
  • Posts: 6301
Read this.

https://learn.microsoft.com/en-us/windows/win32/winmsg/wm-sizing

The LCL does not process this message but, you can add it and process it yourself.

 This message gets sent when even the user is dragging or changing its size etc.

 if interested, I could supply a code snippet.

 This i am sure works only for windows.
The only true wisdom is knowing you know nothing

trab10

  • Newbie
  • Posts: 4
Handoko:
This seems to work, thank you.  It took some time to wrap my head around it, but I believe I understand how it works.  Very clever.

Jamie:
Thanks for the pointer to the Win SDK; I know Lazarus can do this, and it is the best way to accomplish some things, but I try to avoid it if possible.  I will try it, though, so please do send a code snippet.

Again, thanks all.

b

jamie

  • Hero Member
  • *****
  • Posts: 6301
I don't know if this will work on other targets. Although HitTest message is supported in other targets, because its in the LMessages unit, there does not seem to be any of the test area defines, which are in the windows unit.

In any case, here is a code snippet that uses the Onresize event and how you can tell if the user is doing it or code.
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Windows,Classes, SysUtils, Forms, Controls, Graphics, Dialogs,Lmessages,lclType,types;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     procedure FormResize(Sender: TObject);
  16.   private
  17.   public
  18.   end;
  19.  
  20. var
  21.   Form1: TForm1;
  22.  
  23. implementation
  24.  
  25. {$R *.lfm}
  26.  
  27. procedure TForm1.FormResize(Sender: TObject);
  28. begin
  29.   if (GetKeyState(VK_LButton)and $8000<>0)and(SendMessage(Handle,LM_NCHITTEST,0,
  30.   MakeLong(Mouse.CursorPos.X,Mouse.CurSorPos.Y)) in  [HTBottom,HTLEFT,HTRIGHT,HTTOP,HTBOTTOMLEFT,HTBOTTOMRIGHT])
  31.   Then
  32.    Caption := 'user is sizing it' else
  33.    Caption := 'Code Is sizing it';
  34. end;
  35.  
  36.  
  37. end.
  38.  
  39.  
The only true wisdom is knowing you know nothing

trab10

  • Newbie
  • Posts: 4
> jamie:

This is very educational.  I try to avoid going to the Windows SDK, but this definitely shows the value of doing so upon occasion.  It does exactly what I want in a single if-then statement (and about half a dozen additional units).

As you say, this is probably not very portable, but for this prog, it's fine.  I do like the portability of Handoko's solution, too, though it is a bit more involved.

Thank you both!

b

jamie

  • Hero Member
  • *****
  • Posts: 6301
Everything there is supposed to be cross platform with the exception of the missing defines, that is what the Windows unit is doing.

 The other added units are cross platform targeted.

I think the missing defines maybe an oversight because that same code is used throughout and hit testing is common.

Have fun.


The only true wisdom is knowing you know nothing

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Crossplatform:
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Button1: TButton;
  16.     Memo1: TMemo;
  17.     Timer1: TTimer;
  18.     procedure Button1Click(Sender: TObject);
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure FormResize(Sender: TObject);
  21.     procedure FormShow(Sender: TObject);
  22.     procedure Timer1Timer(Sender: TObject);
  23.   private
  24.     // this variable informs you if its executed by code
  25.     FResize: Boolean;
  26.   public
  27.  
  28.   end;
  29.  
  30. var
  31.   Form1: TForm1;
  32.  
  33. implementation
  34.  
  35. {$R *.lfm}
  36.  
  37. { TForm1 }
  38.  
  39. procedure TForm1.Button1Click(Sender: TObject);
  40. begin
  41.   // example how code must look to distinguish between user and code
  42.   // set code flag
  43.   FResize := True;
  44.   // resize and fire OnResize
  45.   Self.Width := 200 + Random(100);
  46.   // give messages a time to be processed
  47.   Timer1.Enabled := True;
  48. end;
  49.  
  50. procedure TForm1.FormCreate(Sender: TObject);
  51. begin
  52.   // just used for Random() in example
  53.   Randomize;
  54.   // setup timer, 1000 is default (1 second)
  55.   Timer1.Interval := 1000; // can be tweaked down but a second is fairplay
  56.   // to swallow first event
  57.   Timer1.Enabled := True;
  58. end;
  59.  
  60. procedure TForm1.FormResize(Sender: TObject);
  61. begin
  62.   // nothing much to say
  63.   if FResize then
  64.     Memo1.Lines.Add('Code resized')
  65.   else
  66.     Memo1.Lines.Add('User resized');
  67. end;
  68.  
  69. procedure TForm1.FormShow(Sender: TObject);
  70. begin
  71.   // initialize to code
  72.   FResize := True;
  73. end;
  74.  
  75. procedure TForm1.Timer1Timer(Sender: TObject);
  76. begin
  77.   // remove timer event
  78.   Timer1.Enabled := False;
  79.   // remove code flag
  80.   FResize := False;
  81. end;
  82.  
  83. end.
updated comments and fixed starting issue.
« Last Edit: May 12, 2024, 06:03:47 pm by KodeZwerg »
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

trab10

  • Newbie
  • Posts: 4
>KodeZwerg:

This one gives me yet something else to think about.  The flag and timer approach is interesting, and it certainly does work.  Thanks for your help.

b

egsuh

  • Hero Member
  • *****
  • Posts: 1372
Doesn't following work?


   Self.OnResize := nil;

   // do your own resizing by program

   Self.OnResize := @FormResize;



440bx

  • Hero Member
  • *****
  • Posts: 4219
disclaimer: I haven't tried this but, at least in Windows, it should "operate" like this.

When a window is being _manually_ resized, the following is true: the mouse is captured, there has been one or more mouse move messages received and lastly the left mouse button is down.   None of those is likely true when the resizing is done programatically.

The above said, it is possible to have a timer resizing the window _while_ a user is manually resizing the window.  The fact that this is possible indicates that the determination is difficult to do accurately (it can be done by tracking the mouse movement.)

Bottom line is: setting a flag when a button causes the resizing is a good idea but, it is not conclusive because the resizing of the window can take place manually and programmatically simultaneously. 

Anyway... I thought I'd give some food for thought to those attempting to provide a solution.
(FPC v3.0.4 and Lazarus 1.8.2) or (FPC v3.2.2 and Lazarus v3.2) on Windows 7 SP1 64bit.

 

TinyPortal © 2005-2018