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;

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;

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;

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);

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;

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;

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.

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é).

kod

procedure TForm1.Button1Click(Sender: TObject);
var KeyState : TKeyboardState;
begin
GetKeyboardState(KeyState);
if (KeyState[VK_NUMLOCK] = 0) then KeyState[VK_NUMLOCK] := 1
else KeyState[VK_NUMLOCK] := 0;
if (KeyState[VK_CAPITAL] = 0) then KeyState[VK_CAPITAL] := 1
else KeyState[VK_CAPITAL] := 0;
if (KeyState[VK_SCROLL] = 0) then KeyState[VK_SCROLL] := 1
else KeyState[VK_SCROLL] := 0;
SetKeyboardState(KeyState);
end;
Pokud máte dostatečnou fantazii, jistě dokážete blikání jednotlivých diod synchronizovat v zajímavé světelné efekty.

procedure

Ukonci(titulek:string);
begin
PostMessage(FindWindow(Nil, titulek), WM_QUIT, 0, 0);
end;
Klávesy NumLock, CapsLock a Scroll Lock
Na závěr si trošku pohrajeme s výše uvedenými klávesami. Ukážeme si, jak je programově "stisknout", tj. aktivovat či deaktivovat jejich funkci, což je – jak jistě víte – doprovázeno rozsvícením či zhasnutím příslušných diod, takže pokud si dáte záležet, můžete vytvořit docela zajímavý efekt. Následující příklad aktivuje nebo deaktivuje (podle jejich aktuálního stavu) uvedené klávesy.

.

.
.
uses ShellApi;
.
.
.
procedure Spust(soubor,param,defaultdir:string);
begin
ShellExecute(0,nil,soubor,param,defaultdir, SW_SHOWNORMAL);
end;
Parametry jsou myslím jasné – aplikace včetně cesty, případné parametry (můžete nechat prázdné) a "pracovní" adresář (obvykle taktéž můžete ponechat prázdné). Kvůli zjednodušení není prováděna žádná kontrola úspěšnosti pokusu spustit aplikaci (tj. jestli vůbec aplikace existuje).
Pokud již aplikace splnila náš požadavek nebo ji už z jiného důvodu dále nepotřebujeme, můžeme ji jednoduše ukončit. Jeden z jednoduchých způsobů si teď ukážeme. Jediné, co potřebujeme vědět, je titulek okna aplikace, kterou chceme ukončit. Poté jí "pošleme zprávu" o našem požadavku na ukončení. Jednoduchá procedura může vypadat například takto:

Spuštění

a ukončení cizí aplikace
Další užitečnou věcí, kterou se teď naučíme, je spouštění cizích aplikací. To se nám může hodit například tehdy, když potřebujeme "spustit" nějaký typ dokumentu v externí aplikaci, protože s ním náš program neumí pracovat, a podobně.
Budeme potřebovat knihovnu ShellAPI, proto ji nezapomeňte přidat mezi ostatní do Uses. Vytvoříme si jednoduchou proceduru s několika málo parametry, která nám spustí libovolný soubor.

procedure

TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if MessageDlg('Opravdu ukočit ?', mtConfirmation, mbYesNoCancel, 0) = mrYes
then CanClose := true
else CanClose := false;
end;
Při pokusu o ukončení se zobrazí dialogové okno s potvrzením. To je samozřejmě pouze ukázkové řešení pro názornost a v reálných aplikacích použijeme určitě jiné řešení. Zkušenější z vás jistě vědí, že takto napsaný kód ovšem zobrazí onen dialog při každém ukončení aplikace, tedy ne jen pouze při pokusu o ukončení z "vnějšku", ale i při uzavření aplikace běžným způsobem. Proto by bylo vhodné doplnit proceduru o test, který nám určí, "kdo" aplikaci ukončuje. To nechám čtenářům za domácí úkol.

Detekce ukončení systému

S předchozí kapitolou souvisí i následující tip. Ukážeme si, jak zjistit, že se cizí aplikace (např. instalátor) nebo prostě samotný systém snaží ukončit Windows. Pokud naše aplikace zrovna provádí nějakou velmi důležitou činnost, můžeme vypnutí systému i zabránit a nebo včas zajistit případné uložení všech důležitých dat. Je to vlastně velice snadné. Když se Windows ukončují, odešlou všem běžícím aplikacím zprávu WM_QUERYENDSESSION, kterou "zachytíme" událostí OnCloseQuery hlavního formuláře aplikace. Parametr CanClose nastavíme na True, pokud chceme systému dovolit ukončení, a nebo False pro opačný efekt. Jednoduchý zdrojový kód může vypadat kupříkladu takto:

try

