Přidání položky

do seznamu naposledy otevřených dokumentů
V menu Start jste si jistě všimli nabídky Dokumenty, která obsahuje kromě odkazu na složku Dokumenty na disku též seznam několika naposledy použitých dokumentů z různých aplikací. Přidávají je sem různé (například textové) editory, takže pokud má vaše aplikace podobné zaměření (na editování čehokoliv), naučíme se, jak do tohoto seznamu přidat položku. Budou k tomu potřeba knihovny ShellAPI a ShlOBJ a samotný kód je již velice krátký:
procedure PridatPolozku(soubor:string);
begin
SHAddToRecentDocs(SHARD_PATH, PChar(soubor));
end;

Poslední věcí,

kterou by bylo vhodné doplnit, je nějakým způsobem indikovat a zobrazit jednak sloupec, podle kterého jsou data setříděna, a pak také směr třídění (vzestupné či sestupné), aby měl uživatel na první pohled jasno. S indikací si nemusíme lámat hlavu, protože tyto informace máme uloženy v proměnných ze sekce Private. Zbývá nám jen tyto informace nějak zobrazit. Jak jistě víte, obvykle se k tomu využívá malá ikonka zobrazená v hlavičce příslušného sloupce, podle kterého jsou data zrovna setříděna. Ikonkou bývá většinou šipka směřující dolu či nahoru podle směru setřídění. Toto grafické vylepšení však již doufám každý zvládne sám. Všechny parametry o aktuálním stavu třídění znáte a změna ikony se provádí běžným způsobem ve vlastnostech daného ListView.

Všimněte si též parametru SortType v první proceduře. Ten určuje, zda a jakým způsobem budou data tříděna, a může se vyskytovat ve čtyřech variantách:
• stNone - položky tříděny nejsou
• stData - položky jsou tříděny podle vlastnosti Data u TListItem objektů
• stText - položky jsou tříděny podle názvu (Caption) daných TListItem objektů
stBoth - kombinace obou předchozích variant

private

{ Private declarations }
Descending: Boolean;
SortedColumn: Integer;


procedure TForm1.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
TListView(Sender).SortType := stNone;
if Column.Index <> SortedColumn then
begin
SortedColumn := Column.Index;
Descending := False;
end
else
Descending := not Descending;
TListView(Sender).SortType := stText;
end;

procedure TForm1.ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
begin
if SortedColumn = 0 then Compare := CompareText(Item1.Caption, Item2.Caption)
else if SortedColumn > 0 then Compare := CompareText(Item1.SubItems[SortedColumn-1], Item2.SubItems[SortedColumn-1]);
if Descending then Compare := -Compare;
end;

Nejprve si na formulář umístěte ListView a vhodně jej naplňte vašimi položkami. Na počtu sloupců nezáleží (pochopitelně že musíte mít alespoň jeden), ale je třeba, aby byl zvolen typ zobrazení jako vsReport.
Nyní jen přidejte do událostí OnColumnClick a OnCompare následující kódy a je též třeba nadefinovat dvě globální proměnné. Jedna slouží k hlídání "směru" třídění, druhá zase určuje sloupec, podle něhož jsou data právě setříděna.

Třídění položek v ListView

Pokud často používáte k zobrazování dat různé tabulky či seznamy v podobě ListView, jistě se vám bude hodit následující tip. Pokud použijete ListView bez dalších dodatečných úprav, klikáním na hlavičky jednotlivých sloupců (v případě, že máte zvolen typ zobrazení vsReport) se nestane nic. Mnohem užitečnější a také častěji používaná varianta je ta, že se po kliknutí na danou hlavičku položky setřídí podle zvoleného sloupce, a to buď vzestupně (po prvním kliknutí), nebo sestupně (po následujícím kliknutí). A přesně toto vylepšení si teď ukážeme.

A nyní již naše ukázka:

Procedure Stin(f: TForm; c: TControl; Width: Integer; Color: TColor);
var
rect: TRect;
old: TColor;
Begin
rect := c.boundsrect;
rect.Left := rect.Left + width;
rect.Top := rect.Top + width;
rect.Right := rect.Right + width;
rect.Bottom := rect.Bottom + width;
old := f.canvas.brush.color;
f.canvas.brush.Color := color;
f.canvas.fillrect(rect);
f.canvas.brush.Color := old;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
i: Integer;
begin
for i:=0 to Self.ControlCount-1 do Stin(self,Self.Controls[i],3,clblack);
end;

V naší ukázce

je pro názornost opatřena stínem každá komponenta, ale samozřejmě máte v rámci parametrů funkce možnost si vybrat přímo konkrétní komponentu. Samotný kód je vhodné umístit do události OnPaint daného formuláře, čímž si zajistíte automatické překreslování.
Parametry funkce jsou velice jednoduché - formulář, komponenta pro kterou je stín použit, tloušťka stínu a konečně barva stínu.

