[SOLVED] Form resize bsNone

[Pe3s]

Hello, I would like to ask more experienced forum users if there is another way to scale the borderstyle:= bsNone form that does not cause the form to freeze when scaling faster.

Code: Pascal  [Select][+][-]

1. function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam): LRESULT; stdcall;
2. const
3.   Margin = 5;
4. var
5.   Rect: TRect;
6.   MouseX, MouseY: LongInt;
7. begin
8.   if uMsg = WM_NCHITTEST then
9.   begin
10.     Result := Windows.DefWindowProc(Ahwnd, uMsg, wParam, lParam);
11.     MouseX := GET_X_LPARAM(lParam);
12.     MouseY := GET_Y_LPARAM(lParam);
13.     with Rect do
14.     begin
15.       Left := MouseX - Form1.BoundsRect.Left;
16.       Right := Form1.BoundsRect.Right - MouseX;
17.       Top := MouseY - Form1.BoundsRect.Top;
18.       Bottom := Form1.BoundsRect.Bottom - MouseY;
19.       if (Top < Margin) and (Left < Margin) then
20.         Result := windows.HTTOPLEFT
21.       else if (Top < Margin) and (Right < Margin) then
22.         Result := windows.HTTOPRIGHT
23.       else if (Bottom < Margin) and (Left < Margin) then
24.         Result := windows.HTBOTTOMLEFT
25.       else if (Bottom < Margin) and (Right < Margin) then
26.         Result := windows.HTBOTTOMRIGHT
27.       else if (Top < Margin) then
28.         Result := windows.HTTOP
29.       else if (Left < Margin) then
30.         Result := windows.HTLEFT
31.       else if (Bottom < Margin) then
32.         Result := windows.HTBOTTOM
33.       else if (Right < Margin) then
34.         Result := windows.HTRIGHT;
35.     end;
36.     Exit;
37.   end;
38.   Result := CallWindowProc(PrevWndProc,Ahwnd, uMsg, WParam, LParam);
39. end;                                                                          
40.  

[jamie]

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Lmessages, LclIntf;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.   private
16.  
17.   public
18.     procedure Hittest(var Msg: TLMNCHITTEST); message LM_NCHITTEST;
19.   end;
20.  
21. var
22.   Form1: TForm1;
23.  
24. implementation
25.  
26. {$R *.lfm}
27.  
28. { TForm1 }
29.  
30. procedure TForm1.Hittest(var Msg: TLMNCHITTEST);
31. const
32.   Margin = 50;
33.   HTTOP = 12;
34.   HTTOPLEFT = 13;
35.   HTLEFT = 10;
36.   HTTOPRight = 14;
37.   HTBottomLeft = 16;
38.   HTBottomRight = 17;
39.   HTbottom = 15;
40.   HTRight = 11;
41. var
42.   R: TRect;
43. begin
44.   inherited;
45.   R := BoundsRect;
46.   if Abs(Msg.YPos - R.Top) < Margin then
47.   begin
48.     if Abs(Msg.XPos - R.Left) < Margin then
49.       Msg.Result := HTTOPLEFT
50.     else
51.     if Abs(Msg.XPos - R.Right) < Margin then
52.       Msg.Result := HTTOPRIGHT
53.     else
54.       Msg.Result := HTTOP;
55.     Exit;
56.   end;
57.   if Abs(Msg.YPos - R.Bottom) < Margin then
58.   begin
59.     if Abs(Msg.XPos - R.Left) < Margin then
60.       Msg.Result := HTBottomLEFT
61.     else
62.     if Abs(Msg.XPos - R.Right) < Margin then
63.       Msg.Result := HTBottomRIGHT
64.     else
65.       Msg.Result := HTBottom;
66.     Exit;
67.   end;
68.   if Abs(Msg.XPos - R.Left) < Margin then
69.     Msg.Result := HTLeft;
70.   if ABS(Msg.XPos - R.Right) < Margin then
71.     MSg.Result := HTRight;
72. end;
73.  
74. end.
75.  

Jamie

