Ošetření neočekávaných chyb

Jistě znáte starou, klasickou a pravdivou poučku, že v každém programu jsou chyby. Chybám v programech se prostě úplně na 100 % nevyhneme nikdy, ale přesto dobře víte, že prostřednictvím definování určitých výjimek existuje možnost, jak vzniklé chyby podchytit. Tedy v tom případě, že víte že může nebo nemusí dojít k nějakému chybovému stavu, upravíte kód tak, aby s oběma možnostmi počítal. V dnešních běžně používaných programovacích nástrojích je tento systém výjimek (Exception) propracován velmi dobře, takže není problém jej dostatečně využít. I když aplikace přímo nezkolabuje a program se právě prostřednictvím těchto výjimek snaží jaksi "zachránit", i tak se zobrazí "ošklivý" dialog o tom, že program vyvolal výjimku na adrese...a tak dále. Pokud se vám to nelíbí a raději byste chtěli, aby se zobrazilo vaše vlastní hlášení pro uživatele, pak si ukážeme jak na to.

Zdrojový kód tedy vypadá takto:

.
.
.
private
{ Private declarations }
procedure WndMove(var msg: TMessage); message WM_Move;
.
.
.

procedure TForm1.WndMove(var msg: TMessage);
begin
Form1.Caption := 'Pozice okna x: ' + IntToStr(longrec(Msg.LParam).lo) + ' y: ' + IntToStr(longrec(Msg.LParam).hi);
end;

Pohyb okna

Rovněž pohyb okna aplikace je velmi zajímavá a hlavně detekovatelná činnost (či lépe řečeno stav) a samozřejmě i v tomto případě půjde o zprávy systému. Využití je taktéž široké, namátkou mě napadá třeba využití při dnes velmi oblíbeném "přichytávání" či "přilepování" okna aplikace k okrajům pracovní plochy (viz. například Winamp). Zde je však třeba upozornit na jeden detail. Jak uvidíte později ve zdrojovém kódu, při pohybu okna jsou čteny aktuální souřadnice okna (které jsou v naší ukázce vypisovány do titulkového pruhu formuláře). Těch se dá právě využít například k již výše zmíněnému efektu přichytávání okna na okraje pracovní plochy. Jedná se o souřadnice levého horního rohu formuláře, avšak bez titulkového pruhu. Souřadnice 0,0 jsou tedy "o něco níže", než by se na první pohled mohlo zdá. Nicméně zpět k našemu původnímu záměru odchytit pohyb okna (příklad s přilepováním na okraje plochy si ukážeme snad jindy, ale věřím že jej každý zvládne sám).

Pohyb okna

Rovněž pohyb okna aplikace je velmi zajímavá a hlavně detekovatelná činnost (či lépe řečeno stav) a samozřejmě i v tomto případě půjde o zprávy systému. Využití je taktéž široké, namátkou mě napadá třeba využití při dnes velmi oblíbeném "přichytávání" či "přilepování" okna aplikace k okrajům pracovní plochy (viz. například Winamp). Zde je však třeba upozornit na jeden detail. Jak uvidíte později ve zdrojovém kódu, při pohybu okna jsou čteny aktuální souřadnice okna (které jsou v naší ukázce vypisovány do titulkového pruhu formuláře). Těch se dá právě využít například k již výše zmíněnému efektu přichytávání okna na okraje pracovní plochy. Jedná se o souřadnice levého horního rohu formuláře, avšak bez titulkového pruhu. Souřadnice 0,0 jsou tedy "o něco níže", než by se na první pohled mohlo zdá.

Zachycení změny obsahu schránky

I druhý dnešní tip bude založen na odchycení zprávy systému. Tentokrát to bude detekce změny obsahu schránky, což je možná ještě o něco užitečnější tip, než náš dnešní úvodní příklad. Jistě sami přijdete na řadu využití, takže bez dalších řečí si rovnou ukažme zdrojový kód:
.
.
.
public
{ Public declarations }
procedure ClipBoardChanged(var Message: TMessage); message WM_DRAWCLIPBOARD;
.
.
.

procedure TForm1.ClipBoardChanged(var Message: TMessage);
begin
ShowMessage('Došlo ke změně obsahu schránky');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SetClipboardViewer(Handle);
end;

Zde je tedy zdrojový kód:

.
.
.
private
{ Private declarations }
procedure WMTimeChange(var Msg: TMessage); message WM_TIMECHANGE;
.
.
.

