Tipy a triky v Delphi, díl 43.

Dnes si ukážeme, jak zobrazit první snímek videosouboru, vytvoříme si vlastní bublinkovou nápovědu a ukážeme si, jak zajistit pouze jedno spuštění naší aplikace během dané instance Windows.

Zobrazení prvního snímku videa

Pokud potřebujete vytvořit pouhý náhled a ne přehrát celé video, obvykle se k tomu používá první snímek, i když zrovna z prvního snímku nemusí být vždy zřejmé, oč se jedná. K jeho zobrazení použijeme komponentu MediaPlayer, čímž nám odpadne starost o všechny záležitosti související s prací se samotným video souborem. Můžeme tak zobrazit první snímek (frame) z téměř libovolného formátu videa, tedy přesněji řečeno z těch formátů, jejichž kodeky máme v systému nainstalovány. A o práci s nimi se právě postará komponenta MediaPlayer. Proto ji umístěte na formulář a dále vyplňte parametr FileName, který určuje název souboru, jehož první snímek chceme zobrazit. Nyní již stačí přidat tento jednoduchý kód a první snímek se zobrazí v okně MediaPlayeru:

procedure TForm1.Button1Click(Sender: TObject);
begin
Application.ProcessMessages;
MediaPlayer1.Open;
Application.ProcessMessages;
MediaPlayer1.Step;
Application.ProcessMessages;
MediaPlayer1.Previous;
end;

A ještě jednou bublinková nápověda

A znovu tu máme téma bublinkové nápovědy. Tentokrát si vytvoříme přímo vlastní bublinkovou nápovědu (Hint), a to prostřednictvím komponenty Panel. Umístěte ji tedy na formulář. O její vlastnosti se nemusíte starat, budou měněny přímo programově. Dále bude potřeba jeden Timer, abychom náš Hint zobrazili na požadovaný časový interval. Poté si ještě na formulář umístěte jedno tlačítko, na kterém budeme funkčnost příkladu demonstrovat.

A nyní již samotný kód:

.
.
.
private
    { Private declarations }
    procedure ShowAHint(x: integer; y: integer; Caption: string; Duration: LongInt);
.
.
.

procedure TForm1.FormCreate(Sender: TObject);
begin
  Timer1.Enabled := false;
  Panel1.Visible := false;
  Panel1.BevelInner := bvNone;
  Panel1.BevelOuter := bvNone;
  Panel1.BorderStyle := bsSingle; 
end;

procedure TForm1.ShowAHint(x : integer; y : integer; Caption : string; Duration : LongInt);
var
  dc : hdc;
  OldFont : hFont;
  pt : TSize;
  p : pChar;
begin
  if Timer1.Enabled <> false then Timer1.Enabled := false;
  Timer1.Enabled := false;
  if Panel1.Visible <> false then Panel1.Visible := false;
  if Caption = `` then exit;
  Panel1.Caption := caption;
  GetMem(p, Length(Panel1.Caption) + 1);
  StrPCopy(p, Panel1.Caption);
  dc := GetDc(Panel1.Handle);
  OldFont := SelectObject(dc, Panel1.Font.Handle);
  GetTextExtentPoint32(dc, p, Length(Panel1.Caption), pt);
  SelectObject(dc, OldFont);
  ReleaseDc(Panel1.Handle, Dc);
  FreeMem(p, Length(Panel1.Caption) + 1);
  Panel1.Left := x;
  Panel1.Top := y;
  Panel1.Width := pt.cx + 6;
  Panel1.Height := pt.cy + 2;
  Panel1.Color:= clLime;
  Panel1.Font.Color := clBlue;
  Panel1.Visible := true;
  Timer1.Interval := Duration;
  Timer1.Enabled := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if Panel1.Visible <> false then
  Panel1.Visible := false;
  Timer1.Enabled := false;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Application.ProcessMessages;
ShowAHint(Button1.Left, Button1.Top + Button1.Height + 6, Button1.Hint, 2000);
end;

Jak vidíte, zobrazení nápovědy je kvůli zjednodušení vyvoláno po stisku tlačítka, což není právě praktické, doplnit si zobrazování po najetí myší vám ovšem nechám za domácí úkol. Ale zpět k samotnému zobrazení. Nejprve je třeba u daného tlačítka vyplnit položku Hint, protože odtud je text brán. Také by bylo dobré deaktivovat původní hint (ShowHint := false), aby se nám nezobrazovaly nápovědy dvě.

