Tipy a triky v Delphi, díl 6.

Animace ikony aplikace, skrytí ikon na pracovní ploše, pohyb a klikání myší. Toto a další tipy jsou tématem dnešního dílu.
Animace ikony aplikace

Prvním dnešním tipem, který si ukážeme, bude poměrně jednoduchý a docela zajímavý efekt s ikonou aplikace. Jistě to znáte, každá aplikace má obvykle ve svém hlavním okně (případně i v oknech dalších) ve svém titulkovém pruhu vedle titulku okna zobrazenu zmenšenou ikonu. Tutéž ikonu je též vidět na Hlavním panelu. Poměrně snadným způsobem můžeme docílit toho, že se ikona bude měnit a při použití vhodných po sobě jdoucích ikon snadno vytvoříme malou animaci.

Jak tedy na to? Nejprve si někam "uložíme" použité ikony. Použít můžete v podstatě libovolnou komponentu, která je schopna uchovat obrázek. V našem příkladu použijeme pro jednoduchost Image, i když v případě větší "animace" by to asi nebylo právě vhodné řešení. Poté stačí jen zajistit pravidelnou změnu ikony, k čemuž můžeme použít např. Timer. Ukážeme si jednoduché řešení, jak střídat dvě ikony (řešení pro více ikon je samozřejmě obdobné).

.
var Ikona1:Boolean;
.
.
.


procedure TForm1.Timer1Timer(Sender: TObject);
begin
if Ikona1=false then
begin
  Application.icon:=Image1.Picture.Icon;
  Ikona1:=true;
end
else
begin
  Application.icon:=Image2.Picture.Icon;
  Ikona1:=false;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Ikona1:=true;
end;

Proměnná Ikona1 slouží pouze k identifikaci, která z ikon je momentálně zobrazena a lze samozřejmě použít i jiné řešení v závislosti na počtu použitých ikon. Nyní již stačí nastavit jen vhodný časový interval Timeru a malá animace je hotova.

Skrytí ikon pracovní plochy

Velmi jednoduchý tip, proto bez dalších větších úvodů. Praktické použití asi nebude tak časté, přesto se tato funkce může někdy hodit.

procedure SkryjIkony;
begin
ShowWindow(FindWindow(nil,`Program Manager`),SW_HIDE);
end;

procedure ZobrazIkony;
begin
ShowWindow(FindWindow(nil,`Program Manager`),SW_SHOW);
end;

Pohyb a klikání myší

Pod tímto na první pohled možná ne úplně srozumitelným nadpisem se neskrývá nic jiného, než programové pohybování myší po pracovní ploše s možností "kliknutí" pravým či levým tlačítkem. Na jednoduchém příkladu si ukážeme aktivaci tlačítka Start.

procedure AktivujStart;
begin
SetCursorPos(20, Screen.Height-20); {nastaveni kurzoru na tlacitko Start}
mouse_event(MOUSEEVENTF_LEFTDOWN,0, 0, 0, 0); {stisknuti leveho tlacitka}
mouse_event(MOUSEEVENTF_LEFTUP,0, 0, 0, 0); {"pusteni" leveho tlacitka}
end;

Na prvním řádku se nejprve přesuneme na tlačítko Start příkazem SetCursorPos(x,y). X-ová souřadnice je nastavena na 20 (abychom se dostali od okraje obrazovky "dovnitř" tlačítka Start). Y-ová souřadnice pochopitelně závisí na rozlišení obrazovky, které používáte. Proto se zjistí pomocí Screen.Height velikost obrazu a opět odečteme asi 20 pixelů, abychom se dostali na tlačítko Start. Následně již můžeme "kliknout" levým tlačítkem. Samozřejmě, že takto napsaný příklad bude fungovat pouze v tom případě, že máte Hlavní panel s tlačítkem Start v "klasické" poloze na dolním okraji obrazovky, to snad nemusím připomínat.

Stisknutí pravého tlačítka docílíme pouze náhradou použitých parametrů v mouse_event na:

mouse_event(MOUSEEVENTF_RIGHTDOWN,0, 0, 0, 0);
mouse_event(MOUSEEVENTF_RIGHTUP,0, 0, 0, 0);

Skrytí hodin

Když už jsme se opět trochu "dotkli" Hlavního panelu, ukážeme si teď, jak nechat zmizet hodiny. Pod Windows 9x dojde i k posunu ikon doprava na uvolněné místo, ve Windows 2000 bohužel zůstane prázdné místo. Jednoduchý parametr nám určuje, zda hodiny zobrazit či nezobrazit.

procedure UkazHodiny(ano : boolean);
var TrayWnd, TrayNWnd, ClockWnd : Hwnd;
begin
TrayWnd  := FindWindow(`Shell_TrayWnd`, nil);
TrayNWnd := FindWindowEx(TrayWnd,0,`TrayNotifyWnd`, nil);
ClockWnd := FindWindowEx(TrayNWnd,0,`TrayClockWClass`, nil);
if ano then ShowWindow(ClockWnd,sw_show)
      else ShowWindow(ClockWnd,sw_hide)
