Author: Jonas Bilinkevicius
How to change the appearance of a forms border?
Answer:
Solve 1:
Actually, it is very easy top change the standard frame border, just by capturing
the two events of Non-Client-Paint and Non-Client-Activate and calling your own
drawing at your own will onto the form.
First, you will have to find the width of your frame border, which can be done by
using the GetSystemMetrics method. Now you can do whatever you want within the
canvas, however, you should not leave the frame area.
1 type
2 TForm1 = class(TForm)
3 private
4 procedure FormFrame;
5 procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
6 procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;
7 public
8 end;
9
10 procedure TForm1.FormFrame;
11 var
12 YFrame: Integer;
13 Rect: TRect;
14 begin
15 YFrame := GetSystemMetrics(SM_CYFRAME);
16 Canvas.Handle := GetWindowDC(Handle);
17 with Canvas, Rect do
18 begin
19 Left := 0;
20 Top := 0;
21 Right := Width;
22 Bottom := Height;
23 Pen.Style := psClear;
24
25 // draw background of frame
26 Brush.Color := clNavy;
27 Brush.Style := bsSolid;
28 Rectangle(Left, Top, Right, YFrame);
29 Rectangle(Left, Top, YFrame, Bottom);
30 Rectangle(Right - YFrame, Top, Right, Bottom);
31 Rectangle(Left, Bottom - YFrame, Right, Bottom);
32
33 // draw frame pattern
34 Brush.Color := clYellow;
35 Brush.Style := bsDiagCross;
36 Rectangle(Left, Top, Right, YFrame);
37 Rectangle(Left, Top, YFrame, Bottom);
38 Rectangle(Right - YFrame, Top, Right, Bottom);
39 Rectangle(Left, Bottom - YFrame, Right, Bottom);
40 end;
41 end;
42
43 procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
44 begin
45 inherited;
46 FormFrame;
47 end;
48
49 procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
50 begin
51 inherited;
52 FormFrame;
53 end;
54
55 if you will have problem when maximizing the form, resize if to the right or the
56 Title caption bar will not update properly, you may try to catch the WM_SIZE
57 message.
58 <!--CS-->
59 procedure WMSize(var Msg: TWMSize); message WM_SIZE;
60 ...
61 procedure TForm1.WMSize(var Msg: TWMSize);
62 begin
63 inherited;
64 FormFrame;
65 end;
Solve 2:
This will paint a one pixel red border around the entire window.
66 type
67 TForm1 = class(TForm)
68 private
69 { Private declarations }
70 procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
71 public
72 { Public declarations }
73 end;
74
75 var
76 Form1: TForm1;
77
78 implementation
79
80 {$R *.DFM}
81
82 procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
83 var
84 dc: hDc;
85 Pen: hPen;
86 OldPen: hPen;
87 OldBrush: hBrush;
88 begin
89 inherited;
90 dc := GetWindowDC(Handle);
91 msg.Result := 1;
92 Pen := CreatePen(PS_SOLID, 1, RGB(255, 0, 0));
93 OldPen := SelectObject(dc, Pen);
94 OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
95 Rectangle(dc, 0, 0, Form1.Width, Form1.Height);
96 SelectObject(dc, OldBrush);
97 SelectObject(dc, OldPen);
98 DeleteObject(Pen);
99 ReleaseDC(Handle, Canvas.Handle);
100 end;
|