Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 48. - Vertikální titulkový pruh

Jan Šindelář - 10.7.2002

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;

Jak vidíte, o vykreslení se stará procedura VerticalTitleBar, která má pouze dva parametry – text zobrazovaného titulku a velikost fontu. Tyto parametry si můžeme podle potřeby celkem snadno rozšířit o další vlastnosti, které zobrazovaný titulek má. Tím je například barva titulku (v našem případě tmavě modrá - Navy), pochopitelně též barva textu i font. Samozřejmě můžete nastavit rovněž šířku (či spíše výšku) titulku, což zajistí proměnná x2, která má v našem případě hodnotu 20 bodů. Tuto šířku je pochopitelně nutné volit vzhledem k použitému fontu či přesněji řečeno velikosti použitého písma.

No a to je vlastně vše. Všimněte si též toho, že kvůli překreslení titulku v případě změny okna formuláře je volání umístěno v událostech OnPaint a OnResize formuláře.

Určitě vás také napadlo, zda by nešlo klasický aplikační titulek nahradit tím naším. V podstatě ano, ale pochopitelně po drobných úpravách. Přidat ikonu či tlačítka na zavření aplikace by snad neměl být takový problém. Rovněž zamezit zobrazení originálního titulkového pruhu není samozřejmě problém. Nesmíme však zapomenout na možnost přesunutí okna, neboť za náš nový titulkový pruh se samozřejmě aplikace uchopit a přesunout nedá. Proto je potřeba "přesměrovat" možnost uchopení a přesunu právě na náš nový titulek. I o tom však již byla kdysi v našem seriálu řeč...