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

Tipy a triky v Delphi, díl 43. - Zobrazení prvního snímku videa; A ještě jednou bublinková nápověda; Spuštění aplikace pouze jednou v rámci dané instance Windows

Jan Šindelář - 5.6.2002

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;