[jamie]

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
2.   Shift: TShiftState; X, Y: Integer);
3. begin
4.   MouseWentDownHere := TPoint.Create(X,Y);
5. end;
6.  
7. procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
8.   Y: Integer);
9. Const Margin=10;
10.  Var
11.    M,C:TRect;
12.    DIf:TPoint;
13. begin
14.    If Not (ssLeft in Shift) then exit;// only do this if left button is down.
15.    M:=ClientRect;
16.    C:= M;
17.    C.Inflate(-Margin,-Margin);//Shrink a rect.
18.    If Not C.Contains(TPoint.Create(X,Y)) Then //size from sides.
19.    Begin
20.    Dif := TPoint.Create(MouseWentDownHere.X-X,MouseWentDownHere.Y-Y);
21.      If Y < C.Top Then  {Top Side}
22.      Begin
23.       Top := Top-Dif.Y;
24.       Height := Height+Dif.Y;
25.      end;
26.      {Complete the other remaining sides.}
27.    end else
28.    Begin  //Drag from center rect;
29.     Dif := TPoint.Create(MouseWentDownHere.X-X,MouseWentDownHere.Y-Y);
30.    Top:=Top-Dif.Y;
31.    Left := Left-Dif.X;
32.   End;
33. end;                                          
34.  

For a Borderless form.

I only completed the TOP side size.
Grab within the margin on top and you should be able to size the height.
anywhere else, you can move it.

 simply complete the other 3 sides I didn't do.

Jamie

[Pe3s]

if I set BorderStyle := bsNone in the object inspector and add the code

Code: Pascal  [Select][+][-]

1.  inherited CreateParams(Params);
2.  
3.   Params.Style := Params.Style and
4.     not (WS_CAPTION or WS_THICKFRAME or WS_BORDER);
5.  

this scaling does not work, handles are missing

I tested this code earlier and I believe it causes the form to freeze during scaling.

Code: Pascal  [Select][+][-]

1. procedure TForm1.CreateParams(var Params: TCreateParams);
2. begin
3.   inherited CreateParams(Params);
4.   Form1.BorderStyle:= bsNone;
5. end;
6.  

[Zoran]

Setting Form.BorderStyle might trigger recreating the window.

I don't know what Form.CreateParams do (I'm not too experienced in this kind of programming), but if this is some procedure which is called inside process of creating the window, then you shouldn't set border style there, as it will lead to calling the same procedure (and recreating the window) endlessly.

[n7800]

Yes, changing the "BorderStyle" property recreates the window (definitely on Windows). I've already had unexpected problems because of this, where registered hotkeys stopped working.

[Pe3s]

Is there a way to bypass and correct this?

[Pe3s]

What do I need to add to add scaling handles if I set BorderStyle:= bsNone in the object inspector?

Code: Pascal  [Select][+][-]

1. procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
2. const
3.   EDGEDETECT = 7;
4. var
5.   deltaRect: TRect;
6. begin
7.   inherited;
8.   if BorderStyle = bsNone then
9.     with Msg, deltaRect do
10.     begin
11.       Left   := XPos - BoundsRect.Left;
12.       Right  := BoundsRect.Right - XPos;
13.       Top    := YPos - BoundsRect.Top;
14.       Bottom := BoundsRect.Bottom - YPos;
15.       if (Top < EDGEDETECT) and (Left < EDGEDETECT) then
16.         Result := HTTOPLEFT
17.       else if (Top < EDGEDETECT) and (Right < EDGEDETECT) then
18.         Result := HTTOPRIGHT
19.       else if (Bottom < EDGEDETECT) and (Left < EDGEDETECT) then
20.         Result := HTBOTTOMLEFT
21.       else if (Bottom < EDGEDETECT) and (Right < EDGEDETECT) then
22.         Result := HTBOTTOMRIGHT
23.       else if (Top < EDGEDETECT) then
24.         Result := HTTOP
25.       else if (Left < EDGEDETECT) then
26.         Result := HTLEFT
27.       else if (Bottom < EDGEDETECT) then
28.         Result := HTBOTTOM
29.       else if (Right < EDGEDETECT) then
30.         Result := HTRIGHT
31.         end;
32. end;              
33.