[SOLVED] Custom Titlebar

[aydın]

Hi,

I am actually using another code for this method, but I am facing some problems when using it:
 - The biggest problem is that the size of the window is not preserved even when the window is closed and opened.
 - None of the animations work.

I think using a method like Delphi does would actually work for me.
I want it to be fully customizable.

Only Windows is sufficient.

If you quickly drag Delphi ide from the side, this happens:
So it's still there in a hidden way, but it's covered up.

[KodeZwerg]

I am actually using another code for this

Why not append a minimalistic project that show what you have?
I am only aware of borderless and adding your very own custom Titlebar to it, that has all the features like the original, including control for border, resizing, screen-snapping etc.

[aydın]

Why not append a minimalistic project that show what you have?

I was at work, and the source code was not near me.

Here is the source code:

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

1. Uses Windows;
2. ...
3.  
4. Procedure TForm1.FormCreate(Sender: TObject);
5. Var
6.   Style: Longint;
7. Begin
8.   if BorderStyle <> bsNone then
9.   Begin
10.     Style:= GetWindowLong(Handle, GWL_STYLE);
11.     if (Style and WS_CAPTION) = WS_CAPTION then
12.     Begin
13.       Case BorderStyle Of
14.         bsSingle, bsSizeable:
15.           SetWindowLong(Handle, GWL_STYLE, Style and (not (WS_CAPTION)) or WS_BORDER);
16.  
17.         bsDialog:
18.           SetWindowLong(Handle, GWL_STYLE, Style and (not (WS_CAPTION)) or DS_MODALFRAME or WS_DLGFRAME);
19.       End;
20.       Height:= Height -GetSystemMetrics(SM_CYCAPTION);
21.       Refresh;
22.     End;
23.     Application.ProcessMessages;
24.   End;
25. End;
26.  

But after several close-opens, it starts to drift.

[KodeZwerg]

I am unsure about if the LCL is happy that you hack it up internal, but you should switch to GetWindowLongPtr/SetWindowLongPtr.

[KodeZwerg]

Try this if it does do what you try to achieve:

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Windows, LCLType,
9.   Classes , SysUtils , Forms , Controls , Graphics , Dialogs;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     procedure FormActivate(Sender: TObject);
17.   strict private
18.     FJustOnce: Boolean;
19.   private
20.   protected
21.   public
22.  
23.   end;
24.  
25. var
26.   Form1: TForm1;
27.  
28. implementation
29.  
30. {$R *.lfm}
31.  
32. { TForm1 }
33.  
34. procedure TForm1.FormActivate(Sender: TObject);
35. var
36.   Style: LongWord;
37. begin
38.   if (not FJustOnce) then
39.     if Self.BorderStyle <> bsNone then
40.       begin
41.         Style := GetWindowLongPtr(Self.Handle, GWL_STYLE);
42.         if (Style and WS_CAPTION) = WS_CAPTION then
43.           begin
44.             case Self.BorderStyle Of
45.               bsSingle, bsSizeable:
46.                 SetWindowLongPtr(Self.Handle, GWL_STYLE, Style and (not (WS_CAPTION)) or WS_BORDER);
47.               bsDialog:
48.                 SetWindowLongPtr(Self.Handle, GWL_STYLE, Style and (not (WS_CAPTION)) or DS_MODALFRAME or WS_DLGFRAME);
49.             end;
50.             Self.Height := Self.Height - GetSystemMetrics(SM_CYCAPTION);
51.             MoveWindow(Self.Handle, Left, Top, Width-1, Height, True);
52.             //Refresh;
53.           end;
54.       //Application.ProcessMessages;
55.       FJustOnce := True;
56.     end;
57. end;
58.  
59. end.

[aydın]

The window stretches when I open and close it.

There is a bit of a border at the top but I can't remove it. I wonder if I can hide it in some way.

[jamie]

Interesting, that chunk of code caused my system to detect an intrusion because I used the debugger to abort the process and then attempting to rerun it, I got a debug error, and my system detected an intrusion.

[KodeZwerg]

I am still total unsure what you actual try to do besides programming against the LCL.
Maybe this demo is what you want to do?
(having a borderless window with possibility to resize and or move it somehow)

[aydın]

Maybe this demo is what you want to do?

It is really a big responsibility to use this. After passing this, small details like dragging to fullscreen (drag and drop to the top) will be strange.

Actually, what I want is for it to work smoothly. I don't understand why it's causing problems.

It just behaves strangely because I lifted the title and the animations don't work.

[KodeZwerg]

Maybe this demo is what you want to do?

It is really a big responsibility to use this. After passing this, small details like dragging to fullscreen (drag and drop to the top) will be strange.

Actually, what I want is for it to work smoothly. I don't understand why it's causing problems.

It just behaves strangely because I lifted the title and the animations don't work.

