Dneska tu máme opět všehochuť různých tipů. Ukážeme si, jak pískat přes PC speaker, jak zjistit sériové číslo disku, a na závěr si ukážeme, jak přidat stíny k vizuálním komponentám.
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;
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čí.
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.
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;
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.
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;
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í.
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.
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;