Vertikální titulkový pruh

Dnes se naučíme opět trošku vylepšit vzhled našich aplikací přidáním vertikálního titulkového pruhu k levému okraji formuláře. No, vlastně to nebude titulkový pruh v pravém slova smyslu, tedy alespoň ne ten, který má každá (tedy většinou) aplikace na horním okraji formuláře. Náš titulkový pruh nebude obsahovat ikonu aplikace ani ovládací tlačítka, ale ani to by nebyl problém v případě zájmu doplnit. Tento náš vertikální titulkový pruh bude tedy sloužit spíše jako jakýsi informační minipanel, který může například indikovat různé stavy aplikace a podobně. Pojďme však již k samotnému kódu: private
{ Private declarations }
procedure VerticalTitleBar(Texto: string; Size: Integer);
.
.
.

procedure TForm1.VerticalTitleBar(TexTo: string; Size: Integer);
var
LogFont: TLogFont;
tmpCanvas: TCanvas;
tmpRect: TRect;
x1, x2, y1, y2: integer;
begin
tmpCanvas := TCanvas.Create;
tmpCanvas.Handle := GetWindowDc(Handle);
try
GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont);
with LogFont do
begin
lfEscapement := 90 * 10;
lfOrientation := 90 * 10;
lfOutPrecision := OUT_TT_ONLY_PRECIS;
lfFaceName := `Arial`;
lfHeight := Size;
lfWeight := FW_BOLD;
lfQuality := PROOF_QUALITY;
end;
with tmpCanvas do
begin
Font.Handle := CreateFontIndirect(LogFont);
Font.Color := clWhite;
Brush.Color := clNavy;
end;
x1 := GetSystemMetrics(SM_CXEDGE) + GetSystemMetrics(SM_CXBORDER);
x2 := 20;
y1 := GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYEDGE) + GetSystemMetrics(SM_CYBORDER) + 1;
y2 := Height - GetSystemMetrics(SM_CYEDGE) - GetSystemMetrics(SM_CYBORDER);
tmpRect := Rect(x1, y1, x2, y2);
tmpCanvas.FillRect(tmpRect);
DrawText(tmpCanvas.Handle, PChar(Texto), - 1, tmpRect, DT_BOTTOM or DT_SINGLELINE);
finally
tmpCanvas.Free;
end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
VerticalTitleBar(`Titulek vertikálního pruhu`, 12);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
VerticalTitleBar(`Titulek vertikálního pruhu`, 12);
end;