procedure TForm1.WMTimeChange(var Msg: TMessage);
begin
inherited;
ShowMessage('Došlo ke změně systémového času/data.');
end;

Detekce změny času

Dnes začneme hezky pozvolna od velmi jednoduchého příkladu, na kterém si ukážeme, jak je možné detekovat změnu systémového času či data. Pochopitelně je myšlena změna času nebo data, která je vyvolána "uměle" (například uživatelem). Někteří uživatelé se tímto způsobem například pokoušejí obejít časové omezení shareware aplikací (většinou marně), ale změna času je pochopitelně běžnou legitimní činností a čas od času je potřeba systémové hodiny seřídit (pokud k tomu nepoužíváte například nějaký server). Jestliže je například vaše aplikace takového druhu, že by nešetrné změny času mohly způsobit nechtěný efekt, je dobré si to pohlídat. Jak jinak, opět se bude jednat o "odchycení" zprávy systému, konkrétně WM_TIMECHANGE.

Prvním parametrem

je prohledávaný ListView, druhý parametr je vlastní text, který hledáme, a posledním parametrem je číslo sloupce, v němž hodláme hledat. Upozorňuji na to, že je zde (ostatně jak je v obdobných případech pravidlem) použito číslování od nuly, takže první sloupec (i první řádek) mají index nula.
Návratový parametr je typu TListItem, takže z něj získáte všechny potřebné informace o pozici a dalších vlastnostech nalezeného prvku. Nebude-li nalezen žádný prvek, bude vrácena "hodnota" nil. Hledání nerozlišuje velikost písmen a nalezen je pouze celý hledaný řetězec.
Nejdůležitějším výsledkem hledání tedy obvykle bude řádek, na kterém se prvek nachází (sloupec samozřejmě známe, protože je parametrem hledání). Tento výsledek pak již musíte vhodně zpracovat sami například tím, že nastavíte Focus na daný prvek, nastavíte viditelnost (MakeVisible), aby se hned zobrazil a uživatel nemusel složitě listovat, a podobně.

function FindListViewItem(lv: TListView; const S: String; column: integer): TListItem;
var
i: integer;
found: Boolean;
begin
Assert(Assigned(lv));
Assert((lv.viewstyle = vsReport) or (column = 0));
Assert(S <> '');
for i := 0 to lv.Items.Count - 1 do
begin
Result := lv.Items[i];
if column = 0 then
found := AnsiCompareText(Result.Caption, S) = 0
else if column <= Result.SubItems.Count then
found := AnsiCompareText(Result.SubItems[column - 1], S) = 0
else
found := False;
if found then
Exit;
end;
Result := nil;
end;

procedure TForm1.Button1Click(Sender: TObject);
var lItem:TListItem;
begin
litem:=FindListViewItem(ListView1,'hledaný text',1);
if lItem<>nil then ShowMessage(lItem.Caption+' pozice:'+IntToStr(lItem.Index));
end;

Hledání prvků v ListView

Často se můžeme setkat s úlohou najít v ListView, který obsahuje velké množství dat, prvek požadovaných vlastností. Budeme nyní hovořit o ListView v podobě vsReport, který patří asi k nejčastějším. Pokud hledáme pouze mezi "hlavními" prvky, můžeme využít k tomu určenou metodu FindCaption, ale o tom zde hovořit nebudeme. Nás bude zajímat ten případ, kdy chceme též hledat mezi ostatními prvky (v ostatních sloupcích než v prvním), a k tomu právě slouží funkce, kterou si teď ukážeme.

Jak vidíte ze zdrojového kódu (doufám), pro přesné umístění textu je rozhodující parametr l, který určuje právě horizontální polohu. Proč odečítáme číslo jedna? To proto, aby text nebyl "nalepený" přímo na okraji rámečku. Ačkoliv zas tak hrozně to nevypadá, rozdíl je minimální. Důležité však je, že právě pomocí tohoto parametru l můžete dosáhnout libovolného vlastního umístění textu, například jej můžete vycentrovat a podobně. To již ponechám na vaší fantazii a potřebách.

Zarovnání prvků v ListBoxu na pravou stranu