That demo link I provided, you just need to setup everything once, save it, use it as a skeleton template for further projects.
The way you do is coding against the LCL and against the Windows API, of course such can produce nasty side-effects which I am not aware of since that little piece of code does not show what you describe.
Please attach a minimalistic demo, as I already asked for, that show your problems.
You want a captionless Window (in terms of LCL and Windows = Borderless) but with a Border around that offers all the benefits of a non-Borderless Window.
I still not understand why you do not want to have a caption or why the demo link is nothing that you want (since it does show the basics very well).
From my point of view, I can not help right now any further since I do not have any problems by running your code.

[aydın]

Sure, the demo is attached.

If Delphi can do it, I think we should be able to do it too.

Here is one of the features I am looking for, again attached as a photo.

[KodeZwerg]

I created from scratch my own variant of a borderless window with resizing borders support.
I am facing issues with my own logic to make it look like you wanted it, that while you are resizing just a rectangle appear.
I post what I've got so far and hope someone can help to make it final.
In attachment is the complete source, here the units code to take a look directly at how wrong I am doing all this :-)
Actual resizing is for testing purposes currently limited to the bottomright corner.

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

1. unit unit2;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Windows, Messages, Types, GraphType,
9.   Classes , SysUtils , Forms , Controls , Graphics ,
10.   Dialogs , StdCtrls , ExtCtrls , Buttons;
11.  
12. type
13.   TResizeMode = (rmNone, rmTop, rmLeft, rmRight, rmBottom, rmTopLeft, rmTopRight, rmBottomLeft, rmBottomRight);
14.   TFormState = (fsNormal, fsMaximized, fsMinimized);
15.  
16. type
17.  
18.   { TForm1 }
19.  
20.   TForm1 = class(TForm)
21.     btnExit: TBitBtn;
22.     btnMax: TBitBtn;
23.     btnMin: TBitBtn;
24.     Button1: TButton;
25.     imgIcon: TImage;
26.     Label1: TLabel;
27.     Label2: TLabel;
28.     Label3: TLabel;
29.     lblCaption: TLabel;
30.     pnlClientArea: TPanel;
31.     pnlCaption: TPanel;
32.     pnlBottom: TPanel;
33.     pnlTop: TPanel;
34.     pnlLeft: TPanel;
35.     pnlRight: TPanel;
36.     procedure FormCreate(Sender: TObject);
37.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
38.       Shift: TShiftState; X , Y: Integer);
39.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X , Y: Integer
40.       );
41.     procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
42.       Shift: TShiftState; X , Y: Integer);
43.     procedure pnlCaptionMouseDown(Sender: TObject; Button: TMouseButton;
44.       Shift: TShiftState; X , Y: Integer);
45.   strict private
46.     FResizeMode: TResizeMode;
47.     FResizeRect: TRect;
48.     FResizing: Boolean;
49.     FDesktopBitmap: HBITMAP;
50.   private
51.     procedure DrawRectangleOnDesktop(const ALeft, ATop, AWidth, AHeight: Integer);
52.     procedure CaptureDesktop;
53.     procedure ClearRectangleFromDesktop;
54.   protected
55.   public
56.  
57.   end;
58.  
59. var
60.   Form1: TForm1;
61.  
62. implementation
63.  
64. {$R *.lfm}
65.  
66. procedure TForm1.FormCreate(Sender: TObject);
67. begin
68.   FResizeMode := rmNone;
69.   FResizing := False;
70.   FResizeRect := Rect(0, 0, 0, 0);
71.   imgIcon.Picture.Icon.Assign(Application.Icon);
72. end;
73.  
74. procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
75.   Shift: TShiftState; X , Y: Integer);
76. begin
77.   CaptureDesktop;
78.   if (Button = mbLeft) and (FResizeMode <> rmNone) then
79.     FResizing := True;
80. end;
81.  
82. procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
83.   Shift: TShiftState; X , Y: Integer);
84. begin
85.   if FResizing then
86.     begin
87.       ClearRectangleFromDesktop;
88.       FResizeRect := Rect(0, 0, 0, 0);
89.       FResizing := False;
90.     end;
91.   //todo: resize window to the new dimensions by taking care of positions
92. end;
93.  
94. procedure TForm1.CaptureDesktop;
95. var
96.   DesktopDC, MemDC: HDC;
97. begin
98.   DesktopDC := GetDC(GetDesktopWindow);
99.   MemDC := CreateCompatibleDC(DesktopDC);
100.   FDesktopBitmap := CreateCompatibleBitmap(DesktopDC, Screen.Width, Screen.Height);
101.   SelectObject(MemDC, FDesktopBitmap);
102.   BitBlt(MemDC, 0, 0, Screen.Width, Screen.Height, DesktopDC, 0, 0, SRCCOPY);
103.   ReleaseDC(GetDesktopWindow, DesktopDC);
104.   DeleteDC(MemDC);
105. end;
106.  
107. procedure TForm1.ClearRectangleFromDesktop;
108. var
109.   DesktopDC, MemDC: HDC;
110. begin
111.   DesktopDC := GetDC(GetDesktopWindow);
112.   MemDC := CreateCompatibleDC(DesktopDC);
113.   SelectObject(MemDC, FDesktopBitmap);
114.   BitBlt(DesktopDC, 0, 0, Screen.Width, Screen.Height, MemDC, 0, 0, SRCCOPY);
115.   ReleaseDC(GetDesktopWindow, DesktopDC);
116.   DeleteDC(MemDC);
117. end;
118.  
119. procedure TForm1.DrawRectangleOnDesktop(const ALeft, ATop, AWidth, AHeight: Integer);
120. var
121.   DesktopDC: HDC;
122. begin
123.   DesktopDC := GetDC(GetDesktopWindow);
124.   try
125.     with TCanvas.Create do
126.     begin
127.       Handle := DesktopDC;
128.       Pen.Color := clRed;
129.       Pen.Width := 2;
130.       Brush.Color := clNone;
131.       Brush.Style := bsClear;
132.       Rectangle(ALeft, ATop, AWidth, AHeight);
133.       Free;
134.     end;
135.   finally
136.     ReleaseDC(GetDesktopWindow, DesktopDC);
137.   end;
138. end;
139.  
140. procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X ,
141.   Y: Integer);
142. var
143.   ctrl: TControl;
144.   pt1, pt2: TPoint;
145. begin
146.   pt1 := ScreenToClient(Mouse.CursorPos);
147.   ctrl := ControlAtPos(pt1, [capfRecursive, capfAllowWinControls]);
148.   if ((not FResizing) and Assigned(ctrl)) then
149.     begin
150.       Label2.Caption := ctrl.Name;
151.       if ctrl.Name = 'pnlTop' then
152.         begin
153.           if ((pt1.Y >= 0) and (pt1.Y <= pnlTop.Height)) then
154.             FResizeMode := rmTop;
155.           if ((pt1.X >= 0) and (pt1.X <= pnlTop.Height)) then
156.             FResizeMode := rmTopLeft;
157.           if ((pt1.X >= pnlTop.Width - pnlTop.Height) and (pt1.X <= pnlTop.Width)) then
158.             FResizeMode := rmTopRight;
159.         end;
160.       if ctrl.Name = 'pnlBottom' then
161.         begin
162.           if ((pt1.Y >= (Self.Height - pnlBottom.Height)) and (pt1.Y <= Self.Height)) then
163.             FResizeMode := rmBottom;
164.           if ((pt1.X >= 0) and (pt1.X <= pnlBottom.Height)) then
165.             FResizeMode := rmBottomLeft;
166.           if ((pt1.X >= pnlBottom.Width - pnlBottom.Height) and (pt1.X <= pnlBottom.Width)) then
167.             FResizeMode := rmBottomRight;
168.         end;
169.       if ctrl.Name = 'pnlLeft' then
170.         begin
171.           if ((pt1.X >= 0) and (pt1.X <= pnlLeft.Width)) then
172.             FResizeMode := rmLeft;
173.           if ((pt1.Y >= 0) and (pt1.Y <= pnlLeft.Width)) then
174.             FResizeMode := rmTopLeft;
175.           if ((pt1.Y >= (Self.Height - pnlLeft.Width - 5)) and (pt1.X <= pnlLeft.Width)) then
176.             FResizeMode := rmBottomLeft;
177.         end;
178.       if ctrl.Name = 'pnlRight' then
179.         begin
180.           if ((pt1.X >= (Self.Width - pnlRight.Width)) and (pt1.X <= Self.Width)) then
181.             FResizeMode := rmRight;
182.           if ((pt1.Y >= 0) and (pt1.Y <= pnlLeft.Width)) then
183.             FResizeMode := rmTopRight;
184.           if ((pt1.Y >= (Self.Height - pnlRight.Width - 5)) and (pt1.X <= Self.Width)) then
185.             FResizeMode := rmBottomRight;
186.         end;
187.       Label1.Caption := Format('x: %d, y: %d', [pt1.x, pt1.y]);
188.       case FResizeMode of
189.         rmNone                  : begin pnlTop.Cursor := crDefault; pnlLeft.Cursor := crDefault; pnlRight.Cursor := crDefault; pnlBottom.Cursor := crDefault; end;
190.         rmTop, rmBottom         : begin pnlTop.Cursor := crSizeNS; pnlBottom.Cursor := crSizeNS; end;
191.         rmLeft, rmRight         : begin pnlLeft.Cursor := crSizeWE; pnlRight.Cursor := crSizeWE; end;
192.         rmTopLeft, rmBottomRight: begin pnlTop.Cursor := crSizeNWSE; pnlLeft.Cursor := crSizeNWSE; pnlRight.Cursor := crSizeNWSE; pnlBottom.Cursor := crSizeNWSE; end;
193.         rmTopRight, rmBottomLeft: begin pnlTop.Cursor := crSizeNESW; pnlLeft.Cursor := crSizeNESW; pnlRight.Cursor := crSizeNESW; pnlBottom.Cursor := crSizeNESW; end;
194.       end;
195.     end;
196.   if (FResizing and (FResizeMode <> rmNone)) then
197.     begin
198.       FResizeRect := Self.ClientRect;
199.       case FResizeMode of
200.         rmTop         : ; //- begin Self.Top := pt.Y; Self.Height := ABS(pt.Y); end;
201.         rmBottom      : FResizeRect.Height := pt1.Y; //+ Self.Height := pt.Y;
202.         rmLeft        : ; //- Self.Width := ABS(pt.X);
203.         rmRight       : FResizeRect.Width := pt1.X; //+ Self.Width := pt.X;
204.         rmTopLeft     : ;
205.         rmBottomRight : begin Self.Height := pt1.Y; Self.Width := pt1.X; end;
206.         rmTopRight    : ; //- begin Self.Height := pt.Y; Self.Width := pt.X; end;
207.         rmBottomLeft  : ;
208.       end;
209.       pt2 := ClientToScreen(pt1);
210.       ClearRectangleFromDesktop;
211.       // my calculations are not matching :-(
212.       DrawRectangleOnDesktop(pt2.X, pt2.Y, FResizeRect.Width, FResizeRect.Height);
213.     end;
214. end;
215.  
216. procedure TForm1.pnlCaptionMouseDown(Sender: TObject; Button: TMouseButton;
217.   Shift: TShiftState; X , Y: Integer);
218. begin
219.   ReleaseCapture;
220.   SendMessage(Self.Handle, WM_SYSCOMMAND, SC_MOVE or HTCAPTION, 0);
221. end;
222.  
223. end.