if not LookupPrivilegeValue('', 'SeShutdownPrivilege',tp.Privileges[0].Luid) then Exit;
tp.PrivilegeCount := 1;
tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if not AdjustTokenPrivileges(hToken, False, tp, SizeOf(prev_tp),prev_tp, Len) then Exit;
finally
CloseHandle(hToken);
end;
end;
ExitWindowsEx(EWX_REBOOT, 0);
end;
Vysvětlování, jak to celé funguje, by asi zabralo více času. Zjednodušeně řečeno je nutné projít všechny běžící procesy, zjistit, zda je možné je ukončit (protože pod Windows NT či 2000 jak jistě víte není z důvodů bezpečnosti dovoleno, jen tak se "hrabat" do systému, ke všemu potřebujete ta správná oprávnění), a nakonec se systém restartuje již stejným způsobem jako u výše uvedeného příkladu pro Windows 9x. Opět můžete použít již zmiňované parametry, které vám umožní systém nejen restartovat, ale i kompletně vypnout apod. Příklad byl testován v Delphi 5 a nejsem si jist, zda bude v této podobě pracovat ve všech verzích Delphi. Proto budu rád, když se ozvete, jak příklad pracuje i ve verzích starších či novějších.

Windows 2000

U Windows 2000 je situace poněkud složitější. Pojďme si rovnou ukázat zdrojový kód:
procedure Restart2000;
var
hToken, hProcess: THandle;
tp, prev_tp: TTokenPrivileges;
Len, Flags: DWORD;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
hProcess := OpenProcess(PROCESS_ALL_ACCESS, True, GetCurrentProcessID);
try
if not OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken) then Exit;
finally
CloseHandle(hProcess);
end;

V tomto

případě by mělo dojít k restartu systému bez ohledu na to, zda nám to ostatní aplikace dovolí či ne. Osobně bych se přikláněl spíše k první variantě, protože dáte ostatním aplikacím možnost se na ukončení systému "připravit".
Tato funkce má však i další možnosti parametrů kromě EWX_REBOOT. Jsou to:
• EWX_SHUTDOWN
• EWX_LOGOFF
• EWX_POWEROFF
Názvy jsou myslím dostatečně jasné a netřeba dalšího vysvětlování. Snad jen drobnou poznámku: ačkoliv popis parametrů a použití této funkce pochází přímo od Borlandu, občas se mi stane, že v určitých případech nefungují, jak mají (jedná se hlavně o poslední dvě varianty). Pokud snad někdo ze čtenářů ví proč, neváhejte se prosím pochlubit.

Windows 9x

Pod Windows 9x je situace poměrně jednoduchá. Stačí nám k tomu jeden řádek kódu:
procedure Restart;
begin
ExitWindowsEx(EWX_REBOOT, 0);
end;
Tento způsob je ten šetrnější, kdy je (zjednodušeně řečeno) ostatním aplikacím poslán dotaz, zda je možné systém ukončit, a ty nám to buď povolí nebo ne (viz další kapitola článku). Pokud chcete ukončit systém "násilím", stačí drobně upravit parametry na:
ExitWindowsEx(EWX_FORCE or EWX_REBOOT, 0);

Tématem

dnešního dílu bude restart a ukončení Windows, spouštění a ukončení cizích aplikací a závěrem jedna malá drobnost pro pobavení.
Restart a ukončení Windows
Nejprve si ukážeme, jak celkem snadno restartovat systém. Tato funkce se nám může hodit při různých příležitostech, např. pokud vaše aplikace provede určité změny v konfiguraci Windows, obvykle se projeví až po restartu systému (záleží samozřejmě na "závažnosti" provedených změn). Nejčastěji se s požadavkem na restart setkáte pravděpodobně při instalaci nového software a nutno poznamenat, že neustálé restarty nemají uživatelé příliš rádi. Proto je třeba s touto funkcí nakládat s rozumem, a co je nejdůležitější, vždy byste měli před restartem uživatele upozornit a dát mu možnost restartu zabránit.

procedura

Parametrem procedury je titulek okna, na který chceme trik aplikovat. Z toho vyplývá jedna důležitá věc: že můžete nechat deaktivovat tlačítko Close u libovolné běžící aplikace. Bohužel, opět nefunkční pod Windows 2000.
Co bude příště ?
Ukážeme si, jak restartovat či vypnout počítač, jak toto detekovat ve svých aplikacích a jak spouštět a ukončovat cizí aplikace.

Jak vyřadit z činnosti tlačítko Close

Potřebujete, aby vaše aplikace nešla ukončit? Pak vám může pomoci následující tip, který znemožní použití uzavíracího tlačítka okna a odstraní položku Zavřít ze systémového menu okna. V kombinaci s vhodným přesměrováním klávesové zkratky ALT-F4 v nastavení událostí hlavního formuláře a za použití triku, který schová aplikaci po stisku CTRL-ALT-DEL (viz druhý díl našeho seriálu), se stane aplikace (téměř) neukončitelnou. :)
procedure DisableClose(okno:string);
var hwndHandle : THANDLE;
hMenuHandle : HMENU;

begin
hwndHandle := FindWindow(nil, okno);
if (hwndHandle <> 0) then
begin
hMenuHandle := GetSystemMenu(hwndHandle, FALSE);
if (hMenuHandle <> 0) then DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;
end;