Další z dnešních tipů bude opět vizuálního charakteru. Při běžné práci s komponentou typu ListBox jsou prvky zarovnány k levému okraji. Co když ale potřebujete jiné zarovnání, například na pravou stranu? I toho lze mírnou úpravou dosáhnout. Nejprve musíte změnit styl ListBoxu na typ lbOwnerDrawFixed. Tím pádem se o vykreslování již nestará systém automaticky, ale musíme mu trošku pomoci, a sice událostí OnDrawItem. Zde je tedy kód:
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
l: Integer;
t: String;
begin
with ListBox1 do
begin
Canvas.FillRect(Rect);
t := Items[Index];
l := Rect.Right - Canvas.TextWidth(t) - 1;
Canvas.TextOut(l, Rect.Top, t);
end;
end;

Kolik paměti využívá daný proces

Tento tip si sice můžete vyzkoušet pouze pod systémy NT/2000/XP (tedy vyzkoušet ho můžete pochopitelně i pod systémy 9x, ale fungovat to nebude), přesto se může hodit. Jak tedy zjistit, kolik paměti si pro svou činnost (nebo nečinnost) bere vaše aplikace? Použijeme k tomu opět funkce API a konkrétně knihovny psAPI. Samotný kód vypadá takto:
uses psAPI;

.
.
.

procedure TForm1.Button1Click(Sender: TObject);
var
pmc: PPROCESS_MEMORY_COUNTERS;
cb: Integer;
begin
cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
GetMem(pmc, cb);
pmc^.cb := cb;
if GetProcessMemoryInfo(GetCurrentProcess(), pmc, cb) then
ShowMessage(IntToStr(pmc^.WorkingSetSize) + ' Bytes')
else
ShowMessage('Nelze zjistit údaj o využití paměti');
FreeMem(pmc);
end;

Jméno procesoru

Opět jeden z velmi krátkých a jednoduchým tipů. Jméno procesoru si zjistíme velmi snadno ze systémového registru, proto nezapomeňte na použití knihovny Registry. Samotný kód je pouze jednoduché čtení údajů z registru, jak jsme jej používali již mnohokrát při podobných příležitostech, takže pro pravidelné čtenáře by možná stačilo uvést jen větev, kde se údaj nachází. Nicméně pro úplnost je zde celá funkce a použití:
uses Registry;
.
.
.

function CPUname: string;
var
Reg: TRegistry;
begin
CPUname := '';
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('\Hardware\Description\System\CentralProcessor\0', False) then
CPUname := Reg.ReadString('Identifier');
finally
Reg.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(CPUname);
end;

V naší ukázce

je pro názornost zvolena poněkud větší velikost fontu, což v opravdové aplikaci asi nepoužijeme. Jak vidíte, není problém použít tučné písmo či kurzívu (nebo obojí zároveň), takže si můžete vymyslet téměř libovolnou kombinaci. Když navíc změníte barvu samotné "bubliny", jak jsme se naučili hned v prvním dílu seriálu, dostane vaše aplikace velmi osobitý a netradiční vzhled. Je však dobré se vyvarovat počátečního nadšení a vždy volit vkusné a hlavně dobře čitelné kombinace. Tento tip totiž není ani tak o efektu (důležitá je funkčnost aplikace, i kdyby vypadala sebelépe), jako spíše o pomoci uživateli, neboť ne každý má tak dobré oči a je schopen běžnou bublinkovou nápovědu přečíst. Proto by asi bylo vhodné (pokud se rozhodnete tento tip použít) ponechat volbu parametrů textu spíše na uživateli samotném prostřednictvím nastavení.

Změna fontu bublinkové nápovědy

V našem seriálu už jsme si kdysi ukazovali, že lze celkem snadno změnit většinu parametrů bublinkové nápovědy (Hint), jako je barva podkladu či jednotlivé časové intervaly, kdy se nápověda objeví. Poněkud jsme však zapomněli na samotný text nápovědy, takže si dnes ukážeme, jak změnit jeho font a velikost. Vytvoříme si na to vlastní proceduru, kterou poté použijeme v události OnCreate hlavního formuláře (nebo formuláře, ve kterém budete tento "vylepšený" hint chtít použít). Zde je tedy příslušný kód:
type
TNasHint = class(THintWindow)
constructor Create(AOwner: TComponent); override;
end;

.
.
.

constructor TNasHint.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
with Canvas.Font do
begin
Name := 'Verdana';
Size := Size + 15;
Style := [fsBold, fsItalic];
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
HintWindowClass := TMyHintWindow;
end;