Stíny vizuálních komponent

Na závěr tu mám opět jeden vizuální trik. Přidáním následujícího kódu dosáhneme toho, že ke zvoleným komponentám bude přidán stín požadované tloušťky a barvy. Je nutné poznamenat několik drobností. Jednak si musíte dobře rozmyslet, pro které komponenty tento efekt použijete, protože ne vždy to vypadá dobře. Zároveň je třeba zvolit decentní tloušťku i barvu, ale to vám snad nemusím připomínat. Vše opět záleží na celkovém rázu vaší aplikace. A poslední věc, na kterou je třeba upozornit, je nutnost ohlídat si překreslování, protože jinak se například po obnovení aplikace z minimalizovaného stavu všechny stíny ztratí.

Sériové číslo disku

A teď zase z jiného soudku, ukážeme si, jak zjistit sériové číslo pevného disku (přesněji konkrétní partition) či disku CD. To je informace, která se dá použít na různé účely, ať informační či bezpečnostní. Parametrem funkce je pouze písmeno požadovaného disku (dvojtečka s lomítkem se přidá sama). Jako menší "bonus" funkce vrací též jmenovku (label) disku. Zde je tedy kód funkce včetně použití:
function GetHardDiskSerial(const DriveLetter: char): string;
var
NotUsed : dWord;
VolumeFlags : dWord;
VolumeInfo : array[0..MAX_PATH] of char;
VolumeSerialNumber: dWord;
begin
GetVolumeInformation(PChar(DriveLetter + ':\'), VolumeInfo, SizeOf(VolumeInfo), @VolumeSerialNumber, NotUsed, VolumeFlags, nil, 0);
result := Format('Label = %s VolSer = %8.8X', [VolumeInfo, VolumeSerialNumber]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetHardDiskSerial('c'));
end;

procedure Delay(MSecs: Integer);
var
FirstTickCount : LongInt;
begin
FirstTickCount:=GetTickCount;
repeat
SleepEX(1, false);
until ((GetTickCount-FirstTickCount) >= LongInt(MSecs));
end;

begin
DoSound(aFreq);
Delay(aDelay);
end;

procedure NoSound;
var
Value: Word;
begin
Value := GetPort($61) and $FC;
SetPort($61, Value);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
Sound(500,100);
Sound(700,100);
Sound(900,100);
NoSound;
end;
Pro úplnost dodávám, že příklad by měl fungovat pod Windows 9x.

Jako ukázka

použití je na samém závěru opět obsluha události tlačítka, která udělá jednoduché trojité pípnutí.
procedure SetPort(address, Value:Word);
var
bValue: byte;
begin
bValue := trunc(Value and 255);
asm
mov dx, address
mov al, bValue
out dx, al
end;
end;

function GetPort(address:word):word;
var
bValue: byte;
begin
asm
mov dx, address
in al, dx
mov bValue, al
end;
GetPort := bValue;
end;

Procedure Sound(aFreq, aDelay : integer);

procedure DoSound(Freq : Word);
var
B : Byte;
begin
if Freq > 18 then
begin
Freq := Word(1193181 div LongInt(Freq));
B := Byte(GetPort($61));

if (B and 3) = 0 then
begin
SetPort($61, Word(B or 3));
SetPort($43, $B6);
end;

SetPort($42, Freq);
SetPort($42, Freq shr 8);
end;
end;

Zdrojový kód

je poněkud delší než obvykle, protože příklad obsahuje nejen samotnou proceduru na vytvoření zvuku dané frekvence, ale také pauzu (delay), o které sice už v našem seriálu byla řeč, ale pro úplnost příkladu je zde funkce uvedena znovu. A samozřejmě je součástí příkladu též funkce na vypnutí zvuku (nosound), bez níž by speaker "pískal" stále a nezbývalo by vám, než počítač restartovat. Většina z vás možná bude znát použití těchto funkcí z klasického Turbo (Borland) Pascalu. V naší je ukázce je menší změna v tom, že se Delay nepoužívá zvlášť, ale je to interní součást procedury Sound a pauza je tím pádem jejím druhým parametrem.

Tvorba zvuků přes PC speaker

Když už jsme u toho "pípání", naučíme se tvořit zvuky přes PC speaker. Myslíte, že už je to dnes v době zvukových karet zastaralé a zbytečné? Možná, ale pro jednoduché ozvučení vaší aplikace se to může hodit, protože PC speaker má jednu nespornou výhodu oproti zvukové kartě. Je totiž v počítači vždy (tedy téměř) což se o zvukové kartě říci nedá.
Žádnou extra hudbu sice ze speakeru nevyčarujete, ale pro různé zvuky, které mají uživatele na něco upozornit či varovat to plně postačí.

Povolení a zakázání systémového pípnutí

Systémové pípnutí (beep) slouží k upozornění systému či aplikací na různé události. Pokud budete chtít toto "pípání" zakázat, slouží k tomu následující funkce.
procedure TForm1.Button18Click(Sender: TObject);
begin
SystemParametersInfo(SPI_SETBEEP,0,NIL,SPIF_SENDWININICHANGE);
end;
A touto funkcí vše opět vrátíme do původního stavu.
procedure TForm1.Button19Click(Sender: TObject);
begin
SystemParametersInfo(SPI_SETBEEP,1,NIL,SPIF_SENDWININICHANGE);
end;

Nejdůležitějším parametrem

je hned ten první, neboť určuje, který systémový zvuk bude přehrán. V naší ukázce je to zvuk startu systému. V následující tabulce můžete najít některé další možné parametry s krátkým popisem (najít se dají v systémovém registru pod HKEY_CURRENT_USER\AppEvents\EventLabels)
AppGPFault chyba programu
Close konec programu
CriticalBatteryAlarm upozornění při kritickém stavu baterie
EmptyRecycleBin vysypání koše
MailBeep oznámení o nové poště
Maximize maximalizace
MenuCommand příkaz z nabídky
MenuPopup stažení nabídky
Minimize minimalizace
Navigating začátek navigace
Open spuštění programu
RestoreDown obnovení z maxima
RestoreUp obnovení z minima
SystemAsterisk hvězdička
SystemExclamation výkřik
SystemExit konec Windows
SystemHand kritické zastavení
SystemQuestion otázka
SystemStart spuštění Windows
A to je pro dnešek všechno. Příště opět nebude jednotné téma, takže budeme v tomto mixu různých tipů pokračovat.

Přehrávání systémových zvuků

A na závěr tu máme opět snad o něco užitečnější tip, než byl ten předchozí. Ukážeme si, jak se dají přehrávat rozličné systémové zvuky, které všichni dobře známe. I zde využijeme knihovny MMSystem a celý kód vypadá velmi jednoduše:
procedure TForm1.Button1Click(Sender: TObject);
begin
PlaySound('SystemStart', 0, SND_APPLICATION or SND_NODEFAULT or SND_ASYNC or SND_NOWAIT);
end;

Detekce zvukové karty

Dříve tomu sice tak nebývalo, ale dnes má asi zvukovou kartu opravdu již téměř každý, obzvlášť když je dnes již běžně integrována na deskách. Přesto se může někdy hodit detekce, zda se přece jen v systému nachází. Zvuková karta asi není v naší ukázce přesný pojem, protože se jedná spíše o "WaveOut" zařízení a například na mém systému se tak tváří i VoiceModem, ale pro hrubou orientaci to postačí. Ještě dodávám, že je třeba použít knihovny MMSystem.
procedure TForm1.Button1Click(Sender: TObject);
begin
if WaveOutGetNumDevs > 0 then ShowMessage('Zvukovka je přítomna')
else ShowMessage('Zvukovka není přítomna');
end;

A když už jsme narazili

na téma klávesnice, ukážeme si ještě, jak se lze mezi jednotlivými klávesnicemi přepínat. Kratičký kód, který teď uvedu, způsobí, že dojde k přepnutí na následující klávesnici. V tom případě, že máte nainstalovány pro českého uživatele běžné dvě klávesnice (českou a anglickou), dojde při opětovném volání této funkce k opětovnému přepnutí na původní klávesnici, takže se vlastně klávesnice cyklicky střídají.
procedure TForm1.Button1Click(Sender: TObject);
begin
ActivateKeyboardLayout(HKL_NEXT, 0);
end;
A pro úplnost ještě dodávám, že změnou parametru na HKL_PREV přepneme na předchozí klávesnici, což sice v případě dvou nainstalovaných klávesnic bude vypadat stejně jako první příklad, ale využití se při větším počtu klávesnic může hodit.

Zjištění a přepínání aktuální klávesnice

Pokud vytváříte nějaký jednoduchý textový editor, můžete například na stavovém řádku informovat uživatele o právě aktuální klávesnici. Na to nám poslouží následující ukázka, která vrací jako textový řetězec označení aktuální klávesnice (např. "Cz" nebo "En" a podobně).
procedure TForm1.Button1Click(Sender: TObject);
var Klv: array[0..2] of Char;
begin
GetLocaleInfo(LOWORD(GetKeyboardLayout(0)), LOCALE_SENGLANGUAGE, Klv, 2);
ShowMessage(Klv);
end;