Samotné parametry "okna" nápovědy si můžete upravit jednak přímo v události OnCreate hlavního formuláře, kde je nastaveno několik základních vizuálních vlastností. Zbytek najdete přímo v proceduře ShowAHint, která má čtyři parametry – souřadnice, kde se má nápověda zobrazit, text nápovědy a dobu, po jakou bude nápověda zobrazena. Velikost okna nápovědy (tedy vlastně Panelu) je upravena podle velikosti zobrazovaného textu, ale nic vám nebrání si velikost přizpůsobit. Rovněž si můžete sami upravit vlastnosti, jako je barva podkladu nápovědy (v našem příkladu zvolena dost kontrastní barva Lime) či barvu a parametry samotného textu.

Spuštění aplikace pouze jednou v rámci dané instance Windows

Poněkud krkolomný nadpis, uznávám. Ale hned si vysvětlíme, oč se jedná. Vzpomínáte si, jak jsme si kdysi ukazovali, jak zamezit několikanásobnému spuštění aplikace? Tento příklad zase zajistí, že vaše aplikace bude spustitelná pouze jednou během aktuálního běhu Windows. Pokud bude někdo chtít vaši aplikaci spustit podruhé, bude muset nejprve Windows restartovat. K tomu nám poslouží funkce GlobalAddAtom a GlobalFindAtom. Využití tohoto příkladu ponechám na vás, jistě sami na něco přijdete.

procedure TForm1.FormShow(Sender : TObject);
var
Atom : integer;
begin
if GlobalFindAtom(`TEXT_IDENTIFIKUJICI_NASI_APLIKACI`) = 0 then Atom := GlobalAddAtom(`TEXT_IDENTIFIKUJICI_NASI_APLIKACI`)
else
  begin
  ShowMessage(`Tato aplikace může být spuštěna pouze jednou za běhu Windows. Pro opětovné spuštění je třeba Windows restartovat`);
  Close;
  end;
end;

Diskuze (13) Další článek: Beta nVidia Detonatory 29.42 WHQL

Témata článku: Software, Windows, Programování, Filename, Díl, Zjednodušený příklad, První spuštění, HFO, První parametr, DEL, TRI, První snímek, Timer, Trik


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

Micro:bit V2: Tuto destičku plnou čipů dokáže naprogramovat i vaše babička

Micro:bit V2: Tuto destičku plnou čipů dokáže naprogramovat i vaše babička

** Chcete se teď hned naučit programovat čipy? ** Nechcete nic instalovat a číst zdlouhavé manuály? ** Naprogramujeme si Micro:bit, který zahraje Tichou noc

Jakub Čížek | 35

Jakub Čížek
Pojďme programovat elektronikuProgramování pro děti
Volitelná aktualizace Windows 10 opravila několik chyb, způsobila ale další problémy
Karel Kilián
Windows UpdateAktualizaceWindows 10
Archivovat data do cloudu, na HDD, SSD, DVD, nebo Blu-ray? Co je nejvýhodnější?

Archivovat data do cloudu, na HDD, SSD, DVD, nebo Blu-ray? Co je nejvýhodnější?

** Kam doma natrvalo uložit data? Vyplatí se ještě optická média? ** Jaké kapacity disků a médií má smysl koupit? ** Cenovou výhodnost si ukážeme na příkladech s 2TB úložištěm

Lukáš Václavík | 122

Lukáš Václavík
ZálohováníÚložištěPevné disky
Messenger a Instagram přicházejí v Evropě o funkce. Kvůli nové směrnici o soukromí
Vladislav Kluska
EvropaInstagramFacebook Messenger
Chytré hodinky Honor a Huawei se zbavily největší brzdy. Naučily se instalovat aplikace
Filip Kůžel
HonorHodinkyMobilní aplikace
Vodafonu se zhroutila kabelovka. Síť bývalého UPC má výpadky
Lukáš Václavík
VodafoneUPC
Lidl buduje chytrou domácnost, propojí všechno se vším
Lukáš Václavík
LidlChytrá domácnostIoT
Dalším gigabitovým hráčem bude ČEZ. Internet již poskytuje prvním zákazníkům
Lukáš Václavík
Poskytovatelé internetuPřipojení k internetu

Aktuální číslo časopisu Computer

Megatest rychlých Wi-Fi 6 routerů

Jak ztišit počítač

Velký test mATX skříní