pokracujeme

procedure TForm1.LoadListViewToFile(AListView: TListView; sFileName: string);
var
F : TFileStream;
IdxItem, IdxSubItem, IdxImage : integer;
W, ItemCount, SubCount : word;
pText : PChar;
PTemp : PChar;
MySignature : array [0..2] of char;
sExeName : string;
begin
with AListView do
begin
ItemCount := 0;
SubCount := 0;
sExeName := ExtractFileName(sFileName);
if not FileExists(sFileName) then
begin
MessageBox(Handle, PChar(format(Msg1, [sExeName])), 'I/O Error', MB_ICONERROR);
Exit;
end;
F := TFileStream.Create(sFileName, fmOpenRead);
F.Read(MySignature, sizeof(MySignature));
if MySignature <> 'LVF' then
begin
MessageBox(Handle, PChar(format(Msg2, [sExeName])), 'I/O Error', MB_ICONERROR);
Exit;
end;
F.Read(ItemCount, sizeof(ItemCount));
Items.Clear;
for idxItem := 1 to ItemCount do
begin
with Items.Add do
begin
F.Read(SubCount, sizeof(SubCount));
F.Read(IdxImage, sizeof(IdxImage));
ImageIndex := IdxImage;
F.Read(w, SizeOf(w));
pText := StrAlloc(w + 1);
pTemp := StrAlloc(w + 1);
F.Read(pTemp^, W);
StrLCopy(pText, pTemp, W);
Caption := StrPas(pText);
StrDispose(pTemp);
StrDispose(pText);
if SubCount > 0 then
begin
for idxSubItem := 1 to SubCount do
begin
F.Read(w, SizeOf(w));
pText := StrAlloc(w + 1);
pTemp := StrAlloc(w + 1);
F.Read(pTemp^, W);
StrLCopy(pText, pTemp, W);
Items[idxItem - 1].SubItems.Add(StrPas(pText));
StrDispose(pTemp);
StrDispose(pText);
end;
end;
end;
end;
F.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SaveListViewToFile(ListView1, 'Data.sav');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
LoadListViewToFile(ListView1, 'Data.sav');
end;

const
Msg1 = 'Soubor "%s" neexistuje !';
Msg2 = '"%s" není soubor s ListView daty !';

procedure TForm1.SaveListViewToFile(AListView: TListView; sFileName: string);
var
idxItem, idxSub, IdxImage : integer;
F : TFileStream;
pText : PChar;
sText : string;
W, ItemCount, SubCount : word;
MySignature : array [0..2] of char;
begin
with AListView do
begin
ItemCount := 0;
SubCount := 0;
MySignature := 'LVF';
F := TFileStream.Create(sFileName, fmCreate or fmOpenWrite);
F.Write(MySignature, sizeof(MySignature));
if Items.Count = 0 then ItemCount := 0
else ItemCount := Items.Count;
F.Write(ItemCount, Sizeof(ItemCount));
if Items.Count > 0 then
begin
for idxItem := 1 to ItemCount do
begin
with items[idxItem - 1] do
begin
if SubItems.Count = 0 then SubCount := 0
else SubCount := Subitems.Count;
F.Write(SubCount, Sizeof(SubCount));
IdxImage := ImageIndex;
F.Write(IdxImage, Sizeof(IdxImage));
sText := Caption;
w := length(sText);
pText := StrAlloc(Length(sText) + 1);
StrPLCopy(pText, sText, Length(sText));
F.Write(w, sizeof(w));
F.Write(pText^, w);
StrDispose(pText);
if SubCount > 0 then
begin
for idxSub := 0 to SubItems.Count - 1 do
begin
sText := SubItems[idxSub];
w := length(sText);
pText := StrAlloc(Length(sText) + 1);
StrPLCopy(pText, sText, Length(sText));
F.Write(w, sizeof(w));
F.Write(pText^, w);
StrDispose(pText);
end;
end;
end;
end;
end;
F.Free;
end;
end;

Načtení a uložení dat z ListView do souboru

