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.

Diskuze (3) Další článek: ATI představila Mobile Radeon

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


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

Portál občana už funguje. Na státní web vypadá až překvapivě použitelně

Portál občana už funguje. Na státní web vypadá až překvapivě použitelně

** Portál občana už funguje, vyřídíte na něm první požadavky ** Funkce se budou postupně rozšiřovat ** Web je docela moderní a přehledný

David Polesný | 65

Byli tam! Důkazy o přistání na Měsíci, Lunochody i čínská sonda jsou vidět z vesmíru

Byli tam! Důkazy o přistání na Měsíci, Lunochody i čínská sonda jsou vidět z vesmíru

** Sonda LRO pořídila z oběžné dráhy Měsíce zajímavé snímky ** Jsou na nich vidět artefakty všech misí programu Apolla, které přistály na povrchu Měsíce ** Jde například o části lunárních modulů, rovery a dokonce i vlajky

Petr Kubala | 60

Rekordy počasí: V Česku to ještě jde, skutečné extrémy zažívají jinde

Rekordy počasí: V Česku to ještě jde, skutečné extrémy zažívají jinde

** Teplotní extrémy dokážou překvapit. Seznamte se s rekordy v Česku i ve světě ** Rekordní hodnoty jsou mnohdy až k neuvěření ** Zjistěte, kdy ke bylo největší horko, zima, déšť či vítr

Karel Kilián | 7

Porno insider: Jak virtuální realita vstupuje do filmů pro dospělé

Porno insider: Jak virtuální realita vstupuje do filmů pro dospělé

** Pornografie údajně představuje třetinu internetové obsahu a je technologický tahounem ** Do erotického obsahu postupně zasahuje i virtuální realita ** Kromě vizuálního vjemu se pracuje také na virtuálním uspokojení toho hmatového

Jan Dudek | 28


Aktuální číslo časopisu Computer

Velký test 18 bezdrátových sluchátek

Vše o přechodu na DVB-T2

Procesory AMD opět porážejí Intel

7 NVMe M.2 SSD v přímém souboji