Tipy a triky v Delphi, díl 48.

A máme tu další díl našeho seriálu. Tentokrát si ukážeme, jak vytvořit na formuláři vertikální titulkový pruh.

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č...

Diskuze (3) Další článek: Autor Gnutelly zemřel ve věku 25 let

Témata článku: Software, Programování, DEL, Trik, TRI, Díl


Určitě si přečtěte

9 nejlepších českých webů, kde lze stáhnout filmy a seriály

9 nejlepších českých webů, kde lze stáhnout filmy a seriály

** Když selžou legální zdroje, můžete se zkusit obrátit na služby pro stahování souborů ** Ulož.to není zdaleka jediné, které nabízí videoobsah ke stažení ** Konkurenční služby nabízí levnější placené účty

redakce | 112

redakce
TipyHudba, filmy, seriályWeb
Nejlepší notebooky do 20 000 Kč. Tipy, co se dnes vyplatí koupit

Nejlepší notebooky do 20 000 Kč. Tipy, co se dnes vyplatí koupit

** S cenou do 20 tisíc lze vybrat solidní notebook na práci i hry ** Přenosné notebooky nabídnou i kovová těla a rychlý hardware ** Možná největší problém je nedostupnost, nejžádanější kusy jsou vyprodané

David Polesný | 36

David Polesný
VánoceNotebooky
Vodafonu se zhroutila kabelovka. Síť bývalého UPC má výpadky
Lukáš Václavík
VodafoneUPC
Finanční správa tento měsíc spustí Moje Daně. Přiznání má být hračka
Lukáš Václavík
eIdentitaČeskoeGovernment
Dostali jste nový počítač? Tohle s ním udělejte, než ho začnete používat

Dostali jste nový počítač? Tohle s ním udělejte, než ho začnete používat

** Každý nový počítač si zaslouží počáteční péči ** Odinstalujte bloatware a nezapomeňte na vhodné nastavení ** Poradíme, jak se o počítač s Windows 10 postarat

David Polesný, Stanislav Janů | 76

David PolesnýStanislav Janů
PočítačeNotebooky
CZ.NIC bezplatně naděluje USB/NFC klíče. Jak jej získat?
Lukáš Václavík
CZ.NICeGovernment
Nová volitelná aktualizace opravuje více než 40 chyb v operačním systému Windows 10
Karel Kilián
Windows UpdateAktualizaceWindows 10
Jak najít hranice území obcí a okresů, abyste věděli, kde se můžete pohybovat
Filip KůželJakub Čížek
KoronavirusMapy
Vážně dnes ještě někdo krade Adobe? Video můžete stříhat zdarma v Resolve a fotky i vektory zvládne Affinity

Vážně dnes ještě někdo krade Adobe? Video můžete stříhat zdarma v Resolve a fotky i vektory zvládne Affinity

** Kde jsou ty doby, kdy měl skoro každý doma Photoshop ** Photoshop a Premiere Pro od kamaráda nebo z warezu ** Dnes už to nemá smysl, existuje totiž hromada laciných alternativ

Jakub Čížek | 92

Jakub Čížek
Grafický editorStřih videa