end;

Zobrazení sekundárních oken na Taskbaru

Možná vám připadá nepěkné, když se sekundární okna vaší aplikace minimalizují do levého dolního rohu pracovní plochy. Nejen, že to nevypadá příliš pěkně, ale i opětovné obnovení okna je mírně řečeno nepohodlné. Pokud byste chtěli, aby se tato okna zobrazovala jako samostatné objekty na Hlavním panelu a byla tak snadno dostupná, přidejte do události OnCreate každého takového okna následující kód:

procedure TForm2.FormCreate(Sender: TObject);
begin
SetWindowLong(Handle, GWL_EXSTYLE, WS_EX_APPWINDOW);
end;

Rychlost procesoru

Chcete-li zjistit frekvenci procesoru, můžete na to použít následující funkci. Výsledek sice nebude naprosto dokonale přesný, ale pokud uděláte průměr z několika výsledků, přiblížíte se realitě dostatečně. Funkce vrátí frekvenci CPU v MHz.

function CPUSpeed : Double;
const DelayTime = 500;
var
  TimerHi,
  TimerLo  : DWORD;
  PriorityClass,
  Priority : Integer;

begin
PriorityClass:=GetPriorityClass(GetCurrentProcess);
Priority:=GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
Sleep(10);
  asm
    dw 310Fh
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
    dw 310Fh
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
  end;

SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Result:=TimerLo / (1000 * DelayTime);
end;

Čas od startu Windows

Na závěr si ukážeme, jak zjistit dobu od spuštění Windows. Můžete například potrápit své mladší sourozence či děti malou aplikací, která jim bude neustále připomínat, jak dlouho že už o toho počítače vysedávají.

function CasOdStartu: string;
const
td : integer = 1000 * 60 * 60 * 24;
th : integer = 1000 * 60 * 60;
tm : integer = 1000 * 60;
ts : integer = 1000;

var
  t : longword;
  d, h, m, s : integer;

begin
  t := GetTickCount;
  d := t div td;
  dec(t, d * td);
  h := t div th;
  dec(t, h * th);
  m := t div tm;
  dec(t, m * tm);
  s := t div ts;
  Result := `Cas od startu: `+IntToStr(d)+ ` dní `+IntToStr(h)+` hodin `+IntToStr(m)+ ` minut `+IntToStr(s)+` sekund`;
end;

A to je pro dnešek všechno. Příště se podíváme na klávesové zkratky, naučíme se spouštět aplikaci v celoobrazovkovém režimu, ukážeme si, jak zajistit spuštění pouze jedné instance programu a další drobnosti.

Témata článku: Software, Windows, Programování, Timer, Díl, Trik, 1000, Hlavní panel, Move, Levý panel, Pracovní plocha, Vhodný font, Start, Deco

3 komentáře

Nejnovější komentáře

  • Ivo Šmerek 24. 4. 2014 18:21:07
    Dobrý den, nevím jestli jestli Vaše redakce stále reaguje na komentáře...
  • autor 17. 10. 2001 10:57:53
    http://zive.cz/H/Developerdaily/Ar.asp?ARI=101436&CAI=2091
  • Peter Incertus 15. 10. 2001 19:42:53

    Neposlal by mi nekdo URL na 5. díl Tipu a triku v Delphi? Nejak ho...

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

Země se jenom o vlásek vyhnula věčnému zmrznutí

Země se jenom o vlásek vyhnula věčnému zmrznutí

** Země po většinu doby své existence zmrzlá rozhodně nebyla ** Podle nového výzkumu tomu však unikla jen o vlásek ** Kdyby totiž byla jenom o 15 procent dále od Slunce, tak by prý kompletně celá zamrzla

Včera | Stanislav Mihulka | 9

CCleaner obsahuje softwarovou havěť! Tvůrcům se do kódu dostali hackeři

CCleaner obsahuje softwarovou havěť! Tvůrcům se do kódu dostali hackeři

** Masově oblíbený program pro softwarovou očistu Windows ovládli hackeři ** Narušení se podařilo zavčas odhalit, unikla jen data o počítačích uživatelů ** Je paradoxní, že CCleaner byl slabě zabezpečen, když jej letos koupil Avast

18.  9.  2017 | David Polesný | 45

Noční strana Venuše vydala další tajemství

Noční strana Venuše vydala další tajemství

18.  9.  2017 | Jiří Černý

Jak tankují bombardéry: Z létající benzinky šest kilometrů nad Českem

Jak tankují bombardéry: Z létající benzinky šest kilometrů nad Českem

** Bombardéry tankují z létající benzinky Boeing KC-135 Stratotanker ** Tu americké letectvo pro doplňování paliva jiných letounů ve vzduchu využívá už více jak půlstoletí ** Tankování probíhá přes speciální výsuvné čerpací rameno na zádi

17.  9.  2017 | Natoaktual.cz


Aktuální číslo časopisu Computer

Vyplatí se ještě těžit kryptoměny?

Velký test studentských notebooků

Test pěti levných soundbarů

Nejlepší chytré hodinky