Author: Jonas Bilinkevicius
I want to change the form's caption font and alignment to DT_CENTER. How can I do
this?
Answer:
Note: The formDeactivate never gets called so when the form isn't active, sometimes
the FormPaint isn't called. If anything causes the form to be repainted while in
inactive, it draws correctly.
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
7
8 type
9 TForm1 = class(TForm)
10 procedure FormPaint(Sender: TObject);
11 procedure FormResize(Sender: TObject);
12 procedure FormDeactivate(Sender: TObject);
13 procedure FormActivate(Sender: TObject);
14 private
15 public
16 { Public declarations }
17 end;
18
19 var
20 Form1: TForm1;
21
22 implementation
23
24 {$R *.DFM}
25
26 procedure TForm1.FormPaint(Sender: TObject);
27 var
28 LabelHeight, LabelWidth, LabelTop: Integer;
29 caption_height, border3d_y, button_width, border_thickness: Integer;
30 MyCanvas: TCanvas;
31 CaptionBarRect: TRect;
32 begin
33 CaptionBarRect := Rect(0, 0, 0, 0);
34 MyCanvas := TCanvas.Create;
35 MyCanvas.Handle := GetWindowDC(Form1.Handle);
36 border3d_y := GetSystemMetrics(SM_CYEDGE);
37 button_width := GetSystemMetrics(SM_CXSIZE);
38 border_thickness := GetSystemMetrics(SM_CYSIZEFRAME);
39 caption_height := GetSystemMetrics(SM_CYCAPTION);
40 LabelWidth := Form1.Canvas.TextWidth(Form1.Caption);
41 LabelHeight := Form1.Canvas.TextHeight(Form1.Caption);
42 LabelTop := LabelHeight - (caption_height div 2);
43 CaptionBarRect.Left := border_thickness + border3d_y + button_width;
44 CaptionBarRect.Right := Form1.Width - (border_thickness + border3d_y)
45 - (button_width * 4);
46 CaptionBarRect.Top := border_thickness + border3d_y;
47 CaptionBarRect.Bottom := caption_height;
48 if Form1.Active then
49 MyCanvas.Brush.Color := clActiveCaption
50 else
51 MyCanvas.Brush.Color := clInActiveCaption;
52 MyCanvas.Brush.Style := bsSolid;
53 MyCanvas.FillRect(CaptionBarRect);
54 MyCanvas.Brush.Style := bsClear;
55 MyCanvas.Font.Color := clCaptionText;
56 MyCanvas.Font.Name := 'MS Sans Serif';
57 MyCanvas.Font.Style := MyCanvas.Font.Style + [fsBold];
58 DrawText(MyCanvas.Handle, PChar(' ' + Form1.Caption), Length(Form1.Caption) + 1,
59 CaptionBarRect, DT_CENTER or DT_SINGLELINE or DT_VCENTER);
60 MyCanvas.Free;
61 end;
62
63 procedure TForm1.FormResize(Sender: TObject);
64 begin
65 Form1.Paint;
66 end;
67
68 procedure TForm1.FormDeactivate(Sender: TObject);
69 begin
70 Form1.Paint;
71 end;
72
73 procedure TForm1.FormActivate(Sender: TObject);
74 begin
75 Form1.Paint;
76 end;
77
78 end.
|