ListView (či TreeView) jsou dvě velmi oblíbené komponenty pro zobrazování dat, protože práce s nimi je poměrně jednoduchá a zobrazení dat přehledné. I když je naplňování ListView daty poměrně snadná záležitost, práci si můžeme velice zjednodušit tím, že je načteme ze souboru (a poté případně opět uložíme). Menší "problém" je ten, jak poznat, zda soubor obsahuje data pro náš ListView. To je v našem příkladě vyřešeno poněkud zjednodušeně tím, že si prostě do souboru uložíme vlastní "značku" (proměnná MySignature). Uznávám, že postup je poněkud primitivní, ale svůj účel splní. Pokud budeme ukládání do souboru používat interně v programu bez zásahu uživatele, pak bych v tom neviděl problém. Jestliže však bude moci přímo uživatel rozhodovat o tom, který soubor má být načten, bylo by dobré tuto kontrolu více propracovat, protože jako správný programátor(ka) musíme vždy počítat s tím, že uživatel je zlomyslný (nebo naivní) a bude se pokoušet načíst kde co.

Smazání souboru do koše

A zbývá nám už jen naučit se, jak soubor přesunout právě do koše. Zde je tedy příslušná funkce, která využívá pro změnu zase ShellApi.
function SmazDoKose(sFileName: string): Boolean;
var
fos: TSHFileOpStruct;
begin
FillChar(fos, SizeOf(fos), 0);
with fos do
begin
wFunc := FO_DELETE;
pFrom := PChar(sFileName);
fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT;
end;
Result := (0 = ShFileOperation(fos));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if SmazDoKose('c:\soubor.txt') then ShowMessage('Soubor přesunut do koše')
else ShowMessage('Došlo k chybě !');
end;

Vyprázdnění koše

Když už jsme se naučili, jak zjistit, zda je koš prázdný či ne, ukažme si teď postup, jak jej vyprázdnit a definitivně tak soubory smazat.
procedure TForm1.Button1Click(Sender: TObject);

const
SHERB_NOCONFIRMATION = $00000001;
SHERB_NOPROGRESSUI = $00000002;
SHERB_NOSOUND = $00000004;

type TSHEmptyRecycleBin = function(Wnd: HWND; LPCTSTR: PChar; DWord: Word): Integer; stdcall;

var
SHEmptyRecycleBin : TSHEmptyRecycleBin;
LibHandle : THandle;

begin
LibHandle := LoadLibrary(PChar('Shell32.dll'));
if LibHandle <> 0 then @SHEmptyRecycleBin := GetProcAddress(LibHandle, 'SHEmptyRecycleBinA')
else
begin
ShowMessage('Chyba při přístupu ke knihovně Shell32.dll');
Exit;
end;
if @SHEmptyRecycleBin <> nil then
begin
SHEmptyRecycleBin(Application.Handle, '', SHERB_NOCONFIRMATION or SHERB_NOPROGRESSUI or SHERB_NOSOUND);
ShowMessage('Koš vysypán!');
end;
FreeLibrary(LibHandle);
@SHEmptyRecycleBin := nil;
end;

uses Activex, ShlObj, ComObj;
.
.
.

function KosJePrazdny : Boolean;
const
CLSID_IRecycleBin: TGUID = (D1: $645FF040; D2: $5081; D3: $101B; D4: ($9F, $08, $00, $AA, $00, $2F, $95, $4E));
var
EnumIDList : IEnumIDList;
FileItemIDList : PItemIDList;
ItemCount : ULONG;
RecycleBin : IShellFolder;
begin
CoInitialize(nil);
OleCheck(CoCreateInstance(CLSID_IRecycleBin, nil, CLSCTX_INPROC_SERVER or
CLSCTX_LOCAL_SERVER, IID_IShellFolder, RecycleBin));
RecycleBin.EnumObjects(0,
SHCONTF_FOLDERS or
SHCONTF_NONFOLDERS or
SHCONTF_INCLUDEHIDDEN,
EnumIDList);
Result := EnumIDList.Next(1, FileItemIDList, ItemCount) <> NOERROR;
CoUninitialize;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if KosJePrazdny then ShowMessage('Koš je prázdný.')
else ShowMessage('Koš obsahuje smazaná data.');

Zjištění, zda je koš prázdný

"Koš", či chcete-li "Recycle Bin", je pro některé uživatele jistě užitečná pomůcka v případě, že se jim "povede" vymazat z disku něco, co nechtěli. My se teď naučíme zjistit, zda je koš prázdný nebo ne, což se nám může v mnoha případech hodit. Poslouží nám k tomu následující funkce, která vrací True nebo False (prázdný nebo plný koš), a využijeme k tomu knihoven Activex, ShlObj a ComObj.