[KodeZwerg]

This is how it's currently looking when in resizing mode.

[KodeZwerg]

Small update

replace this method

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

1. procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
2.   Shift: TShiftState; X , Y: Integer);
3. begin
4.   if FResizing then
5.     begin
6.       ClearRectangleFromDesktop;
7.       Self.Top := FResizeRect.Top;
8.       Self.Left := FResizeRect.Left;
9.       Self.Width := FResizeRect.Width;
10.       Self.Height := FResizeRect.Height;
11.       FResizeRect := Rect(0, 0, 0, 0);
12.       FResizing := False;
13.     end;
14. end;

update in FormMouseMove:

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

1.   if (FResizing and (FResizeMode <> rmNone)) then
2.     begin
3.       FResizeRect := Self.ClientRect;
4.       FResizeRect.Offset(Self.Left, Self.Top);
5.       case FResizeMode of
6.         rmTop         : ;//FResizeRect.Top := FResizeRect.Height + pt1.Y; // incorrect
7.         rmBottom      : FResizeRect.Height := pt1.Y;
8.         rmLeft        : ;
9.         rmRight       : FResizeRect.Width := pt1.X;
10.         rmTopLeft     : ;
11.         rmBottomRight : begin FResizeRect.Height := pt1.Y; FResizeRect.Width := pt1.X; end;
12.         rmTopRight    : ;
13.         rmBottomLeft  : ;
14.       end;
15.       ClearRectangleFromDesktop;
16.       DrawRectangleOnDesktop(FResizeRect.Left, FResizeRect.Top, FResizeRect.Width + FResizeRect.Left, FResizeRect.Height + FResizeRect.Top);
17.     end;

Now resizing for right, bottom and bottomright is working good.

For the other directions I need to figure out how to do it correct or someone can help?

[KodeZwerg]

Final update for resizing via borders:

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

1.       case FResizeMode of
2.         rmTop         : FResizeRect.Top := Y + FResizeRect.Top;
3.         rmBottom      : FResizeRect.Height := pt1.Y;
4.         rmLeft        : FResizeRect.Left := X + FResizeRect.Left;
5.         rmRight       : FResizeRect.Width := pt1.X;
6.         rmTopLeft     : begin FResizeRect.Top := Y + FResizeRect.Top; FResizeRect.Left := X + FResizeRect.Left; end;
7.         rmBottomRight : begin FResizeRect.Height := pt1.Y; FResizeRect.Width := pt1.X; end;
8.         rmTopRight    : begin FResizeRect.Top := Y + FResizeRect.Top; FResizeRect.Width := pt1.X; end;
9.         rmBottomLeft  : begin FResizeRect.Height := pt1.Y; FResizeRect.Left := X + FResizeRect.Left; end;
10.       end;