html

Práce s INI soubory

2011-06-20T05:53:00.001-07:00

Práce s INI soubory

2011-05-25T23:56:00.000-07:00

Jistě mi dáte za pravdu, že každá i jen malinko rozsáhlejší aplikace tu a tam potřebuje uložit nějaká data na disk. Typicky to mohou být různá uživatelská nastavení, stavové informace o programu (jako je poloha okna, naposledy otevřený adresář atd..) a řada dalších informací nutných pro běh aplikace. S příchodem Windows 95 se zpočátku s nadšením upustilo od INI souborů, ve kterých byly podobné informace uloženy, a všichni se vrhli na registry. Logickým argumentem bylo kromě jiného i to, že v dobách starých Windows se v jejich adresáři často hromadilo velké množství nepotřebných INI souborů od již dávno odinstalovaných aplikací. Bohužel se brzy zjistilo, že se tento problém se zapomenutými či špatně odinstalovanými daty přechodem na registry moc neodstranil, pouze se přesunul na jiné místo a přeplněné a nepřehledné registry máme v našich systémech zřejmě všichni.
Proto si myslím, že není třeba INI soubory ještě zcela zatracovat. Ukážeme si, co nám mohou pro pohodlnou práci s nimi nabídnout Delphi. Všechny důležité funkce se skrývají v knihovně IniFiles, takže ji přidejte do projektu. Nevím, jestli to není zbytečné, ale možná bychom se měli nejprve přece jen alespoň krátce zmínit, jak takový INI soubor vlastně vypadá. Jedná se o obyčejný textový soubor, a když si nějaký prohlédnete, zjistíte, že je rozdělen na určité sekce. Každá je označena svým názvem uvedeným v hranatých závorkách. Těsně za tímto názvem sekce následují jednotlivé řádky, kde je vždy uveden název parametru a za rovnítkem jeho hodnota. Formát je to tedy velmi jednoduchý, přehledný a snadno (i ručně) editovatelný.

2011-05-09T00:47:00.000-07:00

Až si budete s těmito parametry hrát, jistě brzy zjistíte, že tento efekt sice může vypadat velmi zajímavě a hezky, ale někdy je problém s čitelností textu na takto poloprůhledném okně, neboť prosvítající podklad může vytvářet menší chaos, pokud obsahuje například text se stejným fontem a stejnou barvou podkladu. Je proto nutné šikovně zvolit úroveň průhlednosti a také barvy jednotlivých prvků na takovémto okně s ohledem na podklad. Rozhodně by nebylo příliš moudré využít této vlastnosti například pro okno textového editoru, protože prosvítající podklad by mohl dost značně zkomplikovat čitelnost textu. Naproti tomu je tato vlastnost ideální k vytvoření různých "About..." boxů a přímo dokonale se hodí k vytvoření "Spash screen". Možná znáte oblíbený grafický benchmark 3D Mark, který po svém spuštění zobrazí obvyklý splashscreen, navíc s efektem postupného objevování. Přesně tento efekt si můžete vytvořit ve svých aplikacích také, právě s využitím průhlednosti okna. Jak vytvořit splashscreen jsme si již v našem seriálu říkali a efekt postupného objevování či mizení vytvoříte snadno tím, že budete postupně měnit hodnotu vlastnosti AlphaBlendValue, protože je to vlastnost, která se dá pochopitelně měnit přímo za běhu aplikace. Tohoto efektu se dá využít prakticky u všech oken aplikace, jenom je třeba si dát pozor, aby ono objevování či mizení netrvalo příliš dlouho a nezdržovalo.
A dostáváme se k vlastnostem TransparentColor a TransparentColorValue. První z nich je opět logická proměnná nabývající hodnot True nebo False. Zapíná nebo vypíná průhlednost barvy, kterou definuje vlastnost TransparentColorValue. Budete-li tedy chtít, aby nějaká konkrétní barva nebyla vůbec vidět, tedy přesněji řečeno byla průhledná a místo ní se zobrazovalo pozadí okna (to, co je pod oknem), tímto parametrem toho dosáhnete. Snadno tak můžete vytvořit na formuláři "díry", i když v tomto případě mě nenapadá nějaké rozumné využití.
Co říci na závěr? Že každá legrace něco stojí. V tomto případě je to výkon počítače. Pokud totiž máte zastaralejší hardware, nemusí být překreslování těchto poloprůhledných oken právě nejrychlejší, obzvlášť pokud máte zapnutou vlastnost "Zobrazovat obsah okna během přetahování". Další nevýhodou je to, že tento efekt bude viditelný pouze ve Windows 2000 a XP, ale na druhou stranu si nemusíte dělat starosti s nefunkčností aplikace pod staršími Windows 9x, protože zde bude váš program bez problémů také pracovat. Pouze bude ignorována vlastnost průhlednosti oken a ta budou zobrazena standardním způsobem. A poslední problém? Nutnost mít Delphi 6 (tedy šlo by to i bez nich, ale složitějším způsobem než pouhým nastavováním vlastností v Object Inspectoru), verzi Personal si však můžete zdarma stáhnout přímo od Borlandu.

Tipy a triky v Delphi

2011-03-08T07:36:00.000-08:00

Prvním tématem dnešního dílu bude práce s průhledností oken pod Delphi 6 a poté se poněkud obsáhleji zaměříme na použití INI souborů.
Průhlednost oken v Delphi 6
Moderní operační systémy se snaží nejen dobře fungovat, což se předpokládá jako samozřejmost (škoda, že tomu tak ne vždy je), ale snaží se též zaujmout svým vzhledem. Proto se i v nejnovější verzi Windows, tedy Windows XP, objevily vizuální styly. Kromě tohoto na první pohled viditelného rozdílu však Windows (a to dokonce už ve verzi 2000) obsahují ještě jeden zajímavý vizuální prvek, který se však v programech přesto příliš neobjevuje. Tímto prvkem je průhlednost oken. Od nové verze Delphi 6 se tato vlastnost oken již objevila v seznamu parametrů v Object Inspectoru, takže použití bude hračka.
O průhlednost okna, či přesněji řečeno průsvitnost, se starají 4 základní vlastnosti okna. Jsou to vlastnosti AlphaBlend, AlphaBlendValue, TransparentColor a TransparentColorValue. Hned si objasníme, co která vlastnost znamená, i když z názvů je to docela patrné.
AlphaBlend může nabývat hodnot True nebo False a určuje, zda chceme či nechceme průhlednost oken používat. Až tedy budete experimentovat, musíte nastavit hodnotu True, jinak se pochopitelně nedostanete dál. Když tímto způsobem průhlednost povolíme, druhý parametr AlphaBlendValue určuje číselnou hodnotu průhlednosti. Může nabývat hodnot od 0 do 255, přičemž 0 znamená zcela průhledné okno, zatímco 255 je přesný opak, tedy okno zcela neprůhledné (standardní).

Zmizení kurzoru myši

2011-02-09T05:42:00.000-08:00

Velice krátký a jednoduchý tip. Zmizení kurzoru myši docílíme takto:
ShowCursor(false);
a jeho opětovné zobrazení celkem logicky takto:
ShowCursor(true);
Je třeba něco dodávat ? Myslím, že určitě ne. Využití tohoto tipu nechám na vás.
Kopírování souboru se zobrazením průběhu
Chcete si vytvořit vlastní souborový manažer ? Pak se vám možná bude hodit tento tip, ve kterém si ukážeme kopírování souborů s ukazatelem průběhu celé akce. O stupínek výš bychom se s naším příkladem dostali, pokud by kopírování probíhalo v samostatném vlákně na pozadí, ale to poněkud přesahuje prostorové možnosti tohoto dílu seriálu. Takže nám opět pomůže obvyklé Application.ProcessMessages, aby nedošlo k "zamrznutí" aplikace po dobu kopírování.
procedure CopyFileWithProgressBar(Source, Destination : string);
var
FromF,
ToF : file of byte;
Buffer : array[0..4096] of char;
NumRead : integer;
FileLength : longint;
begin
AssignFile(FromF,Source);
reset(FromF);
AssignFile(ToF,Destination);
rewrite(ToF);
FileLength:=FileSize(FromF);
with Form1.Progressbar1 do
begin
Min := 0;
Max := FileLength;
while FileLength > 0 do
begin
BlockRead(FromF,Buffer[0],SizeOf(Buffer),NumRead);
FileLength := FileLength - NumRead;
BlockWrite(ToF,Buffer[0],NumRead);
Position := Position + NumRead;
Application.ProcessMessages;
end;
CloseFile(FromF);
CloseFile(ToF);
end;
end;

procedure TForm1.Button16Click(Sender: TObject);
begin
CopyFileWithProgressBar('c:\zdroj.exe','c:\cíl.exe');
end;
Jak vidíte, princip je velmi jednoduchý a snadno pochopitelný. Samozřejmě je nutné, aby byla formuláři umístěna komponenta ProgressBar.

Zobrazení vlastností komponent

2010-10-26T04:25:00.000-07:00

Tento příklad zřejmě nevyužijete v reálných aplikacích či přesněji řečeno, nejedná o funkci, kterou by uživatelé vašich aplikací na první pohled mohli ocenit. Ukážeme si, jak jednoduchým způsobem zjišťovat za běhu aplikace vlastnosti všech komponent, které obsahuje. Může to být neocenitelná pomoc při ladění aplikace při fázi vývoje, při logování chyb v případě pádu aplikace a podobně.
Umístěte si na formulář komponentu Memo, do které budeme v naší ukázce vlastnosti komponent vypisovat. Poté můžete na formulář umístit libovolné další komponenty, na kterých si ověříte funkčnost našeho příkladu.
procedure ListComponentProperties(Component: TComponent; Strings: TStrings);
var
Count, Size, I: Integer;
List: PPropList;
PropInfo: PPropInfo;
PropOrEvent, PropValue: string;
begin
Count := GetPropList(Component.ClassInfo, tkAny, nil);
Size := Count * SizeOf(Pointer);
GetMem(List, Size);
try
Count := GetPropList(Component.ClassInfo, tkAny, List);
for I := 0 to Count - 1 do
begin
PropInfo := List^[I];
if PropInfo^.PropType^.Kind in tkMethods then
PropOrEvent := 'Event'
else
PropOrEvent := 'Property';
PropValue := VarToStr(GetPropValue(Component, PropInfo^.Name));
Strings.Add(Format('[%s] %s: %s = %s', [PropOrEvent, PropInfo^.Name,
PropInfo^.PropType^.Name, PropValue]));
end;
finally
FreeMem(List);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.BeginUpdate;
Memo1.Lines.Clear;
ListComponentProperties(Button1, Memo1.Lines);
Memo1.Lines.EndUpdate;
end;
Nejdůležitějším parametrem je pochopitelně komponenta, jejíž vlastnosti chceme zjistit (v naší ukázce je to Button1).

tipy a triky

2010-06-07T02:33:00.000-07:00

Ako zmeniť názov okna IE a OE ??
Nájdite kľúč [HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main],
vytvorte premennú WindowTitle typu STRING a ako hodnotu zadajte požadovaný názov okna.
Pokiaľ ide o Outlook Express, vyhľadajte kľúč
[HKEY_CURRENT_USER\Identities\{** Identity ID **}\Software\Microsoft\Outlook Express\5.0].
Obdobne vytvorte premennú s názvom Window Title typu STRING.

tipy a triky

2010-05-25T01:52:00.000-07:00

Ako zmeniť štartovaciu stránku Outlook Expressu?
Riešení sa ponúka niekoľko, najjednoduchším je urobenie malej zmeny v kľúči
[HKEY_CURRENT_USER\Identities\[Identity]\Software\Microsoft\Outlook Express\5.0].
Vytvorte premennú typu STRING s názvom FrontPagePath.
Hodnotou premennej bude požadovaná adresa (napr. www.zive.sk).

tipy a triky

2010-05-19T04:09:00.000-07:00

Zmena umiestnenia adresára, kde sa budú ukladať všetky prijaté súbory v OExpress
Vyhľadajte kľúč [HKEY_CURRENT_USER\Software\Microsoft\Outlook Express].
Zmeňte hodnotu premennej Store Root na požadovanú cestu.
Uistite sa, že zadaná cesta naozaj existuje.
Niektoré verzie programu Outlook Express totiž požadovaný adresár nevytvoria.

rady v outlook express

2010-05-11T04:21:00.000-07:00

Máte strach, že by nejaká nepovolaná osoba mohla zmeniť nastavenia vášho konta
v programe Outlook Express?
Jednoducho zakážte vykonávanie zmien zmenou v registroch.
Vyhľadajte kľúč [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Outlook Express].
Stačí už len vytvoriť premennú typu DWORD s názvom
No Modify Accts (vrátane medzier a dvoma c v slove Accts).
Nastavte hodnotu na 1 alebo 0 podľa toho, či chcete zakázať,
resp. povoliť užívateľom robiť zmeny v nastavení konta.

Splash screen

2010-05-10T00:13:00.001-07:00

Ak vám vadí, že pri každom štarte Outlook Expresu musíte trpieť
zobrazenie tzv. Splash Screen, nasledujúci trik vám ho pomôže ľahko odstrániť.
Ak používate Outlook 4 a staršie verzie, zmenu treba vykonať v kľúči
[HKEY_CURRENT_USER\Software\Microsoft\Outlook Express].
V novších verziách treba vyhľadať kľúč
[HKEY_CURRENT_USER\Identities\{** Identity ID **}\Software\Microsoft\Outlook Express\5.0].
V oboch prípadoch je ďalší postup rovnaký.
Vytvorte premennú s názvom NoSplash typu DWORD a nastavte jej hodnotu na 1.

outlook express

2010-05-07T06:21:00.000-07:00

Odstránenie MSN Messengera z Outlook Express
V kľúči [HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Outlook Express] pridajte premennú typu DWORD s názvom Hide Messenger a nastavte jej hodnotu na 2

Počítačová encyklopedie

2010-05-06T00:11:00.000-07:00

ako vypnúť odkaz na inštaláciu Macromedia Flash a jemu podobných programov??
Možností je opäť viacero, podľa mňa najrýchlejšou bude táto (pokiaľ používate Internet Explorer 6):

V IE choďte do Tools – Internet Options – kliknite na záložku Security,
nastavte Custom level a zakážte možnosť „Download signed ActiveX controls...“.
Dajte však pozor, aby aj ostatné položky boli zakázané.
Potom kliknite na záložku Advanced a zakážte položku „Install on demand“ a máte po probléme.

ako upravovať (pridávať, odoberať) tlačidlá na Paneli nástrojov.

2010-05-04T23:47:00.000-07:00

Ak napríklad chcete odstrániť tlačidlo GO, vyhľadajte kľúč
[HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main]
a vytvorte hodnotu typu STRING s názvom ShowGoButton.
Nastavte jeho hodnotu na No a tlačidlo zmizne.
Obdobne sa dá manipulovať aj s ostatnými tlačidlami.
Stačí vytvoriť hodnotu s názvom Show(anglický ekvivalent názvu tlačidla,
napr. Print, Home atď.)Button.
Existuje však aj ďalší spôsob, ako dôjdete k tomu istému cieľu.
Vyhľadajte kľúč
[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer].
Vytvorte hodnotu typu DWORD s názvom SpecifyDefaultButtons a nastavte ju na 1.
Tým povolíte odstraňovanie a pridávanie jednotlivých tlačidiel na Paneli nástrojov.
Podľa nasledujúceho zoznamu vytvorte premenné typu DWORD.
Ich nastavenie na hodnotu 2 spôsobí ich odstránenie z panela.
Ak chcete tlačidlo na panel pridať, nastavte hodnotu na 1.
Rovnaký efekt dosiahnete aj vymazaním premennej z aktívneho kľúča.

Zoznam premenných:
* Btn_Back
* Btn_Forward
* Btn_Stop
* Btn_Refresh
* Btn_Home
* Btn_Search
* Btn_Folders
* Btn_Favorites
* Btn_Media
* Btn_History
* Btn_Fullscreen
* Btn_Tools
* Btn_MailNews
* Btn_Size
* Btn_Print
* Btn_Edit
* Btn_Discussions
* Btn_Cut
* Btn_Copy
* Btn_Paste
* Btn_Encoding
* Btn_PrintPreview

Tipy a triky v Delphi

2010-05-02T09:30:00.000-07:00

Ale pojďme k naší ukázce. Jelikož budeme používat registry, přidejte si do projektu knihovnu Registry. Dále si přidejte na formulář ListView a nastavte jeho styl na vsReport. Právě do tohoto ListView si do dvou sloupců vypíšeme názvy příslušných nainstalovaných aplikací a jejich odinstalační řetězec. Tvorba hlavičky ListView je vyřešena přímo v programu, takže po přidání komponenty na formulář a nastavení jejího zobrazovacího stylu (ačkoliv i to bychom mohli přidat přímo do programu) se již o víc nemusíte starat. Na závěr po načtení celého seznamu bude ještě pro přehlednost setříděn podle abecedy.
procedure TForm1.Button1Click(Sender: TObject);
const
UNINST_PATH = 'Software\Microsoft\Windows\CurrentVersion\Uninstall';
var
Reg : TRegistry;
SubKey: TSTringList;
ListItem: TListItem;
I : Integer;
sDisplayName, sUninstallString : String;
begin
with ListView1 do begin
Columns.Add;
Columns.Add;
Columns[0].Caption := 'Jméno';
Columns[1].Caption := 'Odinstalační řetězec';
Columns[0].Width := 200;
Columns[1].Width := 300;
end;
Reg := TRegistry.Create;
try
With ListView1.Items do
try
BeginUpdate;
Clear;
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKeyReadOnly(UNINST_PATH) then begin
SubKey := TStringList.Create;
try
Reg.GetKeyNames(SubKey);
Reg.CloseKey;
for i := 0 to subKey.Count - 1 do
if Reg.OpenKeyReadOnly(Format('%s\%s', [UNINST_PATH, SubKey[i]]))
then begin
try
sDisplayName := Reg.ReadString('DisplayName');
sUninstallString := Reg.ReadString('UninstallString');
if (sDisplayName) <> '' then begin
ListItem := Add;
ListItem.Caption := sDisplayName;
ListItem.SubItems.Add(sUninstallString);
end;
finally
Reg.CloseKey;
end;
end;
finally
SubKey.Free;
end;
end;
finally
ListView1.AlphaSort;
EndUpdate;
end;
finally
Reg.CloseKey;
reg.Free;
end;
end;

A máme tu další díl našeho seriálu. Dnes se bude opět jednat o sprchu drobných, ale doufám že užitečných tipů. Předvedeme si, jak umístit vlastní tlačítko do nástrojové lišty Internet Exploreru, jak zobrazit HTML kód v komponentě WebBrowser, mizet kurzor myši a další tipy. Vzhůru do čtení.
Přidání vlastního tlačítka do panelu nástrojů v IE
Možná znáte různé programy, které se snaží vylepšit a rozšířit funkce Internet Exploreru. Oblíbenou módou zejména různých vyhledávačů (a to i českých) je vnutit svým uživatelům drobné utility, které například rozšíří nástrojový panel IE o vyhledávací políčko daného vyhledávače nebo umožní například odeslat zprávu SMS. Ponechme teď stranou, jak užitečné či neužitečné podobné prográmky jsou a zkusme si něco obdobného. Ukážeme si, jak přidat do panelu nástrojů vlastní tlačítko, které spustí námi definovanou aplikaci. Zároveň se do menu Nástroje přidá další položka se stejnou funkcí.
Celé je to vlastně velmi jednoduché a je to opět záležitost systémového registru, kam do příslušné větve IE vložíme náš záznam. Zdrojový kód tedy může vypadat například takto:
procedure TlacitkoIE(Path: string);
const
Tagit = '\{10954C80-4F0F-11d3-B17C-00C0DFE39736}\';
var
Reg: TRegistry;
Vetev: string;
begin
Reg := TRegistry.Create;
try
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
Vetev := 'Software\Microsoft\Internet Explorer\Extensions' + Tagit;
OpenKey(Vetev, True);
WriteString('ButtonText', 'Text tlačítka');
WriteString('MenuText', 'Název položky v menu');
WriteString('MenuStatusBar', 'Run Script');
WriteString('ClSid', '{1FBA04EE-3024-11d2-8F1F-0000F87ABD16}');
WriteString('Default Visible', 'Yes');
WriteString('Exec', Path);
WriteString('HotIcon', ',4');
WriteString('Icon', ',4');
end
finally
Reg.CloseKey;
Reg.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
TlacitkoIE('c:\windows\calc.exe');
end;
Náš příklad přidá do nástrojové lišty tlačítko s nadpisem Text tlačítka a přidá do menu položku Název položky v menu. Pokud se vám na lištu tlačítko nepřidá, budete ho muset přes menu Zobrazit -> Panely nástrojů -> Vlastní přidat ručně a najdete ho mezi dostupnými položkami.
Aktivací tlačítka nebo položky z menu dojde ke spuštění Kalkulačky. Jak vidíte podle parametrů, lze též nastavit ikonku, která bude na tlačítku zobrazena a to jak ve své neaktivní podobě, tak po najetí myší. Místo mnou zvolené systémové ikony s číslem 4 můžete jako parametr pochopitelně uvést cestu k libovolné ikoně v souboru ICO nebo k nějaké jiné knihovně.

Prohození tlačítek myši

2010-04-30T03:04:00.000-07:00

Tento tip je opět jedním z těch, které asi v praxi příliš nevyužijeme, ale možná se může hodit, když budeme chtít například někoho trošku pozlobit. Ukážeme si, jak se snadno dají prohodit tlačítka na myši. Tedy pravé tlačítko se bude poté chovat jako levé a naopak. Poslouží nám k tomu následující jednoduchá funkce, jejímž parametrem je logická proměnná, určující, zda mají či nemají být klávesy prohozeny.
procedure ProhoditTlacitka(prohodit: Boolean);
begin
if prohodit then SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP, 1, nil, 0)
else SystemParametersInfo(SPI_SETMOUSEBUTTONSWAP, 0, nil, 0);
end;
Převod barvy formátu TColor na HTML
Následující jednoduchá funkce převede barvu ve formátu TColor, tedy formát běžně v Delphi používaný, na její hexa formu (či chcete-li "HTML barvu").
function ColorToHtml(Color: TColor): string;
var
col: LongInt;
begin
col := ColorToRGB(Color);
Result := '#' + IntToHex(col and $FF, 2) + IntToHex(col shr 8 and $FF, 2) + IntToHex(col shr 16 and $FF, 2);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(ColorToHtml(clLime));
end;
Seznam nainstalovaných aplikací
Chcete-li vědět či přesněji řečeno programově zjistit, které programy máte v systému nainstalovány, není to žádný problém. Jako většina podobných informací o systému jsou i tyto informace uloženy v registrech, takže je stačí jen najít a přečíst si je. Jejich součástí je také tzv. odinstalační řetězec, což není nic jiného než cesta k příslušnému odinstalačnímu programu včetně případných parametrů. Pokud budete chtít, můžete si tímto způsobem vytvořit vlastní program podobný systémovému ovládacímu panelu "Přidat nebo odebrat programy" a odebrat tak libovolnou aplikaci, i když to není asi primární cíl našeho příkladu. Využít však seznamu nainstalovaných aplikací můžete ve vašem programu k různým účelům, protože některé aplikace třeba vyžadují ke své práci současně nainstalované i další programy, takže pokud je váš program podobného ražení, může si sám otestovat přítomnost všech potřebných součástí. Ovšem vše jen za předpokladu, že jsou aplikace korektně nainstalovány v systému a mají svůj záznam v registrech.

Tipy a triky v Delphi

2010-04-29T06:05:00.000-07:00

V naší ukázce si předvedeme změnu parametrů u Editu a u tlačítka. U komponenty Edit bude při aktivaci změněna barva, u tlačítka se změní font popisku na tučný. Provedeme to tak, že si vytvoříme vlastní obsluhy událostí OnEnter a OnExit, které nazveme prostě Enter a Exit. Poté na formulář umístěte libovolný počet editačních polí a nějaká tlačítka. U všech těchto prvků poté nastavte v Object Inspectoru obsluhu událostí OnEnter a OnExit právě na naše připravené procedury. U těch komponent, kde tyto události nenastavíte, se nestane pochopitelně nic, což ovšem rozhodně nemusí být na škodu a můžete si tak vybrat, které komponenty budou takto "postiženy".
.
.
.
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
Button2: TButton;
procedure Enter(Sender: TObject);
procedure Exit(Sender: TObject);
.
.
.

procedure TForm1.Enter(Sender: TObject);
begin
if (Sender is TCustomEdit) then TEdit(Sender).Color := clRed;
if (Sender is TButton) then TButton(Sender).Font.Style := [fsBold];
end;

procedure TForm1.Exit(Sender: TObject);
begin
if (Sender is TCustomEdit) then TEdit(Sender).Color := clWindow;
if (Sender is TButton) then TButton(Sender).Font.Style := [];
end;
Jak vidíte, každá obsluha obsahuje podmínku, podle které se určuje, jaké parametry budou změněny na základě typu daného vizuálního objektu (tedy u typu TButton font, u TEdit zase barva). Změnit se dají vlastně libovolné parametry, ale nás budou zřejmě zajímat pouze ty vizuální. V události OnEnter jednotlivých komponent tedy naše procedura Enter změní barevnost či další parametry a poté, když uživatel přejde na jinou komponentu (zaktivuje ji), původní hodnoty budou opět obnoveny procedurou Exit v události OnExit. Tím docílíme jednoduchého efektu, kdy právě aktivní prvek na formuláři bude vždy zvýrazněn.

Tipy a triky v Delphi

2010-04-27T07:49:00.000-07:00

Popis jednotlivých částí najdete v podobě komentářů ve zdrojovém kódu. Samotný princip je snad dostatečně jasný, jsou to vlastně jen jednoduché čáry s textovým popisem, umístěné na příslušných místech, které se vypočítají z rozměrů formuláře (grafu).
Ještě jedno malé upozornění. Jelikož je pro vykreslení grafu, tedy propojení vypočítaných bodů křivkou, použita procedura Polyline, která všechny jednotlivé po sobě jdoucí body spojí bez ohledu na matematiku, je tento konkrétní postup použitelný na spojité funkce. Ostatní funkce by bylo vhodné vykreslovat buď bod po bodu (tedy bez jejich vzájemného propojení, a proto je třeba kvůli dobré vizuální podobě grafu použít větší přesnost – vypočítat více bodů) a nebo jiným způsobem.

Po čase tu máme opět několik tipů z různých oblastí. Předvedeme si, jak vizuálně zvýraznit právě aktivní prvek na formuláři a zpřehlednit tak uživateli práci. Dále si ukážeme, jak prohodit tlačítka na myši, převod barev formátu TColor do hexa podoby a také si ukážeme, jak zjistit z registrů seznam nainstalovaných aplikací.
Vizuální zvýraznění aktivní komponenty Edit
Komponenta Edit, tedy editační pole pro vyplňování dat rozličného druhu, je jistě jedním z nejběžnějších prvků uživatelského prostředí. Ukážeme si jedno drobné vylepšení, kterým se může práce s těmito editačními poli zvláště v případě rozsáhlejších formulářů pro uživatele velmi zpřehlednit. Toho docílíme tak, že editační pole, které bude zrovna aktivní (tedy uživatel do něj bude právě něco vyplňovat nebo bude prostě označeno – bude mít tzv. Focus), určitým způsobem zvýrazníme. Zvýraznit jej můžeme třeba tím, že se změní jeho barva a font písma nebo některé jiné vizuální vlastnosti, které daná komponenta má. Postup lze totiž aplikovat i na komponenty typu Edit, které nejsou standardně dodávané s Delphi, máte-li některé takové nainstalovány a používáte-li je raději. Ale obecně se dá říci, že je postup použitelný na všechny vizuální komponenty, které mají události OnExit a OnEnter (viz. dále), tedy například tlačítka a různé další prvky. Ne každý takový prvek má však například vlastnost Color, takže je potřeba individuálně podle potřeb náš příklad upravit.

Kreslení grafu funkce

2010-04-19T02:49:00.000-07:00

Tento příklad sice patří mezi klasické, skoro až školní příklady z učebnice programování, ale přesto si jej ukážeme. Pokročilejším čtenářům se tedy omlouvám, ale vydržte to.
V naší ukázce budeme pro názornost kreslit graf funkce sinus. Co také jiného. Kdo ví proč se obvykle v příkladech používá tato funkce, takže nebudeme bourat tradice.
Vytvořte si tedy nový projekt a na formulář umístěte komponentu PaintBox, ve které bude graf kreslen. Vlastnost Align nastavte tak, aby komponenta vyplňovala celý formulář (tedy na hodnotu alClient). Využijeme toho k tomu, aby se nám graf automaticky přizpůsoboval velikosti okna.
Nejprve tedy zdrojový kód (jeho popis bude následovat):
.
.
.
const pInterval=1000;

private
{ Private declarations }
FPoints: array [0..pInterval] of TPoint;

.
.
.

procedure VypocitatGraf;
var
RozsahX, RozsahY: Integer;
pocatek: TPoint;
radian, interval: Double;
i: Integer;
begin
RozsahX := (Form1.paintbox1.Width - 2) div 4;
RozsahY := (Form1.paintbox1.Height - 2) div 2;
pocatek := Point(Form1.paintbox1.Width div 2, Form1.paintbox1.Height div 2);
radian := -2.0 * Pi;
interval := 4.0 * Pi / pInterval;
for i := 0 to High(Form1.FPoints) do
begin
Form1.FPoints[i].X := pocatek.x + Round(radian * RozsahX / Pi);
Form1.FPoints[i].Y := pocatek.y - Round(sin(radian) * RozsahY);
radian := radian + interval;
end;
end;
Konstanta pInterval udává "rozlišení" grafu (počet jeho bodů) na intervalu od -2Pi do 2Pi, na kterém budeme funkci vykreslovat. Čím vyšší číslo, tím více body bude graf tvořen a tím lépe bude vypadat. Tyto body budou poté propojeny výslednou křivkou (viz dále). Počátek souřadnicové soustavy grafu je umístěn na střed PaintBoxu, rozsah X-ových souřadnic je dán Pi, Y-ové souřadnice ohraničuje samozřejmě jednička. Y-ové souřadnice jsou zároveň "převráceny", jak už to u počítačů bývá. Tedy nerostou z levého dolního rohu směrem nahoru, ale z levého horního rohu směrem dolů. Že se počítá v radiánech a ne ve stupních, snad netřeba zdůrazňovat.
Takže máme tedy vypočítané body, nyní nám zbývá nakreslit samotný graf. Kreslení bude provedeno jako událost OnPaint komponenty PaintBox:
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
with PaintBox1.Canvas do
begin
Pen.Color := clBlue;
Polyline(FPoints);
end;
end;
Dále je třeba zajistit překreslování v daném měřítku při změně velikosti formuláře. Proto musíme ještě doplnit události OnCreate a OnResize formuláře:
procedure TForm1.FormResize(Sender: TObject);
begin
VypocitatGraf;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
VypocitatGraf;
end;
A tím je vlastně základ hotov. Funkce je již vykreslena. Příklad by však nebyl úplný bez nakreslení a popsání souřadnicových os. Přidáme si proto opět do události OnPaint několik dalších řádků; celá procedura tedy bude vypadat takto:
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
pocatek: TPoint;
RozsahX, RozsahY: Integer;
begin
with PaintBox1.Canvas do
begin
{bílé pozadí grafu}
Brush.Color := clWhite;
Brush.Style := bsSolid;
Fillrect(paintbox1.BoundsRect);

{souřadnicový kříž}
pocatek := Point(paintbox1.Width div 2, paintbox1.Height div 2);
Pen.Color := clBlack;
Pen.Style := psSolid;
Pen.Width := 1;
MoveTo(1, pocatek.Y);
LineTo(paintbox1.Width - 1, pocatek.y);
MoveTo(pocatek.x, 1);
LineTo(pocatek.x, paintbox1.Height - 1);

Font.Name := 'Symbol';
Font.Size := 8;
Font.Color := clBlack;
RozsahX := (paintbox1.Width - 2) div 4;
RozsahY := (paintbox1.Height - 2) div 2;

{ukazatele a popis osy X}
MoveTo(pocatek.x - 2 * RozsahX, pocatek.y - 4);
LineTo(pocatek.x - 2 * RozsahX, pocatek.y + 4);
TextOut(pocatek.x - 2 * RozsahX + 2, pocatek.y + 2, '-2p');
MoveTo(pocatek.x - RozsahX, pocatek.y - 4);
LineTo(pocatek.x - RozsahX, pocatek.y + 4);
TextOut(pocatek.x - RozsahX + 2, pocatek.y + 2, '-p');
MoveTo(pocatek.x + RozsahX, pocatek.y - 4);
LineTo(pocatek.x + RozsahX, pocatek.y + 4);
TextOut(pocatek.x + RozsahX - 2 - TextWidth('p'), pocatek.y + 2, 'p');
MoveTo(pocatek.x + 2 * RozsahX, pocatek.y - 4);
LineTo(pocatek.x + 2 * RozsahX, pocatek.y + 4);
TextOut(pocatek.x + 2 * RozsahX - 2 - TextWidth('2p'), pocatek.y + 2, '2p');

{ukazatele a popis osy Y}
MoveTo(pocatek.x - 4, pocatek.y - RozsahY);
LineTo(pocatek.x + 4, pocatek.y - RozsahY);
TextOut(pocatek.x + 4, pocatek.y - RozsahY, '1.0');
MoveTo(pocatek.x - 4, pocatek.y - RozsahY div 2);
LineTo(pocatek.x + 4, pocatek.y - RozsahY div 2);
TextOut(pocatek.x + 4, pocatek.y - (RozsahY + TextHeight('1')) div 2, '0.5');
MoveTo(pocatek.x - 2, pocatek.y + RozsahY div 2);
LineTo(pocatek.x + 2, pocatek.y + RozsahY div 2);
TextOut(pocatek.x + 3, pocatek.y + (RozsahY - TextHeight('1')) div 2, '-0.5');
MoveTo(pocatek.x - 2, pocatek.y + RozsahY);
LineTo(pocatek.x + 2, pocatek.y + RozsahY);
TextOut(pocatek.x + 3, pocatek.y + RozsahY - TextHeight('1'), '-1.0');

{nakreslení samotné funkce}
Pen.Color := clBlue;
Polyline(FPoints);
end;
end;

Tipy a triky v Delphi

2010-03-16T05:02:00.000-07:00

Dnes si ještě naposledy řekneme pár tipů k tématu grafiky a od příštího dílu se zase vrhneme na jiné oblasti. Tématem dnešního dílu je převod obrázku na ikonu a kreslení grafu funkce.
Převod obrázku BMP na ikonu
Nedílnou součástí každé aplikace je i její ikona. Jistě se nespokojíte s implicitní ikonou, kterou vaší aplikaci přiřadí Delphi, a budete si chtít vytvořit vlastní. K tomu můžete použít nějaký k tomu určený editor ikon. Pokud jej náhodou nemáte po ruce a nebo nejste natolik výtvarně schopní a raději použijete již hotový obrázek, možná se vám bude hodit následující funkce, která převede obrázek BMP na formát ikony. Ačkoliv se to může zdát jako velmi jednoduchá funkce, dokonce ani velmi oblíbený prohlížeč obrázků ACDsee ji – pokud vím – neobsahuje, a pokud jste již někdy potřebovali rychle vytvořit ikonu bez patřičného editoru, jistě mi dáte za pravdu, že to může být na první pohled celkem problém. Ten se také snaží částečně řešit naše funkce.
Samozřejmě jsou zde jistá omezení, a to především v rozlišení zdrojového obrázku. Ten si musíte předem pomocí grafického editoru upravit na rozlišení ikony (tj. 32x32, 64x64 bodů atd..). Poté na něj již jen aplikujete následující funkci a získáte soubor ICO.
procedure bmp2ico(Image: TImage; FileName: TFilename);
var
Bmp: TBitmap;
Icon: TIcon;
ImageList: TImageList;
begin
Bmp := TBitmap.Create;
Icon := TIcon.Create;
try
Bmp.Assign(Image.Picture);
ImageList := TImageList.CreateSize(Bmp.Width, Bmp.Height);
try
ImageList.AddMasked(Bmp, Bmp.TransparentColor);
ImageList.GetIcon(0, Icon);
Icon.SaveToFile(FileName);
finally
ImageList.Free;
end;
finally
Bmp.Free;
Icon.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
bmp2ico(Image1, 'c:\ikonka.ico');
end;
Všimněte si uvnitř procedury parametru TransparentColor. Ten, jak název napovídá, slouží k určení transparentní barvy ikonky, tedy barvy "pozadí", které nebude vidět. Zde je nastaven podle vstupního souboru, ale klidně můžete celou proceduru obohatit o tento parametr navíc a určovat tuto barvu přímo. Parametr je pochopitelně typu TColor.

Transparentní text v obrázku

2010-02-02T07:18:00.000-08:00

Velmi užitečnou funkcí též může být umístění transparentního textu, tedy textu s průhledným pozadím, přímo do obrázku. Jaký může být způsob využití takové funkce? Namátkou mě napadá třeba situace, kdy potřebujete hromadně u desítek obrázků přidat do jejich rohu váš copyright nebo časový údaj pro budoucí prezentaci. V tom případě vám může tato funkce ušetřit řadu času.
Příklad opět předpokládá, že v komponentě Image máte již načtenu bitmapu, a samotné přidání textu bude opět voláno jako událost stisku tlačítka:
procedure TForm1.Button1Click(Sender: TObject);
begin
with Image1.Picture.Bitmap.Canvas do
begin
Font.Color := clRed;
Brush.Style := bsclear;
Font.Size := 13;
TextOut(10, 10, 'Dnes je 3.4. 2002');
end;
end;
Jak vidíte, lze bez problému měnit všechny základní parametry textu. Pokud by vám snad nevyhovovalo, že je text transparentní, stačí příslušným způsobem změnit Brush.Style například na bsSolid a v tom případě bude pod textem pozadí.
A to je pro dnešek všechno. Příště si ještě ukážeme několik drobných funkcí s obrázky a začneme se opět věnovat jiným tématům.

2010-01-28T00:45:00.000-08:00

Transparentní text v obrázku

2010-01-24T06:25:00.000-08:00

Transparentní text v obrázku
Velmi užitečnou funkcí též může být umístění transparentního textu, tedy textu s průhledným pozadím, přímo do obrázku. Jaký může být způsob využití takové funkce? Namátkou mě napadá třeba situace, kdy potřebujete hromadně u desítek obrázků přidat do jejich rohu váš copyright nebo časový údaj pro budoucí prezentaci. V tom případě vám může tato funkce ušetřit řadu času.
Příklad opět předpokládá, že v komponentě Image máte již načtenu bitmapu, a samotné přidání textu bude opět voláno jako událost stisku tlačítka:
procedure TForm1.Button1Click(Sender: TObject);
begin
with Image1.Picture.Bitmap.Canvas do
begin
Font.Color := clRed;
Brush.Style := bsclear;
Font.Size := 13;
TextOut(10, 10, 'Dnes je 3.4. 2002');
end;
end;
Jak vidíte, lze bez problému měnit všechny základní parametry textu. Pokud by vám snad nevyhovovalo, že je text transparentní, stačí příslušným způsobem změnit Brush.Style například na bsSolid a v tom případě bude pod textem pozadí.
A to je pro dnešek všechno. Příště si ještě ukážeme několik drobných funkcí s obrázky a začneme se opět věnovat jiným tématům.

Převod barev do odstínů šedi

2010-01-03T14:51:00.000-08:00

Převod barev obrázku do odstínů šedi je další z obvyklých funkcí a řekl bych, že docela potřebnou, protože řada fotografií získá převodem na "černobílou" zcela jiný umělecký rozměr. Ale to teď nechme stranou, ukažme si rovnou samotnou funkci na převod. Podobně jako u předchozích funkcí lze i tuto provést řadou způsobů, z nichž jeden vám předkládám:
procedure Grayscale(const Bmp: TBitmap);
type
TRGBArray = array[0..32767] of TRGBTriple;
pRGBArray = ^TRGBArray;
var
x, y, Gray: Integer;
Row: pRGBArray;
begin
Bmp.PixelFormat := pf24Bit;
for y := 0 to Bmp.Height - 1 do
begin
Row := Bmp.ScanLine[y];
for x := 0 to Bmp.Width - 1 do
begin
Gray := (Row[x].rgbtRed + Row[x].rgbtGreen + Row[x].rgbtBlue) div 3;
Row[x].rgbtRed := Gray;
Row[x].rgbtGreen := Gray;
Row[x].rgbtBlue := Gray;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if Image1.Picture <> nil then Grayscale(Image1.Picture.Bitmap);
Form1.Image1.Repaint;
end;
Opět, stejně jako u všech předchozích příkladů, je třeba mít na formuláři komponentu Image, do které například pomocí OpenPictureDialogu nejprve načteme bitmapu.

Tipy a triky v Delphi

2009-06-04T05:48:00.000-07:00

Tipy a triky v Delphi
Do třetice zde máme tip pro Windows XP a opět se bude týkat bublinkové nápovědy - hintů. Tentokrát ale té běžné, která se zobrazuje u všech prvků uživatelského prostředí.
Windows XP nám kromě nových funkcí přinášejí řadu novinek uživatelského prostředí. Kromě "skinů", vyhlazování fontů a různých dalších efektů, týkajících se všech možných prvků prostředí, jsme si minule ukazovali i nové balónové hinty. Jestli jsou všechny tyto efekty přínosem, to je věc názoru. První věcí, kterou velká část uživatelů udělá, je to, že tyto efekty prostě vypne. Toto je ovšem téma na úplně jiný článek, i když budu rád, pokud svůj názor vyjádříte v diskusi pod článkem. Vraťme se však k Delphi. I dnes si budeme povídat o hintech, tedy o bublinkové nápovědě, ale tentokrát té klasické, kterou obsahují (či mohou obsahovat) již od pradávna všechny (tedy téměř) prvky uživatelského prostředí systému.
I u tohoto poměrně jednoduchého prvku nám Windows XP přinášejí rovněž vylepšení vzhledu. Pokud ji do svých programů zapracujete a necháte aktivované příslušné volby vzhledu v samotném systému, budou pak vypadat hinty o malý chloupek lépe než dosud. Změna spočívá v přidání poměrně efektního, i když možná na první pohled snadno přehlédnutelného, stínu k samotnému popisku. Tím vypadá nápověda ještě o něco lépe a vyvolává mnohem plastičtější dojem.

2008-11-26T07:22:00.000-08:00

Zajímavá je taktéž procedura SysTrayIconMsgHandler, která má na starosti zpracování zpráv o stavu nápovědy. V naší ukázce nejsou jednotlivým stavům přiřazeny žádné akce, takže si příslušné funkce doplňte dle vaší potřeby sami. Jak vidíte ze zdrojového kódu, jsou zde reakce na stisknutí tlačítka myši, skrytí či zobrazení nápovědy, uplynutí timeoutu a podobně.
A na závěr snad už jen poznámka k drobným rozdílům mezi systémy. Zatímco pod Windows XP bude zobrazena nápověda v "plné síle" včetně uzavíracího tlačítka a s efektem postupného zobrazování a pohasínání, pod Windows 2000 bude toto tlačítko i efekt chybět. Nemám představu, jak bude situace vypadat pod Windows ME, ale předpokládám že stejně jako pod Windows 2000. A konečně pod Windows 98 (či staršími systémy) se nezobrazí nic, pouze ikona v hlavním panelu a varovné upozornění, které je tam pochopitelně pouze pro naše testovací účely a v opravdových aplikacích není samozřejmě nutné tímto dialogem uživatele obtěžovat.

2008-10-09T00:33:00.000-07:00

type
PNewNotifyIconData = ^TNewNotifyIconData;
TDUMMYUNIONNAME = record
case Integer of
0: (uTimeout: UINT);
1: (uVersion: UINT);
end;

TNewNotifyIconData = record
cbSize: DWORD;
Wnd: HWND;
uID: UINT;
uFlags: UINT;
uCallbackMessage: UINT;
hIcon: HICON;
szTip: array [0..127] of Char;
dwState: DWORD;
dwStateMask: DWORD;
szInfo: array [0..255] of Char;
DUMMYUNIONNAME: TDUMMYUNIONNAME;
szInfoTitle: array [0..63] of Char;
dwInfoFlags: DWORD;
end;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
IconData: TNewNotifyIconData;
procedure SysTrayIconMsgHandler(var Msg: TMessage); message TRAY_CALLBACK;
procedure AddSysTrayIcon;
procedure ShowBalloonTips;
procedure DeleteSysTrayIcon;
public
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.SysTrayIconMsgHandler(var Msg: TMessage);
begin
case Msg.lParam of
WM_MOUSEMOVE:;
WM_LBUTTONDOWN:;
WM_LBUTTONUP:;
WM_LBUTTONDBLCLK:;
WM_RBUTTONDOWN:;
WM_RBUTTONUP:;
WM_RBUTTONDBLCLK:;
NIN_BALLOONSHOW:;
NIN_BALLOONHIDE:;
NIN_BALLOONTIMEOUT:;
NIN_BALLOONUSERCLICK:;
end;
end;

procedure TForm1.AddSysTrayIcon;
begin
IconData.cbSize := SizeOf(IconData);
IconData.Wnd := AllocateHWnd(SysTrayIconMsgHandler);
IconData.uID := 0;
IconData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
IconData.uCallbackMessage := TRAY_CALLBACK;
IconData.hIcon := Application.Icon.Handle;
IconData.szTip := 'Toto je testovací nápověda.';
if not Shell_NotifyIcon(NIM_ADD, @IconData) then ShowMessage('Chyba, nepodařilo se vložit ikonu do hlavního panelu !');
end;

procedure TForm1.ShowBalloonTips;
var
TipInfo, TipTitle: string;
begin
IconData.cbSize := SizeOf(IconData);
IconData.uFlags := NIF_INFO;
TipInfo := 'Toto je testovací nápověda.';
strPLCopy(IconData.szInfo, TipInfo, SizeOf(IconData.szInfo) - 1);
IconData.DUMMYUNIONNAME.uTimeout := 3000;
TipTitle := 'Upozornění';
strPLCopy(IconData.szInfoTitle, TipTitle, SizeOf(IconData.szInfoTitle) - 1);
IconData.dwInfoFlags := NIIF_INFO;
Shell_NotifyIcon(NIM_MODIFY, @IconData);
IconData.DUMMYUNIONNAME.uVersion := NOTIFYICON_VERSION;
if not Shell_NotifyIcon(NIM_SETVERSION, @IconData) then ShowMessage('Chyba ve verzi.');
end;

procedure TForm1.DeleteSysTrayIcon;
begin
DeallocateHWnd(IconData.Wnd);
if not Shell_NotifyIcon(NIM_DELETE, @IconData) then ShowMessage('Chyba, nepodařilo se odstranit ikonu z hlavního panelu.');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
AddSysTrayIcon;
ShowBalloonTips;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteSysTrayIcon;
end;

end.
Při úpravě kódu je pro vás důležitá hlavně procedura ShowBalloonTips, kde najdete jednak texty, které se budou v nápovědě zobrazovat (tedy nadpis a vlastní zpráva) a dále také typ ikony. Ta je v ukázce nastavena na NIIF_INFO, tedy informační ikona. Další možnosti můžete najít v konstantách, jsou to NIIF_WARNING a NIIF_ERROR a jistě sami dobře víte, jaké ikony budou tyto názvy představovat. Rovněž zde najdete i časový interval (timeout), jak dlouho bude bublina zobrazena, ale rovnou se vám přiznám, že je třeba brát tento údaj s rezervou, neboť se nápověda zobrazí vždy na o něco delší okamžik (tedy alespoň na mém počítači).

Tipy a triky v Delphi

2008-10-07T00:00:00.000-07:00

I dnešní tip bude poněkud zaměřen na Windows XP, i když příklad by vám měl fungovat i v jiných verzích. Budeme se zabývat "balónovými hinty".
Tzv. balónové hinty, tedy poněkud vylepšená klasická bublinková nápověda, která se objevuje u ikon na hlavním panelu vedle hodin, se ve větší míře začaly objevovat až s příchodem Windows XP, i když v jisté omezené míře fungují i pod Windows 2000 či ME (stejně jako náš dnešní příklad).
Kromě výrazně změněného vzhledu samotné "bubliny", která teď už vypadá skutečně jako komiksová bublina, se drobně odlišuje i text. Bublina obsahuje jednak jakýsi nadpis, který je napsán tučněji než samotný text a pak pochopitelně samotnou zprávu uživateli, která může být několikařádková. Dále je zde drobná ikonka, symbolizující druh zprávy (podobně jako u klasických message dialogů) a rovněž tlačítko na uzavření tohoto malého "okna". Ale dost popisu, všichni víte, oč se jedná.
Náš příklad tedy ve zkratce provede to, že po spuštění se přidá do hlavního panelu ikonka naší aplikace a zobrazí se balónový hint s krátkým textem. Po uplynutí zadaného času (nastaven na 3 sekundy) nebo kliknutí uživatele pak nápověda zmizí.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ShellAPI;

const
NIF_INFO = $10;
NIF_MESSAGE = 1;
NIF_ICON = 2;
NOTIFYICON_VERSION = 3;
NIF_TIP = 4;
NIM_SETVERSION = $00000004;
NIM_SETFOCUS = $00000003;
NIIF_INFO = $00000001;
NIIF_WARNING = $00000002;
NIIF_ERROR = $00000003;
NIN_BALLOONSHOW = WM_USER + 2;
NIN_BALLOONHIDE = WM_USER + 3;
NIN_BALLOONTIMEOUT = WM_USER + 4;
NIN_BALLOONUSERCLICK = WM_USER + 5;
NIN_SELECT = WM_USER + 0;
NINF_KEY = $1;
NIN_KEYSELECT = NIN_SELECT or NINF_KEY;
TRAY_CALLBACK = WM_USER + $7258;

2008-08-11T03:38:00.000-07:00

{$R *.dfm}

function RegisterSessionNotification(Wnd: HWND; dwFlags: DWORD): Boolean;
type
TWTSRegisterSessionNotification = function(Wnd: HWND; dwFlags: DWORD): BOOL; stdcall;
var
hWTSapi32dll: THandle;
WTSRegisterSessionNotification: TWTSRegisterSessionNotification;
begin
Result := False;
hWTSAPI32DLL := LoadLibrary('Wtsapi32.dll');
if (hWTSAPI32DLL > 0) then
begin
try
@WTSRegisterSessionNotification := GetProcAddress(hWTSAPI32DLL, 'WTSRegisterSessionNotification');
if Assigned(WTSRegisterSessionNotification) then Result := WTSRegisterSessionNotification(Wnd, dwFlags);
finally
if hWTSAPI32DLL > 0 then FreeLibrary(hWTSAPI32DLL);
end;
end;
end;

function UnRegisterSessionNotification(Wnd: HWND): Boolean;
type
TWTSUnRegisterSessionNotification = function(Wnd: HWND): BOOL; stdcall;
var
hWTSapi32dll: THandle;
WTSUnRegisterSessionNotification: TWTSUnRegisterSessionNotification;
begin
Result := False;
hWTSAPI32DLL := LoadLibrary('Wtsapi32.dll');
if (hWTSAPI32DLL > 0) then
begin
try
@WTSUnRegisterSessionNotification := GetProcAddress(hWTSAPI32DLL, 'WTSUnRegisterSessionNotification');
if Assigned(WTSUnRegisterSessionNotification) then Result:= WTSUnRegisterSessionNotification(Wnd);
finally
if hWTSAPI32DLL > 0 then FreeLibrary(hWTSAPI32DLL);
end;
end;
end;

function GetCurrentSessionID: Integer;
type
TProcessIdToSessionId = function(dwProcessId: DWORD; pSessionId: DWORD): BOOL; stdcall;
var
ProcessIdToSessionId: TProcessIdToSessionId;
Lib : THandle;
pSessionId : DWord;
begin
Result := 0;
Lib := GetModuleHandle('kernel32');
if Lib <> 0 then
begin
ProcessIdToSessionId := GetProcAddress(Lib, '1ProcessIdToSessionId');
if Assigned(ProcessIdToSessionId) then
begin
ProcessIdToSessionId(GetCurrentProcessId(), DWORD(@pSessionId));
Result:= pSessionId;
end;
end;
end;

procedure TForm1.AppMessage(var Msg: TMSG; var Handled: Boolean);
var
strReason: string;
begin
Handled := False;
if Msg.Message = WM_WTSSESSION_CHANGE then
begin
case Msg.wParam of
WTS_CONSOLE_CONNECT: strReason := 'WTS_CONSOLE_CONNECT';
WTS_CONSOLE_DISCONNECT: strReason := 'WTS_CONSOLE_DISCONNECT';
WTS_REMOTE_CONNECT: strReason := 'WTS_REMOTE_CONNECT';
WTS_REMOTE_DISCONNECT: strReason := 'WTS_REMOTE_DISCONNECT';
WTS_SESSION_LOGON: strReason := 'WTS_SESSION_LOGON';
WTS_SESSION_LOGOFF: strReason := 'WTS_SESSION_LOGOFF';
WTS_SESSION_LOCK: strReason := 'WTS_SESSION_LOCK';
WTS_SESSION_UNLOCK: strReason := 'WTS_SESSION_UNLOCK';
WTS_SESSION_REMOTE_CONTROL: strReason := 'WTS_SESSION_REMOTE_CONTROL';
else
strReason := 'WTS_Unknown';
end;
Memo1.Lines.Add(strReason + ' ' + IntToStr(msg.Lparam));
end;
end;

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

procedure TForm1.FormDestroy(Sender: TObject);
begin
if FRegisteredSessionNotification then UnRegisterSessionNotification(Handle);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FRegisteredSessionNotification := RegisterSessionNotification(Handle, NOTIFY_FOR_THIS_SESSION);
Application.OnMessage := AppMessage;
end;

end.
A zbývá jen poslední informace, týkající se ostatních systémů Windows. Není třeba se obávat žádných chybových hlášení, program vybavený těmito funkcemi bude fungovat i na starších systémech, ale tyto funkce pochopitelně nebudou mít žádný efekt.

2008-08-07T05:57:00.000-07:00

Vytvoříme si proto malou ukázkovou aplikaci, která bude toto přepínání hlídat. Poslouží nám k tomu dvě funkce. První zařídí, aby aplikace dostávala od systému upozornění na změnu session (tu použijeme při spuštění programu), druhou funkcí zase toto upozorňování zrušíme (při ukončení programu). Ještě přidáme navíc funkci pro detekci čísla aktuální session. V konstantách budou uloženy názvy jednotlivých stavů session (a zřejmě nemá cenu je překládat do češtiny, takže je ponechávám v původní podobě) a všechny výpisy budou prováděny do komponenty Memo. Umístěte ji proto na prázdný formulář. Jelikož totiž po přepnutí uživatele nebudete mít k aplikaci přístup, bude záznam o této změně vypsán právě do komponenty Memo a po opětovném přepnutí zpět si můžete jednotlivé stavy prohlédnout. Poslední věcí je tlačítko, které rovněž přidejte na formulář. Po jeho stisku bude zobrazeno číslo session, což má v tomto případě spíše ukázkový charakter, protože budete vidět vždy jen vaší aktuální session (po přepnutí na jiného uživatele pochopitelně tlačítko nepůjde stisknout, protože neuvidíte vůbec samotnou aplikaci). V "ostrých" aplikacích však tato funkce své využití jistě najde a rovněž místo výpisu daných stavů do Memo se bude aplikace chovat jinak. A zde tedy již samotný kód. Pro dnešek opět kompletní unit pro snadnější zkopírování do Delphi.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

const

WM_WTSSESSION_CHANGE = $2B1;
WTS_CONSOLE_CONNECT = 1;
WTS_CONSOLE_DISCONNECT = 2;
WTS_REMOTE_CONNECT = 3;
WTS_REMOTE_DISCONNECT = 4;
WTS_SESSION_LOGON = 5;
WTS_SESSION_LOGOFF = 6;
WTS_SESSION_LOCK = 7;
WTS_SESSION_UNLOCK = 8;
WTS_SESSION_REMOTE_CONTROL = 9;
NOTIFY_FOR_THIS_SESSION = 0;
NOTIFY_FOR_ALL_SESSIONS = 1;

type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FRegisteredSessionNotification : Boolean;
procedure AppMessage(var Msg: TMSG; var HAndled: Boolean);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

2008-08-01T12:27:00.000-07:00

Kdysi jsme si v našem seriálu ukazovali, jak detekovat vypnutí či restart systému, protože to je stav, který je pro aplikaci poměrně důležitý. Aplikace v takovém případě může reagovat uložením dat a podobně. S příchodem Windows XP, které jsou stále rozšířenější, se nám celá věc drobně zkomplikovala. Přibyla nám totiž funkce na přepínání uživatelů, kdy nedojde k odhlášení uživatele v pravém slova smyslu, ale jeho aplikace běží na pozadí dál, zatímco může pracovat jiný přihlášený uživatel. Tyto spuštěné aplikace normálně pracují a pro aktuálního uživatele nejsou viditelné ani přístupné. A právě toto přepínání mezi uživateli se naučíme detekovat, aby mohla naše aplikace příslušným způsobem reagovat. V běžných případech to zřejmě nebude vůbec nutné, ale pokud je vaše aplikace natolik speciální, že by přepnutí uživatele mohlo vadit (přistupuje například k nějakým sdíleným prostředkům), jistě se bude tato detekce hodit. Program pak může reagovat tak, že některé své funkce omezí nebo úplně vypne, dokud nedojde opět k přepnutí na původního uživatele.

2008-07-30T01:52:00.000-07:00

procedure PaintRainbow(Dc : hDc; x : integer; y : integer; Width : integer; Height : integer; bVertical : bool; WrapToRed : bool);
var
i : integer;
ColorChunk : integer;
OldBrush : hBrush;
r : integer;
g : integer;
b : integer;
Chunks : integer;
pt : TPoint;
begin
OffsetViewportOrgEx(Dc, x, y, pt);
if WrapToRed then Chunks := 6
else Chunks := 5;
if bVertical then ColorChunk := Height div Chunks
else ColorChunk := Width div Chunks;

{Red -> Yellow}
r := 255;
b := 0;
for i := 0 to ColorChunk do
begin
g:= (255 div ColorChunk) * i;
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));
if bVertical then PatBlt(Dc, 0, i, Width, 1, PatCopy)
else PatBlt(Dc, i, 0, 1, Height, PatCopy);
DeleteObject(SelectObject(Dc, OldBrush));
end;

{Yellow -> Green}
g:=255;
b:=0;
for i := ColorChunk to (ColorChunk * 2) do
begin
r := 255 - (255 div ColorChunk) * (i - ColorChunk);
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));
if bVertical then PatBlt(Dc, 0, i, Width, 1, PatCopy)
else PatBlt(Dc, i, 0, 1, Height, PatCopy);
DeleteObject(SelectObject(Dc, OldBrush));
end;

{Green -> Cyan}
r:=0;
g:=255;
for i:= (ColorChunk * 2) to (ColorChunk * 3) do
begin
b := (255 div ColorChunk)*(i - ColorChunk * 2);
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));
if bVertical then PatBlt(Dc, 0, i, Width, 1, PatCopy)
else PatBlt(Dc, i, 0, 1, Height, PatCopy);
DeleteObject(SelectObject(Dc,OldBrush));
end;

{Cyan -> Blue}
r := 0;
b := 255;
for i:= (ColorChunk * 3) to (ColorChunk * 4) do
begin
g := 255 - ((255 div ColorChunk) * (i - ColorChunk * 3));
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));
if bVertical then PatBlt(Dc, 0, i, Width, 1, PatCopy)
else PatBlt(Dc, i, 0, 1, Height, PatCopy);
DeleteObject(SelectObject(Dc, OldBrush));
end;

{Blue -> Magenta}
g := 0;
b := 255;
for i:= (ColorChunk * 4) to (ColorChunk * 5) do
begin
r := (255 div ColorChunk) * (i - ColorChunk * 4);
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));
if bVertical then PatBlt(Dc, 0, i, Width, 1, PatCopy)
else PatBlt(Dc, i, 0, 1, Height, PatCopy);
DeleteObject(SelectObject(Dc, OldBrush))
end;

if WrapToRed then
begin
{Magenta -> Red}
r := 255;
g := 0;
for i := (ColorChunk * 5) to ((ColorChunk * 6) - 1) do
begin
b := 255 -((255 div ColorChunk) * (i - ColorChunk * 5));
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r,g,b)));
if bVertical then PatBlt(Dc, 0, i, Width, 1, PatCopy)
else PatBlt(Dc, i, 0, 1, Height, PatCopy);
DeleteObject(SelectObject(Dc,OldBrush));
end;
end;

if (Width - (ColorChunk * Chunks) - 1 ) > 0 then
begin
if WrapToRed then
begin
r := 255;
g := 0;
b := 0;
end
else
begin
r := 255;
g := 0;
b := 255;
end;
OldBrush := SelectObject(Dc, CreateSolidBrush(Rgb(r, g, b)));
if bVertical then PatBlt(Dc, 0, ColorChunk * Chunks, Width, Height - (ColorChunk * Chunks), PatCopy)
else PatBlt(Dc, ColorChunk * Chunks, 0, Width - (ColorChunk * Chunks), Height, PatCopy);
DeleteObject(SelectObject(Dc,OldBrush));
end;
OffsetViewportOrgEx(Dc, Pt.x, Pt.y, pt);
end;

function ColorAtRainbowPoint(ColorPlace : integer; RainbowWidth : integer; WrapToRed : bool) : TColorRef;
var
ColorChunk : integer;
ColorChunkIndex : integer;
ColorChunkStart : integer;
begin
if ColorPlace = 0 then
begin
result := RGB(255, 0, 0);
exit;
end;
if WrapToRed then ColorChunk := RainbowWidth div 6
else ColorChunk := RainbowWidth div 5;
ColorChunkStart := ColorPlace div ColorChunk;
ColorChunkIndex := ColorPlace mod ColorChunk;
case ColorChunkStart of
0 : result := RGB(255, (255 div ColorChunk) * ColorChunkIndex, 0);
1 : result := RGB(255 - (255 div ColorChunk) * ColorChunkIndex, 255, 0);
2 : result := RGB(0, 255, (255 div ColorChunk) * ColorChunkIndex);
3 : result := RGB(0, 255 - (255 div ColorChunk) * ColorChunkIndex, 255);
4 : result := RGB((255 div ColorChunk) * ColorChunkIndex, 0, 255);
5 : result := RGB(255, 0, 255 - (255 div ColorChunk) * ColorChunkIndex);
else
if WrapToRed then result := RGB(255, 0, 0)
else result := RGB(255, 0, 255);
end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
PaintRainbow(Form1.Canvas.Handle, 0, 0, Form1.ClientWidth, Form1.ClientHeight, false, true);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
InvalidateRect(Form1.Handle, nil, false);
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Color : TColorRef;
begin
Color := ColorAtRainbowPoint(y, Form1.ClientWidth, true);
ShowMessage(IntToStr(GetRValue(Color)) + #32 + IntToStr(GetGValue(Color)) + #32 + IntToStr(GetBValue(Color)));
end;
K čemu dnešní příklad použijete, to již ponechám jako obvykle na vás. Zřejmě asi nebude nejvhodnější dávat takové barevné pozadí na hlavní formulář aplikace, ale jistě se najdou i jiná vhodná místa. Rovněž si povšimněte, že není nutné aplikovat kreslení spektra pouze na pozadí formuláře, ale prakticky na libovolný objekt, která má "plátno" (Canvas). Například jej můžete použít jako pozadí ToolBaru, ale musíte si dát v tomto případě pozor na překreslování jednotlivých prvků (tlačítek), které bude ToolBar obsahovat.
A to je již pro dnešek opravdu vše a jako obvykle vás v podobných případech vybízím k experimentování se zdrojákem. Určitě se vám povede vykouzlit různé barevné "šílenosti".

2008-07-17T20:34:00.000-07:00

Tipy a triky v Delphi, díl 61.
V našem seriálu už jsme vylepšovali aplikace opravdu rozličnými způsoby. Od tvaru a barev samotného okna, přes úpravu jednotlivých komponent. Ne vždy to samozřejmě bylo účelné a některá tato vylepšení byla spíše pro zábavu a zkoušení. Vše záleží do jisté míry na vašem vkusu, jak moc aplikaci podobnými efekty "přeplácáte". Do podobné kategorie spadá i dnešní tip.
Ukážeme si, jak na pozadí formuláře, které je jinak šedivě (či jinak) nudné, nakreslit duhu. Tedy, ne úplně přesně duhu, ale spíše barevné spektrum. Zkrátka jednotlivé barvy spektra, které postupně přecházejí jedna v druhou.
Příklad se skládá vlastně ze dvou procedur. První slouží k samotnému vykreslování "duhy", druhá pro zjišťování čísla barvy na daném místě duhy (viz. dále). Pohledem do zdrojového kódu můžete vidět, jak jsou postupně kresleny přechody jednotlivých barev. Procedura má postupně parametry, které určují místo, kde bude spektrum kresleno (zde plátno formuláře), dále souřadnice a velikost spektra. Předposledním parametrem určíme, zda má být spektrum horizontální či vertikální a posledním parametrem můžeme zajistit, zda má spektrum opět končit červenou počáteční barvou a uzavřít tak pomyslný "kruh" (což v tomto případě není zrovna přesné vyjádření).
Druhá procedura je spíše takové nepovinné rozšíření pro kontrolu, se samotným kreslením spektra nemá nic společného. Poslouží nám pouze k tomu, že po kliknutí na libovolné místo formuláře se nám zobrazí hodnota barvy, kterou v daném místě spektrum má.

Tapeta na ploše během přihlašování

2008-07-08T04:27:00.001-07:00

I druhý dnešní tip vzdáleně souvisí s přihlašováním do systému a rovněž využijeme registry. Možná vám vadí, že během přihlašování do systému Windows 2000 je pod přihlašovacím dialogem zobrazena jen prázdná (modrá) "pracovní plocha". Samotná tapeta (obrázek) se načte až jednotlivým uživatelům po přihlášení. To však lze změnit a vámi zvolený obrázek se může místo modré prázdné plochy zobrazit už při přihlašování. Stačí do příslušného místa registru zadat cestu k souboru s obrázkem a je to. Bylo by zřejmě zbytečné zde uvádět stejný zdrojový kód jako v předchozím případě a proto si uvedeme pouze příslušnou větev a klíč registru, který je třeba změnit. Konkrétně je to tedy tato větev:
HKEY_USERS\.DEFAULT\Control Panel\Desktop
Zde najdete položku Wallpaper, jejíž hodnotu vyplníte cestou k souboru s obrázkem a vše je hotovo. Po restartu systému již bude daný obrázek načten ihned při zobrazení přihlašovacího okna.
Offline verze ve formátu nápovědy
Soubor všech tipů a triků osažených v dílech 1 až 55 si můžete nyní také stáhnout pro offline prohlížení ve formátu nápovědy pro Windows. Velikost zip souboru je 194 kB.

Tapeta na ploše během přihlašování

2008-07-08T04:27:00.000-07:00

Zobrazení upozornění před logovacím dialogem

2008-06-23T00:49:00.001-07:00

Ve Windows existuje možnost drobnou úpravou registru zajistit to, že se ještě před samotným dialogem pro přihlášení do systému zobrazí okno s textem, které tak může uživatele upozornit na různé události. Po potvrzení dialogu kliknutím na OK pak již pokračuje přihlášení zcela běžným způsobem. Má to tu výhodu, že takto můžete jednak upozornit všechny "legální" uživatele daného systému na nějakou důležitou věc (lépe řečeno vaše aplikace může ohlásit nějakou událost), ale můžete také na cokoliv upozornit (varovat) uživatele, kteří na daném počítači svůj účet nemají.
Postup by měl fungovat ve všech Windows, i když musím přiznat, že mně osobně to na systémech 9x nepracovalo. Pod Windows 2000 však vše pracovalo bezvadně a koneckonců má tato funkce pro systémy NT/2000/XP mnohem větší opodstatnění než pro systémy 9x, které nejsou víceuživatelské v pravém slova smyslu.
Nyní tedy již k samotné implementaci v Delphi. Jelikož jsme v našem seriálu už prováděli úpravy registrů nesčetněkrát, zřejmě by stačilo pouze uvést, kterou větev a klíč upravit, ale pro jistotu si uvedeme celý kód. Snad nemusím připomínat, že je třeba do projektu přidat jednotku Registry.
procedure TForm1.Button1Click(Sender: TObject);
var
key: string;
Reg: TRegIniFile;
begin
key := '\Software\Microsoft\Windows NT\CurrentVersion\Winlogon';
Reg := TRegIniFile.Create;
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.CreateKey(Key);
if Reg.OpenKey(Key, False) then
begin
Reg.WriteString(key, 'LegalNoticeCaption', 'Titulek zobrazeného okna');
Reg.WriteString(key, 'LegalNoticeText', 'Vlastní zobrazovaný text');
end;
finally
Reg.Free;
end;
end;
Pro systémy 9x musíte vynechat v textu klíče NT, takže klíč pak vypadá takto:
'\Software\Microsoft\Windows\CurrentVersion\Winlogon'
Zobrazovaný text může mít 256 znaků, u systémů NT s posledním service packem (a zřejmě tím pádem u všech systému 2000 a XP) až 1024 znaků.

2008-06-19T02:51:00.001-07:00

V jednom z předchozích dílů jsme se zabývali načítáním informací ze souboru WAV a dnes se na to podíváme z poněkud opačné stránky, protože budeme tyto zvukové soubory programově vytvářet.
Procedura, která nám k tomu poslouží, na základě požadovaných parametrů vygeneruje příslušný zvuk do souboru WAV, který pak můžete již běžným způsobem přehrát. Mezi parametry procedury patří jednak frekvence zvuku pro oba kanály, dále pak délka vygenerovaného zvuku (či spíše tónu) a konečně jméno výstupního souboru. Do seznamu použitých jednotek ještě přidejte knihovnu MMSystem, kterou budeme potřebovat.
procedure CreateWave(LeftFreq, RightFreq: Single; Duration: Cardinal; const FileName: String);
const
BitsPerSample = 16;
NumChannels = 2;
SampleRate = 44100;
var
ChunkSize: Integer;
DataSize: Integer;
Factor: Single;
Format: TWaveFormatEx;
FourCC: array[0..3] of Char;
I: Integer;
NumSamples: Integer;
L: SmallInt;
R: SmallInt;
WaveStream: TFileStream;
begin
WaveStream := TFileStream.Create(FileName, fmCreate);
try
FourCC := 'RIFF';
WaveStream.Write(FourCC, SizeOf(FourCC));
NumSamples := (SampleRate * Duration) div 1000;
DataSize := (BitsPerSample shr 3) * NumChannels * NumSamples;
ChunkSize := DataSize + SizeOf(TWaveFormatEx) + 20;
WaveStream.Write(ChunkSize, SizeOf(ChunkSize));
FourCC := 'WAVE';
WaveStream.Write(FourCC, SizeOf(FourCC));
FourCC := 'fmt ';
WaveStream.Write(FourCC, SizeOf(FourCC));
ChunkSize := SizeOf(TWaveFormatEx);
WaveStream.Write(ChunkSize, SizeOf(ChunkSize));
with Format do
begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := NumChannels;
nSamplesPerSec := SampleRate;
wBitsPerSample := BitsPerSample;
nBlockAlign := nChannels * wBitsPerSample shr 3;
nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
cbSize := 0
end;
WaveStream.Write(Format, SizeOf(Format));
FourCC := 'data';
WaveStream.Write(FourCC, SizeOf(FourCC));
ChunkSize := DataSize;
WaveStream.Write(ChunkSize, SizeOf(ChunkSize));
for I := 0 to 999 do
begin
Factor := Exp(- 0.005 * (1000 - I));
L := Round(Factor * 32767 * Sin(2 * Pi * LeftFreq * I / SampleRate));
R := Round(Factor * 32767 * Sin(2 * Pi * RightFreq * I / SampleRate));
WaveStream.Write(L, SizeOf(L));
WaveStream.Write(R, SizeOf(R))
end;
for I := 1000 to NumSamples - 1001 do
begin
L := Round(32767 * Sin(2 * Pi * LeftFreq * I / SampleRate));
R := Round(32767 * Sin(2 * Pi * RightFreq * I / SampleRate));
WaveStream.Write(L, SizeOf(L));
WaveStream.Write(R, SizeOf(R))
end;
for I := NumSamples - 1000 to NumSamples - 1 do
begin
Factor := Exp(0.005 * (NumSamples - 1001 - I));
L := Round(Factor * 32767 * Sin(2 * Pi * LeftFreq * I / SampleRate));
R := Round(Factor * 32767 * Sin(2 * Pi * RightFreq * I / SampleRate));
WaveStream.Write(L, SizeOf(L));
WaveStream.Write(R, SizeOf(R))
end;
WaveStream.Position := 0;
finally
WaveStream.Free
end
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CreateWave(500, 100, 1000, 'test.wav');
end;
Pohledem do části konstant zdrojového kódu si můžete všimnout, jaké parametry bude výsledný soubor mít.
Konkrétní příklad použití vidíte hned za procedurou v události OnClick tlačítka, kdy po jeho stisknutí bude vygenerován testovací soubor o délce jedné sekundy s příslušnými parametry pro levý a pravý kanál. Výsledný "zvuk" sice vzdáleně připomíná spíše nějaké vrčení elektromotoru, ale jsem si jist, že při troše experimentování něco zajímavého vytvoříte.

2008-06-15T01:24:00.000-07:00

Po spuštění naší ukázkové aplikace se vám zobrazí prázdný formulář. Stačí kliknout kamkoliv na jeho plochu a na tomto místě se vytvoří Label s jednoduchým textem, obsahující informace u původních souřadnicích textu (tedy před tím, než s ním začnete hýbat).
Jak vidíte, kód je uveden opět jako celá jednotka, takže stačí, když si vytvoříte nový projekt a celý tento kód umístíte do vytvořené jednotky. Pak již zbývá jen přiřadit událost OnClick formuláře a vše je hotovo.
Zkuste s kódem trošku experimentovat a uvidíte, že se dá tohoto jednoduchého postupu využít k různým účelům. Přesunovat takto můžete i jiné komponenty, třeba tlačítka, ale to již ponechám na vaší fantazii.

2008-06-09T23:12:00.001-07:00

Pro zvýšení "efektu" je barva Labelu během přetahování změněna na červenou (z původní modré). K přesunování textu můžete použít libovolné tlačítko na myši, ale pokud by vám to nevyhovovalo, jistě pro vás nebude problém kód upravit tak, aby přesun reagoval například jen na pravé tlačítko, neboť identifikace tlačítka je součástí parametrů procedur pro pohyb (či přesněji řečeno události pro stisk a uvolnění tlačítka). Do nich pak stačí vložit na začátek jednoduchou podmínku:
if Button = mbRight then
begin
.
.
.
end;
Do těla této podmínky pak vložíte zbytek kódu události.

2008-06-08T00:02:00.000-07:00

Po dvou dílech, ve kterých jsme se zabývali soubory MP3, se dnes podíváme opět na něco jiného. Tentokrát budeme pomocí myši posouvat text po formuláři.
Poněkud zamlžený úvod si hned podrobněji vysvětlíme. Příklad, který si teď ukážeme, bude dělat jednoduchou věc. Po kliknutí na formulář se na daném místě objeví textový popisek (Label). Tento Label pak budeme moci po formuláři libovolně přesunovat myší ve stylu drag and drop. Takovýchto Labelů si budete moci na formulář "naklikat" kolik budete chtít, protože jsou vytvářeny až za běhu programu.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;

type
TForm1 = class(TForm)
procedure FormClick(Sender: TObject);
private
{ Private declarations }
downX, downY: Integer;
dragging: Boolean;
procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure ControlMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

type
TMCapture = Class(TControl);

procedure TForm1.FormClick(Sender: TObject);
var
pt: TPoint;
begin
GetCursorPos( pt );
pt := ScreenToClient( pt );
with TLabel.Create( Self ) do
begin
SetBounds(pt.x, pt.y, width, height);
Caption := Format('Souřadnice %d, %d', [pt.x, pt.y]);
Color := clBlue;
Font.Color := clWhite;
Autosize := True;
Parent := Self;
OnMouseDown := ControlMouseDown;
OnMouseUp := ControlMouseUp;
OnMouseMove := ControlMouseMove;
end;
end;

procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
downX := X;
downY := Y;
dragging := True;
with TMCapture(Sender) do
begin
MouseCapture := True;
Color := clRed;
end;
end;

procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if dragging then
with Sender as TControl do
begin
Left := X - downX + Left;
Top := Y - downY + Top;
end;
end;

procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if dragging then
begin
dragging := False;
with TMCapture(Sender) do
begin
MouseCapture := False;
Color := clBlue;
end;
end;
end;

end.

2008-05-22T02:40:00.000-07:00

Pro výpis informací o souboru použijeme podobně jako minule opět komponentu Memo, takže i tu je třeba umístit na formulář.
Samotné zpracování načtených informací a jejich zobrazení budeme provádět v události OnClick komponenty FileListBox.
procedure TForm1.FileListBox1Click(Sender: TObject);
var
soubor: MPEG_Header;
f: file;
hlavicka: header_type;

begin
try
Assignfile(f, Filelistbox1.Filename);
Reset(f, 1);
blockread(f, hlavicka, SizeOf(hlavicka));
if not (hlavicka[0] <> 255) or ((hlavicka[1] or $1F) <> 255) then
begin
if ((hlavicka[1] and 16) shr 4) = 0 then soubor.version := 2
else soubor.version := (hlavicka[1] and 8) shr 3;
soubor.layer := 4 - ((hlavicka[1] and 6) shr 1);
soubor.protect := hlavicka[1] and 1;
soubor.bitrate := (hlavicka[2] and 240) shr 4;
soubor.samplerate := (hlavicka[2] and 12) shr 2;
soubor.padding := (hlavicka[2] and 2) shr 1;
soubor.extension := (hlavicka[2] and 1);
soubor.channelmode := (hlavicka[3] and 192) shr 6;
soubor.modeextension := (hlavicka[3] and 48) shr 4;
soubor.copyright := (hlavicka[3] and 8) shr 3;
soubor.original := (hlavicka[3] and 4) shr 2;
soubor.emphasis := (hlavicka[3] and 3);

Memo1.Clear;
Memo1.Lines.Add('MPEG ' + MPEG_version[soubor.version] + ' Layer ' + MPEG_layer[soubor.layer]);
Memo1.Lines.Add(IntToStr(MPEG_bitrates[soubor.version, soubor.layer-1, soubor.bitrate]) + ' kbps');
Memo1.Lines.Add(IntToStr(MPEG_frequencies[soubor.version, soubor.samplerate]) + ' Hz');
Memo1.Lines.Add(MPEG_channel[soubor.channelmode]);
Memo1.Lines.Add('Private : ' + MPEG_extension[soubor.extension]);
Memo1.Lines.Add('CRCs : ' + MPEG_protection[soubor.protect]);
Memo1.Lines.Add('Copyrighted : ' + MPEG_copyright[soubor.copyright]);
Memo1.Lines.Add('Original : ' + MPEG_original[soubor.original]);
Memo1.Lines.Add('Emphasis : ' + MPEG_emphasis[soubor.emphasis]);
end
else Memo1.Lines.Add('Chyba !!!!!');
except
end;
end;
Toto je tedy zhruba základ toho, co lze ze souboru MPEG vyčíst a co je asi pro běžného uživatele nejdůležitější. Pokud by vás zajímaly další informace, které se dají z MPEG souboru "vyždímat", odkáži vás pouze na internet jako zdroj informací. Nebudu vás směrovat na konkrétní stránku, aby to nedopadlo jako minule, ale tentokrát již třeba v době čtení tohoto článku bude www.id3.org fungovat, takže to zkuste například tam.

2008-05-19T04:02:00.000-07:00

Tipy a triky v Delphi

Minule jsem si slíbili, že si budeme povídat o souborech MPEG a jak získat z těchto souborů rozličné informace. Ukážeme si tedy, jak zjistit například vzorkovací frekvenci či datový tok a další základní informace.
Podobně jako v minulém díle, vytvoříme si nejprve základní struktury, které budou soubor MPEG (či přesněji jeho hlavičku) popisovat. Na rozdíl od minule, kdy jsme se zabývali ID3 popiskem a informace jsme prakticky rovnou načítali ze souboru, musíme si v tomto případě nejprve nadefinovat řadu konstant. Ty budou obsahovat jednak příslušné frekvence, datové toky a další informace, které jsou standardní a předem definované a každý soubor se dá zařadit do jedné z kolonek. Tyto konstanty tedy mohou vypadat například takto:
const
MPEG_version: array[0..2] of string = ('2', '1', '2.5');
MPEG_layer: array[0..3] of string = ('neznámý', 'I', 'II', 'III');
MPEG_protection: array[0..1] of string = ('Ano', 'Ne');
MPEG_frequencies: array[0..2, 0..3] of word = ((22050,24000,16000,0), (44100,48000,32000,0), (11025,12000,8000,0));
MPEG_bitrates: array[0..2,0..2,0..15] of word=
(((0,32,48,46,64,80,96,112,128,144,160,176,192,224,256,0),
(0, 8,46,24,32,40,48, 56, 64, 80, 96,112,128,144,160,0),
(0, 8,16,24,32,40,48, 56, 64, 80, 96,112,128,144,160,0)),

((0,32,64,96,128,160,192,224,256,288,320,352,384,416,448,0),
(0,32,48,56, 64, 80, 96,112,128,160,192,224,256,320,384,0),
(0,32,40,48, 56, 64, 80, 96,112,128,160,192,224,256,320,0)),

((0,32,48,46,64,80,96,112,128,144,160,176,192,224,256,0),
(0, 8,46,24,32,40,48, 56, 64, 80, 96,112,128,144,160,0),
(0, 8,16,24,32,40,48, 56, 64, 80, 96,112,128,144,160,0)));

MPEG_padding: array[0..1] of string = ('All bits in frame are used', 'Unused bits are filled');

MPEG_extension: array[0..1] of string = ('Ne','Ano');

MPEG_channel: array[0..3] of string = ('Stereo', 'Joint stereo', 'Dual channel', 'Mono');

MPEG_modeext: array[0..3,0..3] of word =
((4,8,12,16),
(4,8,12,16),
(0,4,8,16),
(0,0,0,0));

MPEG_copyright: array[0..1] of string = ('Ne','Ano');

MPEG_original: array[0..1] of string = ('Ne','Ano');

MPEG_emphasis: array[0..3] of string = ('None','50/15 microseconds','Unknown','CITT j.17');
Nyní je třeba si nadefinovat strukturu pro vlastní hlavičku MPEG souboru a její typ, kterou lze popsat kupříkladu takovýmto záznamem:
MPEG_header = record
version,
layer,
protect,
bitrate,
samplerate,
padding,
extension,
channelmode,
modeextension,
copyright,
original,
emphasis:byte;
end;

header_type = array[0..3] of byte;
A teď již zbývá jen informace z jednotlivých souborů MP3 načíst do předem připravených struktur, zařadit je podle definovaných konstant do příslušné kategorie, zpracovat a výsledek zobrazit. Abychom si náš příklad usnadnili, použijeme pro celé rozhraní procházení disků, složek a souborů komponenty ze záložky Win 3.1, konkrétně tedy komponenty DriveComboBox, DirectoryListBox a FileListBox. Ty navzájem "propojíme" v Object Inspectoru jejich vlastnostmi tak, jak je běžně zvykem, tedy aby se změna v jedné komponentě interaktivně projevila i v komponentách ostatních.

2008-05-15T07:43:00.000-07:00

Nyní jsme tedy již teoreticky připraveni a můžeme se pustit do samotné implementace načítání tagů v Delphi. Věřím, že většina z vás by již tuto fázi zvládla bez problému sama, ale pro úplnost si uvedeme ukázkový kód. V něm si nejprve nadefinujeme strukturu záznamu pro ID3 tag a dále pak jednoduchou funkci pro načítání tagu ze souboru. Na formulář dále umístěte tlačítko, dialog pro otevření souboru a komponentu Memo pro výpis tagu. Samotné načítání umístíme do události OnClick tlačítka a zde bude zároveň i výpis.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

TagRecord = record
Header: array [1..3] of Char;
Title: array [1..30] of Char;
Artist: array [1..30] of Char;
Album: array [1..30] of Char;
Year: array [1..4] of Char;
Comment: array [1..30] of Char;
Genre: Byte;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function ReadTag(const FileName: string; var TagData: TagRecord): Boolean;
var
SourceFile: file;
begin
try
Result := true;
AssignFile(SourceFile, FileName);
FileMode := 0;
Reset(SourceFile, 1);
Seek(SourceFile, FileSize(SourceFile) - 128);
BlockRead(SourceFile, TagData, 128);
CloseFile(SourceFile);
except
Result := false;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Tag: TagRecord;
begin
OpenDialog1.Execute;
if OpenDialog1.FileName <> '' then ReadTag(OpenDialog1.FileName, Tag);
if Tag.Header = 'TAG' then
begin
Memo1.Clear;
Memo1.Lines.Add('Titulek: ' + TrimRight(Tag.Title));
Memo1.Lines.Add('Interpret: ' + TrimRight(Tag.Artist));
Memo1.Lines.Add('Album: ' + TrimRight(Tag.Album));
Memo1.Lines.Add('Rok: ' + TrimRight(Tag.Year));
if ((Tag.Comment[29] = #0) and (Tag.Comment[30] <> #0)) or ((Tag.Comment[29] = #32) and (Tag.Comment[30] <> #32)) then
begin
Memo1.Lines.Add('Komentář: ' + TrimRight(Copy(Tag.Comment, 1, 28)));
Memo1.Lines.Add('Číslo stopy: ' + IntToStr(Ord(Tag.Comment[30])));
end
else
Memo1.Lines.Add('Komentář: ' + TrimRight(Tag.Comment));
end;
end;

end.
Pozornější z vás si jistě všimli, že jsem "takticky" vynechal položku žánr. Ten se samozřejmě během načítání rovněž ze souboru načte a uloží do záznamu Genre, ale v podobě čísla, které danému žánru odpovídá a jeho slovní vyjádření je nutné najít v příslušné tabulce (viz. úvodní text). Abych výsledný kód příliš nekomplikoval a neprodlužoval (žánrů je celkem 147), rozhodl jsem se tuto položku vynechat a opět vás musím odkázat na adresu, kde tyto hodnoty a jejich slovní vyjádření naleznete.
To bude pro dnešek vše a příště pravděpodobně ještě u MP3 souborů zůstaneme a povíme si něco o jeho vlastnostech, přesněji řečeno, jak tyto vlastnosti ze souborů získat.

2008-05-02T03:42:00.000-07:00

Dnes se budeme pro začátek zabývat první verzí tagu a časem se možná dostane i na verzi 2, i když to by si již vyžádalo poněkud komplexnější vysvětlování. Ale uvidíme časem. Dnes tedy verze 1.
Jak již bylo řečeno, nachází se na konci souboru a má přesně 128 bajtů. Je pochopitelné, že do takového malého prostoru příliš informací neuložíme, ale něco přeci. Popišme si tedy blíže strukturu tohoto tagu. První tři bajty tvoří vždy slovo TAG a je to vlastně jeden ze znaků, podle kterého se dá testovat, zda soubor tag obsahuje nebo ne. Dalších 30 bajtů tvoří titulek skladby, pak následuje 30 bajtů pro název skupiny či umělce a dále rovněž 30 bajtů pro název alba. Následují 4 bajty pro rok vydání skladby, poté opět 30 bajtů - tentokrát pro komentář a poslední bajt obsahuje žánr skladby. Časem byl tento formát ještě drobně rozšířen (někdy pak bývá označován jako verze 1.1) o parametr čísla skladby. Velikost takového tagu je však stejná, pouze se drobně ukrojil prostor pro komentář. Platí pak pravidlo, že pokud je předposlední bajt komentáře nulový a poslední bajt naopak různý od nuly, vyjadřuje právě tento poslední bajt číslo skladby. Ještě je potřeba vysvětlit, jak je vyřešena otázka žánru. Na něj je vyhrazen pouhý jeden bajt, ale jak jistě dobře víte například při prohlížení detailních informací o souboru ve Winampu, názvy žánrů jsou pochopitelně slovní. Toho je docíleno celkem jednoduše tím, že je předem určena v normě ID3 množina definovaných žánrů se svými čísly. Každý program, který tedy s ID3 tagy pracuje, tuto tabulku v sobě obsahuje a ze souboru je pouze načten identifikující bajt.
Tolik tedy teorie a pokud byste chtěli o tomto tématu získat další znalosti, navštivte tuto adresu.

2008-04-25T23:16:00.000-07:00

Jak vidíte, ještě než dojde k samotnému testování a případnému přesouvání (přichycování) okna, uloží se nejprve původní rozměry okna, které jsou na konci celé procedury opět na okno aplikovány. Kdyby jsme to neudělali, okno by mělo tendenci během přichycování či "odtrhávání" od okraje plochy měnit svoje rozměry.
Příklad je tedy velmi jednoduchý a jistě sami přijdete na mnohá zlepšení. Určitě by se například slušelo uložit hodnoty tolerance okrajů do konstant pro snadnější modifikaci. Další drobná vada, kterou byste časem jistě objevili, je to, že pokud změníte polohu nabídky Start až po spuštění aplikace, nebude se k menu přichytávat správně. To je celkem samozřejmé, protože rozměry plochy zjišťujeme v události OnCreate. Pokud by tedy přichytávání mělo být ještě o něco dokonalejší, museli bychom hlídat i případnou změnu polohy nabídky Start (či její automatické schovávání) a také rozlišení obrazovky. Ale to již ponechám na vašem uvážení a každý jistě zvládne úpravu kódu tak, jak bude potřebovat.

2008-04-19T01:23:00.000-07:00

Kromě samotné procedury, která hlídá pohyb okna, ještě přidáme do programu jeden krátký řádek kódu do události OnCreate formuláře. Ten zjistí rozměry pracovní plochy, abychom věděli, jestli se okno aplikace přiblížilo k okraji nebo ne. Zároveň se tím vyřeší i "problém" s nabídkou Start a bez ohledu na to, na kterém okraji plochy ji máte umístěnu a zda máte nastaveno automatické schovávání, okno naší aplikace se k ní stejně přichytí.
Celý kód jednoduchého formuláře, který se přichycuje k okrajím plochy, tedy vypadá takto:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TWMMoving = record
Msg: Cardinal;
Side: Longint;
Coord: PRect;
Unused: longint;
end;

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure WMMoving(var Message: TWMMoving); message WM_MOVING;
public
{ Public declarations }
Desktop: TRect;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMMoving(var Message: TWMMoving);
var
OriginalWidth, OriginalHeight: integer;
begin
OriginalWidth := Width;
OriginalHeight := Height;
if (WindowState = wsNormal) and Visible then
begin
if (Message.Coord.Left < (Desktop.Left + 10)) then Message.Coord.Left := Desktop.Left;
if (Message.Coord.Top < (Desktop.Top + 10)) then Message.Coord.Top := Desktop.Top;
if (Message.Coord.Bottom > (Desktop.Bottom - 10)) then Message.Coord.Top := Desktop.Bottom - Height;
if (Message.Coord.Right > (Desktop.Right - 10)) then Message.Coord.Left := Desktop.Right - Width;
end;
Message.Coord.Right := Message.Coord.Left + OriginalWidth;
Message.Coord.Bottom := Message.Coord.Top + OriginalHeight;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @Desktop, 0);
end;

end.

Tipy a triky v Delphi

2008-04-09T03:00:00.000-07:00

Tipy a triky v Delphi,

Dnes budeme přichytávat okno formuláře k okrajím pracovní plochy. Tato funkce se stává poměrně oblíbeným vylepšením uživatelského prostředí řady programů a proto si ukážeme, jak na to.
Věřím, že jistě všichni víte, o čem je vlastně řeč. Mnoho programů (namátkou třeba populární Winamp) umožňuje uživateli nastavit, že když přesouváte okno aplikace po pracovní ploše a přiblížíte se k některému okraji, okno aplikace se automaticky "přichytí" k tomuto okraji. Pokud tedy chce uživatel umístit okno například do pravého horního rohu pracovní plochy, nemusí se složitě strefovat a má práci velmi usnadněnou. Přesně touto funkcí se dnes budeme zabývat.
Celá věc se dá udělal různými způsoby (jako ostatně většina věcí), ale jako obvykle jsem se snažil o pokud možno co nejjednodušší a také nejkratší kód. Slovní popis celého principu je poměrně logický a jasný. Sledujeme pohyb okna (prostřednictvím zpráv systému) a když se okno přiblíží k některému z okrajů plochy na námi definovanou vzdálenost (v našem případě je to 10 bodů), posuneme okno tak, aby se daného okraje dotýkalo (přichytíme jej).

2008-04-07T04:23:00.000-07:00

procedure TForm1.FileListBox1Change(Sender: TObject);
begin
Label1.Caption := '';
Label2.Caption := '';
Label3.Caption := '';
Label4.Caption := '';
Label5.Caption := '';
if FileListBox1.FileName <> '' then
begin
ReadWAV(FileListBox1.FileName, soubor);
if HeaderOK(soubor) then
begin
Label1.Caption := 'Hlavička souboru v pořádku - soubor rozpoznán';
case Soubor.FormatID of
1: Label2.Caption := 'Windows PCM';
2: Label2.Caption := 'Microsoft ADPCM';
6: Label2.Caption := 'A-LAW';
7: Label2.Caption := 'MU-LAW';
17: Label2.Caption := 'DVI/IMA ADPCM';
85: Label2.Caption := 'MPEG Layer III';
else
Label2.Caption := 'Neznámý formát';
end;

case Soubor.ChannelNumber of
0: Label3.Caption := 'Neznámý typ';
1: Label3.Caption := 'Mono';
2: Label3.Caption := 'Stereo';
end;

Label4.Caption := IntToStr(Soubor.BitsPerSample) + ' bit';
Label5.Caption := IntToStr(Soubor.SampleRate) + ' Hz';
end
else
Label1.Caption := 'Hlavička souboru není v pořádku - soubor nerozpoznán';
end;
end;
A to je pro dnešek vše. V některém z příštích dílu se určitě také podíváme na další zvukové formáty jako třeba MP3. Tento díl je zároveň první, ve kterém jsem se pokusil na základě reakcí některých čtenářů zlepšit čitelnost kódu zvýrazněním klíčových slov. Pokud vaše ohlasy budou kladné, začneme s tím od příště natrvalo.

2008-04-02T04:12:00.000-07:00

except
Result := false;
end;
end;
Ještě než se dostaneme k samotnému zpracování načtených dat a jejich zobrazení, vytvoříme si jednoduchou funkci, která nám otestuje hlavičku souboru a zjistí, zda je platná či ne a jestli má tím pádem smysl, pokoušet se vypisovat nějaké informace. Funkci pak poté využijeme v další části kódu.
function HeaderOK(const WAVData: WAVRecord): Boolean;
begin
Result := true;
if WAVData.RIFFHeader <> 'RIFF' then Result := false;
if WAVData.WAVEHeader <> 'WAVE' then Result := false;
if WAVData.FormatHeader <> 'fmt ' then Result := false;
if (WAVData.ChannelNumber <> 1) and (WAVData.ChannelNumber <> 2) then Result := false;
end;
A teď už se konečně dostáváme k výpisu informací na obrazovku. Jak jsme si řekli na začátku, výpis bude součástí události OnChange komponenty FileListBox. Když se podíváte na strukturu načítaných dat na začátek článku a porovnáte s těmi daty, které vypisujeme, jistě vidíte, že jsme nepoužili všechny možnosti, ale nechtěl jsem ukázku příliš prodlužovat. Myslím, že struktura záznamu je svými názvy dostatečně popsána a tak pro vás nebude problém vypsat i další informace. Proto jsou v našem příkladu převážně ty údaje, které jsou vlastně konstantami (a asi by se slušelo je jako konstanty nadefinovat, tak promiňte to zjednodušení). Vše ostatní již z názvů v záznamu pochopíte.

2008-03-27T04:22:00.000-07:00

Nyní můžeme začít vytvářet naší ukázkovou aplikaci. Na prázdný formulář tedy nejprve umístíme tři komponenty, které se nám postarají o procházení adresáři a disky. Kvůli zjednodušení můžeme použít například komponenty FileListBox, DirectoryListBox a DriveComboBox ze záložky Win 3.1 na paletě komponent. Komponenty pak navzájem "propojíme" běžným způsobem nastavením vlastností v Object Inspectoru tak, aby se změna disku či složky automaticky projevila i na výpis souborů a souborovou masku omezíme na soubory WAV.
Pro výpis informací, získaných ze souborů, můžeme použít například Label, respektive jejich větší množství (podle toho kolik a jaké informace budeme vypisovat), ale použít můžete pochopitelně cokoliv, to již nechám na vás. Samotné načtení a zobrazení informací pak umístíme do události OnChange komponenty FileListBox.
A to už se tedy postupně dostáváme k samotnému výpisu informací. Nejdříve si ještě nadefinujeme globální proměnnou, do které budou data načítána a poté již následuje vlastní funkce pro čtení dat ze souboru:
.
.
var
soubor: WAVrecord;
.
.

function ReadWAV(const FileName: string; var WAVData: WAVrecord): Boolean;
var
SourceFile: file;
begin
try
Result := true;
AssignFile(SourceFile, FileName);
FileMode := 0;
Reset(SourceFile, 1);
BlockRead(SourceFile, WAVData, 40);
if WAVData.DataHeader <> 'data' then
begin
Seek(SourceFile, WAVData.FormatSize + 28);
BlockRead(SourceFile, WAVData.SampleNumber, 4);
end;
CloseFile(SourceFile);

Tipy a triky v Delphi

2008-03-25T04:26:00.000-07:00

Tipy a triky v Delphi

Tématem dnešního dílu budou soubory WAVE. Nebudeme je sice přehrávat, to není až zas tak velký problém, ale naučíme se zjišťovat o nich různé užitečné informace jako je typ, délka, frekvence a mnoho dalších.
Soubory WAVE jsou alespoň na platformě Windows oblíbeným a celkem dlouhá léta standardním formátem pro ukládání zvukových dat. Hudbu máte sice pravděpodobně uloženu v jiném formátu kvůli úspoře místa, ale například pro nahrávání zvuků (hudby) z nějakého externího zdroje a následnou editaci je to celkem použitelný formát, který zvládá snad každý zvukový editor a můžete tak bez ztráty kvality zvuky upravovat. Až poté je teprve převedete do nějakého úspornějšího formátu (MP3, WMA a podobně). Rovněž rozličné systémové zvuky či zvuky v aplikacích jsou uloženy v tomto formátu. Proto jistě nebude na škodu, když si teď ukážeme, jak získat z hlavičky souboru některé zajímavé údaje a vlastnosti souboru.
Nejprve si vytvoříme datovou strukturu, do které tyto informace z hlavičky načteme. Můžeme k tomu využít například záznam (record) a ten bude vypadat takto:
.
.
type
WAVrecord = record
RIFFHeader: array [1..4] of Char;
FileSize: Integer;
WAVEHeader: array [1..4] of Char;
FormatHeader: array [1..4] of Char;
FormatSize: Integer;
FormatID: Word;
ChannelNumber: Word;
SampleRate: Integer;
BytesPerSecond: Integer;
BlockAlign: Word;
BitsPerSample: Word;
DataHeader: array [1..4] of Char;
SampleNumber: Integer;
end;
.

2008-03-19T05:47:00.000-07:00

if Pos(uppercase('soname'),exestring) > 0 then
begin
Extract('soname','eoname',ExeString,Temp);
SpeedButton1.Caption := 'Program je registrován na: '+Temp;
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
MyStream: TMemoryStream;
MyFile,newname: string;
A,B: Integer;
begin
If Speedbutton1.Caption <> 'Napište vaše jméno a klikněte sem pro registraci' then exit;
if edit1.text = '' then
begin
showmessage('Vložte prosím vaše jméno !');
exit;
end;
MyStream := TMemoryStream.Create;
try
ExeString := ExeString + uppercase('soname') + Edit1.Text + uppercase('eoname');
MyStream.Clear;
MyStream.WriteBuffer(Pointer(ExeString)^, Length(ExeString));
newname := application.exename;
Insert('_clone',newname,length(application.exename)-3);
MyStream.savetofile(newname);
finally
MyStream.Free;
end;
ShellExecute(Handle, 'open', pchar(newname), nil, nil, SW_SHOWNORMAL);
application.terminate;
end;

end.
Zdrojový program aplikace si ukazujeme celý, pěkně od začátku až do konce, aby nedošlo k nějakým nejasnostem. Zdrojový kód jsem nechal tentokrát téměř beze změn, tak jak se mi dostal do rukou.
Možná jste si všimli, že je opět použita jedna z variant procedury Delay. Je použita proto, aby v kritické fázi mazání jednoho souboru a spouštění jiného nedošlo ke vzájemné kolizi, ke které může dojít. Proto je vložena půlsekundová pauza.
Místo ve zdrojovém kódu, které je výrazně orámováno lomítky, obsahuje ten kód, který bude proveden v tom případě, že již došlo k úspěšné registraci (a v této fázi již by měl být tedy na disku pouze výsledný modifikovaný soubor). Sem tedy vložte ten kód, který má reagovat na tuto situaci. V naší ukázce dojde jednak k zneviditelnění komponenty Edit, protože ta již není potřeba, a pak je ještě změněna barva formuláře.
Co říci na úplný závěr? Vzhledem ke způsobu manipulace se soubory, jejich kopírování a mazání nebude zřejmě příliš vhodné tento postup použít pro velmi velké soubory. A i při použití pro menší soubory nelze vyloučit za určitých extrémních podmínek možné selhání, ale to je riziko každého podobného krkolomného postupu. Pokud však nemáte jinou možnost, račte vyzkoušet...

2008-03-17T03:10:00.000-07:00

procedure TForm1.FormCreate(Sender: TObject);
Var
MyStream: TMemoryStream;
name,C,Temp: String;
D,E: integer;
begin
exe2String(ExeString);
if pos(uppercase('soname'),exestring) > 0 then
begin
delay(500);
if pos('_clone',application.exename) = 0 then
begin
name := application.exename;
Insert('_clone',name,(length(name)-3));
deletefile(name);
end;
////////////////////////////////////////////////////////////////////////////////
edit1.visible := false;
form1.color := $00c6aa84;
////////////////////////////////////////////////////////////////////////////////
end;

if pos('_CLONE',uppercase(application.exename)) <> 0 then
begin
delay(500);
name := application.exename;
Delete(name,length(name)-9,6);
if deletefile(name) then
begin
MyStream := TMemoryStream.Create;
try
MyStream.WriteBuffer(Pointer(ExeString)^, Length(ExeString));
MyStream.savetofile(name);
finally
MyStream.Free;
ShellExecute(Handle, 'open', pchar(name), nil, nil, SW_SHOWNORMAL);
application.terminate
end;
end
else showmessage(name+' nenalezen');
end;

2008-03-13T05:37:00.000-07:00

• pokud se již nejedná o dočasný klon, program smaže v daném adresáři všechny soubory, které mají v názvu _CLONE (tím vlastně provede závěrečný úklid) a postup je u konce
• jestliže se jedná o klon, je nejprve smazán z disku originální program, poté uložen na disk modifikovaný soubor pod původním názvem, ten je spuštěn a klon se sám ukončí
• spuštěný finální soubor se postará o smazání klonu (viz. o dva body výše)
Doufám, že je teď již postup zcela jasný a můžeme si tedy ukázat zdrojový kód. Příklad předpokládá, že na formuláři budete mít jeden Edit pro zadávání jména a dále pak SpeedButton, po jehož stisku dojde k registraci - spustí se modifikace souboru:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, StdCtrls,ShellAPI, ExtCtrls, Mask;

type
TForm1 = class(TForm)
SpeedButton1: TSpeedButton;
Edit1: TEdit;
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
ExeString: String;

implementation

{$R *.DFM}

procedure Extract(A,B: String;Var C,D: String);
Var
E,F: Integer;
begin
if Pos(uppercase(A),C) > 0 then
begin
E := Pos(uppercase(A),C)+length(A);
F := Pos(uppercase(B),C);
D := Copy(C,E,F-E);
end;
end;

procedure Exe2String(var A:String);
Var
ExeStream: TFileStream;
MyStream: TMemoryStream;
begin
ExeStream:=TFileStream.Create(Application.ExeName,fmOpenRead or fmShareDenyNone);
Try
SetLength(A, ExeStream.Size);
ExeStream.ReadBuffer(Pointer(A)^, ExeStream.Size);
Finally
ExeStream.Free;
end;
end;

procedure Delay(ms : longint);
var
TheTime : LongInt;
begin
TheTime := GetTickCount + ms;
while GetTickCount < TheTime do Application.ProcessMessages;
end;

Tipy a triky v Delphi

2008-03-11T02:26:00.000-07:00

Tipy a triky v Delphi, díl 53.
14. 8. 2002, Jan Šindelář formát pro tisk
Tématem dnešního dílu bude poněkud kontroverzní záležitost, protože se pokusíme modifikovat soubor aplikace přímo za jejího běhu.
Jistě vás napadlo, že běžným způsobem to nepůjde, protože běžící program by vám neměl operační systém v žádném případě dovolit jakkoliv pozměňovat či mazat z disku a také vám to nedovolí. Způsobů, jak toto omezení obejít, lze určitě vymyslet několik, ale vždy se bude jednat o ne příliš obvyklý způsob a proto berte i čistotu dnešního zdrojového kódů poněkud tolerantněji.
Ale zpět k našemu příkladu. Jistou možností je vytvořit za běhu aplikace její upravenou kopii a původního souboru se poté zbavit například tím, že do registru systému vložíme příkaz k jeho vymazání po dalším restartu Windows. Jistě víte, že podobný způsob využívají například instalační programy, které se tak zbavují těch částí programu, které nemohly být z určitého důvodu ukončeny (a smazány) v době odinstalace aplikace. Způsob je to jistě korektní a čistý, ale má tu nevýhodu, že tento efekt změny není okamžitý a je závislý právě na restartu systému. Proto si ukážeme jiný postup, který bude mít okamžitý efekt, ale nebude tak způsobný, jako postup předchozí.
Než si ukážeme zdrojový kód, je třeba si slovně popsat celý princip. Věc není komplikovaná, ale je potřeba si ujasnit jisté situace, které mohou nastat a které jsou pro příklad klíčové. Velmi zkráceně řečeno je postup takový, že se vytvoří kopie běžící aplikace, která bude poté uložena na disk v již pozměněné podobě a pochopitelně pod jiným názvem. Tato nová aplikace bude poté spuštěna, původní aplikace se ukončí a bude novou aplikací z disku smazána. Nyní již zbývá jen poslední věc a tou je název nově vzniklé aplikace. Ten je totiž jiný, než byl u aplikace původní, protože jsme pochopitelně nemohli uložit na disk dva soubory téhož názvu. A proto si postup ještě jednou zopakujeme. Opět uložíme kopii souboru na disk, ale tentokrát již pod původním názvem, tato další nová aplikace bude opět spuštěna a postará se o smazání "dočasné" aplikace. Tím je celý postup u konce a na disku (a běžící v paměti) je teď již pouze modifikovaná aplikace s původním názvem. Celé to trošku připomíná jeden ze základních programátorských postupů výměny hodnot dvou proměnných, která se udělá pomocí proměnné třetí (tedy, jak možná víte, ono to jde udělat i bez pomocné proměnné, ale to teď nechme stranou).
Celá věc má ještě několik drobných fint, které by nemusely být ze zdrojového kódu hned jasné a tak si je teď ještě musíme vysvětlit. Příklad, který naleznete v závěru článku, řeší s využitím výše popsaného postupu jednoduchou registraci uživatele. Při prvním spuštění bude uživatel požádán o vložení jeho jména. Toto jméno bude poté uloženo přímo do aplikace modifikací jejího souboru a nemusí tak být uloženo v registrech nebo INI souboru. Když bude poté taková aplikace spuštěna, "pozná" že již byla registrována a tato úvodní procedura bude přeskočena. Toto uživatelské jméno bude uloženo na samém konci souboru mezi "klíčová" slova SONAME a EONAME. Tato slova jsou tam právě proto, aby aplikace při svém znovuspuštění poznala, zda již došlo k registraci a můžete si je dle potřeby změnit.
Znovu si tedy popišme celý postup, tentokrát již jen heslovitě:
• aplikace je spuštěna a podle toho, zda najde na svém konci jméno uživatele mezi speciálními klíčovými slovy pozná, zda má spustit registrační proceduru nebo ne
• pokud k registraci ještě nedošlo, uživatel je požádán o vložení jména
• poté dojde k převedení celého souboru aplikace na string, na jehož konec bude přidáno jméno uživatele spolu s klíčovými slovy
• tento soubor je uložen pod dočasným názvem (k originálnímu názvu je přidáno _CLONE), tato nová aplikace je spuštěna a původní se sama ukončí
• takto vzniklý modifikovaný klon nejprve zjistí, jestli již došlo k registraci a pokud ano, snaží se zjistit, zda je klon a nebo finální program (to pozná ze svého jména)

Stav modemu

2008-03-04T05:40:00.000-08:00

Stav modemu
I druhý dnešní tip souvisí s modemem. Tentokrát si ukážeme, jak zjistit některé jeho stavové informace. Opět je třeba specifikovat COM port a celá struktura procedury je dost podobná předchozímu příkladu. Výsledný stav je poté vypsán v jednoduchém dialogu.
procedure TForm1.Button1Click(Sender: TObject);
var
CommPort : string;
hCommFile : THandle;
ModemStat : DWord;
begin
CommPort := 'COM3';
hCommFile := CreateFile(PChar(CommPort), GENERIC_READ, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hCommFile = INVALID_HANDLE_VALUE then
begin
ShowMessage('Nelze otevřít '+ CommPort);
exit;
end;

if GetCommModemStatus(hCommFile, ModemStat) then
begin
if ModemStat and MS_CTS_ON <> 0 then ShowMessage('The CTS (clear-to-send) is on.');
if ModemStat and MS_DSR_ON <> 0 then ShowMessage('The DSR (data-set-ready) is on.');
if ModemStat and MS_RING_ON <> 0 then ShowMessage('The ring indicator is on.');
if ModemStat and MS_RLSD_ON <> 0 then ShowMessage('The RLSD (receive-line-signal-detect) is on.');
end;

CloseHandle(hCommFile);
end;
Zjištění stavu modemu nějaký čas zabere (u mě okolo dvou sekund), takže nepanikařte, pokud se výsledek nezobrazí ihned. Text (tedy stav), který se zobrazí jako výsledek, jsem tentokrát nepřekládal, protože by to mohlo být spíše kontraproduktivní a věřím že ti, kteří tento tip budou zkoušet, ví o co jde a dají přednost původním termínům.

2008-02-22T14:21:00.000-08:00

Telefonní číslo v naší ukázce následuje v příslušné proměnné za znaky ATDT a pro názornost je použito smyšlené mobilní číslo. Pro lepší použitelnost by bylo pochopitelně lepší umožnit zadávání čísla například přes Edit. Totéž se týká COM portu.

2008-01-12T10:37:00.001-08:00

var
hCommFile : THandle;
.
.
.

procedure TForm1.Button1Click(Sender: TObject);
var
PhoneNumber : string;
CommPort : string;
nw : Cardinal;
begin
PhoneNumber := 'ATDT 0603123456' + #13 + #10;
CommPort := 'COM3';
hCommFile := CreateFile(PChar(CommPort), GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
if hCommFile=INVALID_HANDLE_VALUE then
begin
ShowMessage('Nelze otevřít '+ CommPort);
exit;
end;
nw := 0;
if not WriteFile(hCommFile, PChar(PhoneNumber)^, Length(PhoneNumber), nw, nil) then ShowMessage('Nelze komunikovat přes ' + CommPort);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
CloseHandle(hCommFile);
end;

Vytočení telefonního čísla

2007-12-15T04:41:00.000-08:00

Máte-li modem, můžete si vyzkoušet následující příklad. Ukážeme si, jak prostřednictvím modemu a jeho AT příkazů vytočit libovolné telefonní číslo a samozřejmě také jak spojení ukončit. Musíte samozřejmě toto číslo specifikovat v programu a dále je též nutné v programu určit, na jakém portu máte modem, protože v tak kratičkém příkladu pochopitelně není autodetekce. Samotný kód je jako obvykle "přilepen" na událost stisku tlačítka, přesněji řečeno dvou tlačítek. První tlačítko se pokusí vytočit číslo a navázat spojení. Nejprve zkusí otevřít příslušný COM port, poté se pokusí vytočit číslo a pokud vše proběhne v pořádku, spojení je navázáno. Druhé tlačítko slouží k ukončení "hovoru".

2007-12-13T03:19:00.000-08:00

A to už se pomalu blížíme k závěru. Nyní již zbývá jen několik drobností. V okně Object Inspectoru můžete nastavit u modulu apletu několik vlastností. První je vlastnost AppletIcon, která určuje ikonu apletu, jež bude zobrazena v Ovládacích panelech. Caption zase určuje popisek, který je u ikony zobrazen. Důležitá je též položka Help, kam můžete napsat krátký popis apletu a tento text bude zobrazen v levé části okna Ovládacích panelů po označení vašeho apletu.
Zbývá nám poslední věc a tou je testování celého projektu. Pokud jste se již při tvorbě pokusili projekt spustit, jistě se vám ukázalo chybové hlášení o nutnosti specifikovat hostitelskou aplikaci. Je to samozřejmé, protože jak již bylo řečeno na začátku, nejedná se o klasickou aplikaci, ale vlastně o knihovnu. Proto z menu Run vyberte položku Parameters. Zde v prvním řádku Host Application vyplňte c:\windows\rundll32.exe (pro systémy na bázi NT c:\winnt\system32\rundll32.exe), do druhého řádku pak shell32.dll,Control_RunDLL c:\aplet.cpl (cestu samozřejmě nastavte k vašemu apletu).
Nyní již můžete programovat aplikaci způsobem, na který jste zvyklí. Na vizuální formulář můžete pochopitelně běžným způsobem přidávat komponenty a doplnit samotný funkční kód daného apletu. Když budete s prací hotovi, stačí výsledný soubor cpl zkopírovat do systémového adresáře Windows a po aktivaci okna Ovládacích panelů například z menu Start byste již váš aplet měli vidět.
Celá problematika programování aplikací Ovládacích panelů je pochopitelně mnohem rozsáhlejší a lze využívat řady dalších pokročilejších funkcí. Proto berte tento dnešní tip jako spíše takový úvod do vašeho vlastního experimentování.

2007-11-24T02:52:00.001-08:00

Začněme tedy pěkně od začátku. Možná víte, že tyto speciální aplikace nejsou spustitelné exe soubory, mají koncovku cpl a jedná se v podstatě od knihovny podobě jako dll. Tyto aplety se vytvářejí v Delphi poměrně snadno, i když je postup mírně odlišný od tvorby běžné aplikace. Začneme tím, že založíme nový projekt. Z menu File vybereme klasicky položku New a v zobrazeném dialogu najdeme a vybereme typ Control Panel Application. Hned si můžete všimnout, že nově vytvořené soubory se drobně liší od těch klasických aplikačních. První rozdíl je v tom, že v projektovém souboru nenajdeme klasický termín Program, ale místo toho se zde nalézá označení library. Vytvořená jednotka a její hlavní objekt pak není třídy TForm, ale TAppletModule. Proto se vám také neobjevilo obvyklé okno formuláře, na které lze umisťovat další komponenty, ale místo toho vidíte jiný typ formuláře, který je však nevizuální (tj. po spuštění apletu nebude vidět) a jeho úkolem je "pouze" zprostředkování událostí. Proto je nutné vytvořit ještě běžný typ formuláře typu TForm, který přidáme do projektu a bude vlastně tvořit samotné uživatelské rozhraní apletu. Vytvořte tedy takový formulář a odkaz na jeho jednotku musíte přidat do řádku uses u jednotky apletu. Celý kód pak tedy vypadá kupříkladu takto:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
CtlPanel, unit2;

type
TAppletModule1 = class(TAppletModule)
procedure AppletModuleActivate(Sender: TObject; Data: Integer);
private
{ private declarations }
protected
{ protected declarations }
public
{ public declarations }
end;

var
AppletModule1: TAppletModule1;

implementation

{$R *.DFM}

end.

Nyní je potřeba zajistit, aby se po spuštění apletu tento nově přidaný formulář zobrazil. K tomu použijeme událost OnActivate modulu apletu:

procedure TAppletModule1.AppletModuleActivate(Sender: TObject; Data: Integer);
begin
Form2 := TForm2.Create( self );
Form2.ShowModal;
Form2.Free;
end;

Ovládací panely

2007-11-13T09:35:00.000-08:00

Jak jistě dobře víte, Ovládací panely Windows obsahují řadu různých drobných aplikací, jejichž náplní práce je nastavení vlastností všech možných částí systému od myši až po sítě a databáze. Jistě jste si také všimli, že kromě těchto základních "aplikací" (ne vždy se jedná o samostatnou aplikaci v pravém slova smyslu), které jsou nainstalovány společně se systémem, se zde po nainstalování některých dalších aplikací objeví nové ikonky. Typickým zástupcem mohou být třeba přímo Delphi, které sem umístí odkaz na BDE Administrator, ale i řada dalších programů (namátkou třeba známá Sisoft Sandra, programy od Symantecu, Adobe a další). Cokoliv tedy nějakým způsobem souvisí s nastavením systému, má své sídlo zde a pokud vytváříme aplikaci tohoto typu, jistě by bylo vhodné umístit ji rovněž sem právě v podobě aplikace pro Ovládací panely.

2007-11-12T03:57:00.000-08:00

Dnešní díl bude poněkud netradiční, protože se trochu ohlédneme zpátky a uděláme si malý přehled toho, o čem jsme si až doposud povídali. Ano, je tomu již skoro přesně na den rok, co vyšel první díl našeho seriálu a tak je na čase udělat malou rekapitulaci. Přehledný obsah celého seriálu, tedy seznam všech tipů, bude náplní dnešního jubilejního dílu.
Doufám, že vám tento přehled pomůže alespoň k částečné orientaci a lépe se vám bude hledat ten tip, který zrovna potřebujete. Mnoho z vás mě žádá, zda by nešel celý seriál zabalit, aby se dal stáhnout ve formě jednoho souboru. Tím vám sice dnes nemohu sloužit, ale uvidíme do budoucna. Zatím se spokojte alespoň s tímto seznamem. Ale dost zbytečných řečí, přehled právě začíná...

Test rozbaleni Treeview

2007-11-07T00:44:00.000-08:00

I druhý dnešní tip se bude týkat Treeview, konkrétně stavu jeho rozbalení. Občas se totiž může hodit informace, zda je či není celý strom kompletně rozbalen, a podle toho příslušně reagovat. Postup je tedy poměrně logický. Projdeme postupně celý strom a testujeme rozbalenost jednotlivých podvětví. K tomu nám poslouží následující jednoduchá funkce, jejímž jediným parametrem je Treeview, jehož stav nás zajímá:
function IsExpanded(TView: TTreeview) : boolean;
var
Node: TTreenode;
begin
Assert(Assigned(TView));
if TView.Items.Count > 0 then
begin
Node := TView.Items[0];
Result := True;
while Result and Assigned(Node) do
begin
Result := Node.Expanded or not Node.HasChildren;
Node := Node.GetNext;
end;
end
else
Result := False;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if IsExpanded(TreeView1) then ShowMessage('Strom je rozbalen')
else ShowMessage('Strom není rozbalen');
end;
Zajímavá může být též funkce, která testuje, zda je celý strom kompletně zabalen. Funkce pak vypadá naprosto totožně, liší se pouze v podmínce testování, která může vypadat například takto:
Result := not (Node.Expanded and Node.HasChildren);
O metodách FullExpand a FullCollapse, které slouží k rozbalení a opětovnému zabalení celého stromu (a souvisejí tak s našim příkladem), snad mluvit nemusím, protože je jistě dobře znáte a běžně používáte.

Blikání ikony u prvků v TreeView

2007-11-03T03:00:00.000-07:00

TreeView je velmi oblíbeným prvkem aplikací, protože celkem přehledně dokáže zobrazit v podstatě libovolnou hierarchickou strukturu dat. Jednotlivé prvky mohou mít vlastní ikonku a právě této ikonky využijeme v našem příkladu. Často se totiž vyskytne případ, kdy je nutné na určitou položku stromu uživatele nějakým způsobem upozornit, upoutat jeho pozornost a vynutit si tak jeho odezvu. A toho docílíme například tím, že necháme ikonku u příslušného prvku blikat.
Pro někoho to bude možná neohrabané řešení, nicméně pro tuto jednoduchou "animaci" použijeme Timer. Pochopitelně musíte mít rovněž na formuláři TreeView naplněný daty a definované příslušné ikonky pro jednotlivé prvky. Pak již stačí jen doplnit událost OnTimer:
procedure TForm1.Timer1Timer(Sender: TObject);
var
r: TRect;
bNode: TTreeNode;
ImageWidth: Integer;
begin
with Form1.TreeView1 do bNode := Items[Items.count - 1 ];
with bNode do
begin
ImageIndex := ImageIndex xor MaxInt;
SelectedIndex := SelectedIndex xor MaxInt;
if IsVisible then
begin
ImageWidth := TTreeView(Treeview).Images.Width;
r := DisplayRect(True);
r.Right := r.Left + ImageWidth;
OffsetRect(r, -ImageWidth - 4 , 0);
InvalidateRect(GetHandle, @r, True);
end;
end;
end;
Blikající prvek, označený jako bNode, je v našem případě ten úplně poslední z celého stromu. Rychlost blikání je pochopitelně ovlivněna nastavením Timeru, takže zvolte vhodný interval.

2007-11-02T07:22:00.000-07:00

No a to je vlastně vše. Všimněte si též toho, že kvůli překreslení titulku v případě změny okna formuláře je volání umístěno v událostech OnPaint a OnResize formuláře.
Určitě vás také napadlo, zda by nešlo klasický aplikační titulek nahradit tím naším. V podstatě ano, ale pochopitelně po drobných úpravách. Přidat ikonu či tlačítka na zavření aplikace by snad neměl být takový problém. Rovněž zamezit zobrazení originálního titulkového pruhu není samozřejmě problém. Nesmíme však zapomenout na možnost přesunutí okna, neboť za náš nový titulkový pruh se samozřejmě aplikace uchopit a přesunout nedá. Proto je potřeba "přesměrovat" možnost uchopení a přesunu právě na náš nový titulek. I o tom však již byla kdysi v našem seriálu řeč...

2007-10-29T06:58:00.000-07:00

Jak vidíte, o vykreslení se stará procedura VerticalTitleBar, která má pouze dva parametry – text zobrazovaného titulku a velikost fontu. Tyto parametry si můžeme podle potřeby celkem snadno rozšířit o další vlastnosti, které zobrazovaný titulek má. Tím je například barva titulku (v našem případě tmavě modrá - Navy), pochopitelně též barva textu i font. Samozřejmě můžete nastavit rovněž šířku (či spíše výšku) titulku, což zajistí proměnná x2, která má v našem případě hodnotu 20 bodů. Tuto šířku je pochopitelně nutné volit vzhledem k použitému fontu či přesněji řečeno velikosti použitého písma.

2007-10-25T14:26:00.000-07:00

Tento náš vertikální titulkový pruh bude tedy sloužit spíše jako jakýsi informační minipanel, který může například indikovat různé stavy aplikace a podobně. Pojďme však již k samotnému kódu:
.
.
.
private
{ Private declarations }
procedure VerticalTitleBar(Texto: string; Size: Integer);
.
.
.

procedure TForm1.VerticalTitleBar(TexTo: string; Size: Integer);
var
LogFont: TLogFont;
tmpCanvas: TCanvas;
tmpRect: TRect;
x1, x2, y1, y2: integer;
begin
tmpCanvas := TCanvas.Create;
tmpCanvas.Handle := GetWindowDc(Handle);
try
GetObject(Canvas.Font.Handle, SizeOf(LogFont), @LogFont);
with LogFont do
begin
lfEscapement := 90 * 10;
lfOrientation := 90 * 10;
lfOutPrecision := OUT_TT_ONLY_PRECIS;
lfFaceName := 'Arial';
lfHeight := Size;
lfWeight := FW_BOLD;
lfQuality := PROOF_QUALITY;
end;
with tmpCanvas do
begin
Font.Handle := CreateFontIndirect(LogFont);
Font.Color := clWhite;
Brush.Color := clNavy;
end;
x1 := GetSystemMetrics(SM_CXEDGE) + GetSystemMetrics(SM_CXBORDER);
x2 := 20;
y1 := GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYEDGE) + GetSystemMetrics(SM_CYBORDER) + 1;
y2 := Height - GetSystemMetrics(SM_CYEDGE) - GetSystemMetrics(SM_CYBORDER);
tmpRect := Rect(x1, y1, x2, y2);
tmpCanvas.FillRect(tmpRect);
DrawText(tmpCanvas.Handle, PChar(Texto), - 1, tmpRect, DT_BOTTOM or DT_SINGLELINE);
finally
tmpCanvas.Free;
end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
VerticalTitleBar('Titulek vertikálního pruhu', 12);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
VerticalTitleBar('Titulek vertikálního pruhu', 12);
end;

Vertikální titulkový pruh

2007-10-24T13:44:00.000-07:00

Dnes se naučíme opět trošku vylepšit vzhled našich aplikací přidáním vertikálního titulkového pruhu k levému okraji formuláře. No, vlastně to nebude titulkový pruh v pravém slova smyslu, tedy alespoň ne ten, který má každá (tedy většinou) aplikace na horním okraji formuláře. Náš titulkový pruh nebude obsahovat ikonu aplikace ani ovládací tlačítka, ale ani to by nebyl problém v případě zájmu doplnit.

2007-10-23T08:23:00.000-07:00

Funkce, kterou si teď ukážeme, testuje platnost zadaného ISBN, neboť toto číslo (podobně jako například rodné číslo) musí splňovat jisté parametry. Pokud tedy kupříkladu programujete nějakou databázi knih, může se vám tato funkce hodit jako kontrola vstupních dat. Za správnost algoritmu neručím, neboť nejsem jeho autorem, ale na náhodně vybraném vzorku knih v mojí knihovně vše fungovalo bez problému. Kód ISBN, který je předáván funkci jako parametr, se zadává včetně pomlček, které obsahuje.
function IsISBN(ISBN: String): Boolean;
var
Number, CheckDigit: String;
CheckValue, CheckSum, Err: Integer;
i, Cnt: Word;
begin
Result := False;
CheckDigit := Copy(ISBN, Length(ISBN), 1);
Number := Copy(ISBN, 1, Length(ISBN) - 2);
if (Length(Number) = 11) and (Pos(CheckDigit, '0123456789X') > 0) then
begin
if (CheckDigit = 'X') then CheckSum := 10
else Val(CheckDigit, CheckSum, Err);
Cnt := 1;
for i := 1 to 12 do
begin
if (Pos(Number[i], '0123456789') > 0) then
begin
Val(Number[i], CheckValue, Err);
CheckSum := CheckSum + CheckValue * (11 - Cnt);
Inc(Cnt);
end;
end;
if (CheckSum mod 11 = 0) then Result := True;
end;
end;

Test platnosti ISBN

2007-10-21T04:05:00.000-07:00

Tento tip nebude jistě pro každého, spíše pro velmi malou skupinku čtenářů, kteří hned bez přemýšlení vědí, co to zkratka ISBN vůbec znamená. Ne, není to žádná z nepřeberného množství počítačových zkratek. ISBN je zkratka pro mezinárodní unikátní číslo pro knihy, které se tak dají lépe strojově zpracovávat. Pokud sáhnete do své knihovny pro libovolnou knihu měla by na lícové straně vazby (nebo na jiném místě) toto číslo obsahovat. Záměrně píši "měla by obsahovat", protože nejsem žádný knihovník ani odborník na knihy, takže si nejsem jist, jestli neexistují nějaké výjimky. Z oficiálních zdrojů jsem se dozvěděl, že se tato metoda používá již 30 let, takže logicky starší knihy kód neobsahují. Zároveň některé země nemusí tento standard podporovat, takže pokud máte nějaký unikát z velmi cizokrajné a izolované země, zřejmě ani na takové knize kód nenajdete. 159 zemí civilizovaného světa však tento systém již desítky let používají.

Celou věc opět řeší systém zpráv Windows.

2007-10-19T04:04:00.000-07:00

Vytvoříme si vlastní obsluhu volání Application.OnMessage, ve které budeme poté testovat vyvolání kontextového menu a zda byla vybrána námi přidaná položka. Na základě toho bude provedena příslušná akce, což bude v našem případě prostý výpis textu.
.
.
.

private
{ Private declarations }
procedure OnAppMessage(var Msg: TMsg; var Handled: Boolean);
.
.
.
const
SC_MyMenuItem = WM_USER + 1;
.
.
.

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := OnAppMessage;
AppendMenu(GetSystemMenu(Application.Handle, FALSE), MF_SEPARATOR, 0, '');
AppendMenu(GetSystemMenu(Application.Handle, FALSE), MF_STRING, SC_MyMenuItem, '&Naše položka');
end;

procedure TForm1.OnAppMessage(var Msg: TMsg; var Handled: Boolean);
begin
if (Msg.message = WM_SYSCOMMAND) and (Msg.wParam = SC_MyMenuItem) then
begin
ShowMessage('Byla vybrána naše položka z menu');
Handled := True;
end;
end;

Vlastní položky v kontextovém menu aplikace v taskbaru

2007-10-17T00:50:00.001-07:00

U běžné aplikace je na hlavním panelu (taskbaru) zobrazena její ikona či spíše tlačítko s ikonou. Tím máme přehled o spuštěných programech a pochopitelně tak můžeme i mezi aplikacemi přepínat. Poklepáním pravým tlačítkem na toto "tlačítko" se zobrazí kontextové menu, které obsahuje podle dané aplikace rozličné obvyklé funkce jako je například Zavřít, Minimalizovat, Přesunout atd.. Menu je velmi podobné tomu, které se zobrazí po poklepání na titulkový pruh aplikace (avšak pozor, je pouze podobné, nejedná se o stejné menu). A právě do tohoto systémového menu, které se zobrazuje na hlavním panelu, se naučíme přidat vlastní položky.

2007-10-15T23:34:00.000-07:00

Jak pojmenovat zmíněné komponenty, zjistíte snadno ze zdrojového kódu. První procedura slouží k "zakódování", druhá ke zpětnému získání textu z obrázku:
procedure TForm1.Button1Click(Sender: TObject);
var
x, y, i, j: Integer;
PixelData: TColor;
CharMask, CharData: Byte;
begin
imgTarget.Picture.Assign(imgOrig.Picture);
imgDelta.Picture.Assign(imgOrig.Picture);
imgTarget.Picture.Bitmap.PixelFormat := pf32bit;
imgDelta.Picture.Bitmap.PixelFormat := pf32bit;
x := 0;
y := 0;
with imgTarget.Picture.Bitmap do
for i := 1 to Length(sourceMessage.Text) do
begin
CharMask := $80;
for j := 1 to 8 do
begin
CharData := Byte(sourceMessage.Text[i]) and CharMask;
if (CharData <> 0) then
begin
PixelData := Canvas.Pixels[x, y] xor $1;
Canvas.Pixels[x, y] := PixelData;
end;
x := (x + 1) mod imgTarget.Picture.Bitmap.Width;
if (x = 0) then
begin
Inc(y);
end;
CharMask := CharMask shr 1;
end;
end;
for y := 0 to imgOrig.Picture.Bitmap.Height -1 do
for x := 0 to imgOrig.Picture.Bitmap.Width -1 do
if (imgOrig.Picture.Bitmap.Canvas.Pixels[x, y] <> imgTarget.Picture.Bitmap.Canvas.Pixels[x, y]) then
imgDelta.Picture.Bitmap.Canvas.Pixels[x, y] := clYellow;
end;

procedure TForm1.Button2Click(Sender: TObject);
Var
x, y: integer;
mask, ch: byte;
begin
sourceMessage.Clear;
mask := $80;
ch := 0;
for y := 0 to imgOrig.Picture.Bitmap.Height -1 do
begin
for x := 0 to imgOrig.Picture.Bitmap.Width -1 do
begin
if (imgOrig.Picture.Bitmap.Canvas.Pixels[x, y] <>
imgTarget.Picture.Bitmap.Canvas.Pixels[x, y]) then ch := ch or mask;
mask := mask shr 1;
if mask = 0 Then
begin
Edit1.Text := Edit1.Text + char(ch);
mask := $80;
ch := 0;
end;
end;
end;
end;
Jak vidíte, výsledný obrázek není uložen na disk. Toho však snadno docílíte přidáním tohoto řádku na konec první procedury:
imgTarget.Picture.SaveToFile('c:\vyslednyobrazek.bmp');
Celý příklad berte spíše jako ukázkový. Je koncipován tak, abyste přímo viděli, jak daná věc funguje, a mohli experimentovat. V reálné aplikaci bude pochopitelně nutné přidat dialog pro výběr a následné uložení obrázku a také načítání vkládaného textu ze souboru.

2007-10-15T00:45:00.001-07:00

Pojďme však již k samotné implementaci v Delphi. Příklad jsou vlastně pouze dvě procedury – události stisku dvou tlačítek. První tlačítko zakóduje do obrázku zprávu, druhé tlačítko ji dekóduje. Kromě těchto dvou tlačítek ještě umístěte na formulář 3 komponenty TImage. První bude obsahovat originální obrázek, takže jej prostřednictvím Object Inspectoru můžete rovnou do komponenty načíst. Obrázek musí být ve formátu BMP. Zbylé dvě komponenty TImage slouží k zobrazení výsledného obrázku na tzv. delta snímku, ve kterém jsou žlutou barvou zvýrazněny klíčové změněné pixely. Tento obrázek slouží pouze pro přehled a nemá žádnou praktickou funkci. Poslední věcí, kterou je třeba na formulář přidat, je komponenta, jež bude obsahovat textovou zprávu, kterou chceme do obrázku ukrýt. V našem případě bude tuto funkci plnit komponenta TEdit.

Ale teď vážně.

2007-10-12T00:29:00.001-07:00

Ukážeme si jeden jednoduchý způsob, jak tohoto efektu zakomponování textu do obrázku dosáhnout v Delphi. Na originální obrázek je namaskován zadaný text v jeho binární podobě. Při zpětném procesu (dešifrování) jsou porovnány jednotlivé pixely původního a zašifrovaného obrázku a rozdíly jsou opět zpětně "demaskovány", čímž se získají jednotlivé znaky uloženého textu.
V tom je právě menší nevýhoda tohoto jinak velmi jednoduchého postupu – totiž nutnost mít pro dešifrování také původní originální obrázek. V praxi to pak znamená, že pochopitelně nebudete pokaždé posílat oba obrázky (tedy původní originál a obrázek s ukrytým textem), ale originální obrázek si s člověkem, se kterým chcete touto formou komunikovat, vyměníte pouze jednou. Poté už pouze posíláte obrázky s ukrytými texty. Abychom byli opravdu precizní a učinili zadost všem agentským pravidlům, můžete ještě nenápadnost vašeho počínání zvýšit tím, že budete používat obrázků více (v extrémním případě až na každý den v roce jiný obrázek). Jinak by bylo totiž značně podezřelé, kdybyste posílali stejnému člověku stále dokola tentýž obrázek.

Ukrytí textové zprávy do obrázku

2007-10-10T00:55:00.001-07:00

Možná znáte některé programy, které vám umožní schovat do běžného obrázku textová data tak, aby byl takto získaný obrázek k nerozeznání od originálu. K čemu je to dobré? Je to jeden ze zajímavých způsobů, jak bezpečným způsobem přenášet citlivá data například prostřednictvím e-mailu. Jistě namítnete, že mnohem lepší je data šifrovat. Ano, je to jeden z účinných způsobů, ale zašifrovaná data mohou být na první pohled podezřelá a mohou lákat ke zkoušení, jak šifru prolomit. A i když se prolomení nepodaří (tak by tomu tedy alespoň v drtivé většině případů mělo být), přesto samo zjištění jiné osoby, že posíláte nějakou šifrovanou poštu, může být pro vás dostatečně kompromitující. Když ovšem pošlete e-mailem naprosto neškodný obrázek, žádné podezření to nevzbudí a vaše paranoidní duše agenta může být klidná.

Název a identifikační číslo CD disku

2007-10-08T23:22:00.000-07:00

Na závěr tu máme jednoduchou funkci na zjišťování základních informací o vloženém CD – název a ID disku. Jako parametr se předává písmenko mechaniky CD (včetně dvojtečky). Pokud bude jako parametr předán disk jiného typu (například pevný disk či disketová mechanika), funkce vrátí prázdný řetězec.
function GetCDInfo(WhichDrive: string): string;
var
VolumeName: array[0..255] of char;
FileSystemType: array[0..255] of char;
SerialNum: DWORD;
MaxFilenameLength: DWORD;
Flags: DWORD;
begin
if (GetVolumeInformation(PChar(WhichDrive), VolumeName, 256, @SerialNum, MaxFilenameLength, Flags, FileSystemType, 256)) then
Result := (IntToHex(SerialNum shr 16, 3) + IntToHex((SerialNum shl 16) shr 16, 4)) + ' - ' + VolumeName;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetCDinfo('e:'));
end;

Jak zabránit překreslení okna aplikace?

2007-10-07T01:16:00.000-07:00

Následující tip patří opět k těm velmi krátkým, jednoduchým a velmi málo používaným. Pokud tedy z nějakého důvodu chcete zabránit systému v překreslování okna vaší aplikace, stačí použít následující příkaz:
SendMessage(Handle, WM_SetRedraw, 0, 0);
Pro opětovné zapnutí překreslování použijte tyto parametry:
SendMessage(Handle, WM_SetRedraw, 1, 0);
Až budete tento tip zkoušet, dejte si pozor, aby se vám aplikace "neztratila". Nejenže se okno nebude překreslovat (tj. pokud jej překryjete oknem jiné aplikace a poté znovu odkryjete, bude vidět plocha Windows), ale nebude ani reagovat na klikání myši. Nelze jej tak ani uchopit nebo klikat na objekty na formuláři (nehledě na to, že i kdyby se vám "nějak" podařilo myší okno uchopit, těžko byste jej díky nepřekreslování někam viditelně přenesli). Aplikace však samozřejmě reaguje na klávesnici, takže lze mezi jednotlivými prvky (i když třeba nejsou vidět) přecházet například tabulátorem.

2007-10-03T00:42:00.000-07:00

Jednotlivé "řádky" (položky) ComboBoxu jsou identifikovány svým indexem (parametr Index), který je jako obvykle počítán od nuly. Kvůli zjednodušení příkladu je tentýž index zároveň určující pro to, který obrázek z ImageListu bude pro danou položku použit. V reálných aplikacích si pochopitelně na základě hodnoty daného řádku můžete přiřadit patřičný vhodný obrázek libovolně.
Máte-li k dispozici Delphi verze 6 (stačí i Personal verze zdarma), pak je situace mnohem jednodušší, neboť vše řeší nová komponenta ComboBoxEx.

2007-10-02T01:04:00.000-07:00

Vlastní obsluha události OnDrawItem pak vypadá takto:
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
ComboBox : TComboBox;
bitmap : TBitmap;
begin
ComboBox := (Control as TComboBox);
bitmap := TBitmap.Create;
try
ImageList1.GetBitmap(Index, bitmap);
with ComboBox.Canvas do
begin
FillRect(Rect);
if Bitmap.Handle <> 0 then Draw(Rect.Left + 2, Rect.Top, Bitmap);
Rect := Bounds(Rect.Left + ComboBox.ItemHeight + 2, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
DrawText(handle, PChar(ComboBox.Items[Index]), length(ComboBox.Items[index]), Rect, DT_VCENTER+DT_SINGLELINE);
end;
finally
bitmap.Free;
end;
end;

Obrázkový ComboBox

2007-09-30T04:36:00.001-07:00

Ukážeme si, jak vylepšit klasický ComboBox tím, že k jednotlivým položkám rozbaleného seznamu přiřadíme obrázky (ikonky). Každá položka pak bude mít vlevo vlastní ikonu a vedle ní bude samotný text dané položky.
Jak toho dosáhnout? Poměrně snadno tím, že se o vykreslení budeme starat sami prostřednictvím události OnDrawItem. Nejprve je však třeba nastavit styl ComboBoxu na csOwnerDrawFixed nebo csOwnerDrawVariable (podle toho, zda budou jednotlivé řádky mít fixní či proměnlivou velikost).
Poté naplňte ComboBox nějakými testovacími daty. Prostě několik řádků hodnot. Jednotlivé obrázky budou potom k položkám přiřazeny z ImageListu, který rovněž přidejte na formulář a pochopitelně naplňte několika (vhodně malými) obrázky.

Dále následuje část deklarace:

2007-09-29T03:46:00.001-07:00

.
.
.
procedure FormCreate(Sender: TObject);
procedure WndProc(var Message: TMessage); override;
procedure Showform1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
IconNotifyData : TNotifyIconData;
end;
.
.
.
Procedura WndProc "odchytává" pokus o minimalizaci aplikace a zařídí její minimalizaci do ikony hlavního panelu. Zároveň se stará o reakce na kliknutí myší na ikonu – buď aplikaci obnoví nebo zobrazí PopupMenu.
procedure TForm1.WndProc(var Message: TMessage);
var
p : TPoint;
begin
case Message.Msg of
WM_SYSCOMMAND:
case Message.WParam and $FFF0 of
SC_MINIMIZE:
begin
Hide;
Exit;
end;
SC_RESTORE: ;
end;
WM_USER + 1:
case Message.lParam of
WM_RBUTTONDOWN:
begin
GetCursorPos(p);
PopupMenu1.Popup(p.x, p.y);
end;
WM_LBUTTONDOWN:
begin
Show;
end;
end;
end;
inherited ;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
with IconNotifyData do
begin
hIcon := Application.Icon.Handle;
uCallbackMessage := WM_USER + 1;
cbSize := sizeof(IconNotifyData);
Wnd := Handle;
uID := 100;
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
end;
StrPCopy(IconNotifyData.szTip, Application.Title);
Shell_NotifyIcon(NIM_ADD, @IconNotifyData);
Application.ShowMainForm := False;
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

procedure TForm1.Showform1Click(Sender: TObject);
begin
Show;
SetForegroundWindow(Self.handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @IconNotifyData);
end;
Jako text bublinkové nápovědy u ikony je použit titulek aplikace – viz řádek StrPCopy(IconNotifyData... v události OnCreate hlavního formuláře, ale můžete jej pochopitelně libovolně měnit.
Jak vidíte, přidat si ikonku na hlavní panel není složité ani pracné. I když je tento příklad velmi jednoduchý a má sloužit spíše jako ukázka, základní funkce plní. Přidat některá další vylepšení však není problém. Pokud tedy místo použití hotových komponent dáváte přednost vlastní tvorbě, račte experimentovat.

2007-09-28T02:20:00.000-07:00

Dost ale zbytečných a nudných úvodů a pojďme k našemu příkladu. Po jeho spuštění bude aplikace ihned minimalizována, nebude vidět na hlavním panelu vedle tlačítka Start a zároveň se vedle hodin zobrazí příslušná ikonka. Po kliknutí na ni levým tlačítkem myši bude aplikace opět maximalizována (či přesněji řečeno, bude obnoveno hlavní okno do původního stavu), po kliknutí pravým tlačítkem se zobrazí kontextové menu.
Ještě je třeba upozornit, že budeme potřebovat knihovnu ShellAPI, takže ji nezapomeňte přidat do projektu. Vytvořte tedy nový projekt, přidejte zmíněnou knihovnu a také přidejte PopupMenu, v němž si můžete nadefinovat zcela libovolné položky (slouží pouze pro demonstraci).

Ikona aplikace v hlavním panelu - tray icon

2007-09-26T11:08:00.000-07:00

Jistě dobře víte, že řada aplikací se po svém spuštění "usídlí" v hlavním panelu vedle hodin v podobě malé ikonky. Obvykle se jedná o aplikace, které běží již od startu systému a vykonávají na pozadí nějaké funkce (antivirový program či různé další utility). Nevyžadují žádnou zvláštní pozornost uživatele a jejich hlavní okno by se tedy na ploše jen zbytečně pletlo. Zároveň však musí být jejich funkce občas přístupné a nebo je alespoň třeba indikovat, že daná aplikace běží. K tomu se právě ideálně hodí místo vedle hodin na hlavním panelu – tray. Tolik tedy teorie, ale praxe je bohužel trochu jiná, což sami jistě velmi dobře víte. Ikonu se na toto místo snaží "nacpat" kdejaká aplikace, takže někdy jich tam má uživatel slušnou řádku. Proto mi dovolte, ještě než si ukážeme jak touto ikonkou naše aplikace opatřit, jedno malé doporučení: dávat ikonu do hlavního panelu jen tehdy, když to má smysl (a ne proto, abyste ukázali, že to umíte). Také je dobré, aby o zobrazení či nezobrazení ikony mohl rozhodnout uživatel v nastavení programu.

Spuštění aplikace pouze jednou v rámci dané instance Windows

2007-09-24T00:48:00.001-07:00

Poněkud krkolomný nadpis, uznávám. Ale hned si vysvětlíme, oč se jedná. Vzpomínáte si, jak jsme si kdysi ukazovali, jak zamezit několikanásobnému spuštění aplikace? Tento příklad zase zajistí, že vaše aplikace bude spustitelná pouze jednou během aktuálního běhu Windows. Pokud bude někdo chtít vaši aplikaci spustit podruhé, bude muset nejprve Windows restartovat. K tomu nám poslouží funkce GlobalAddAtom a GlobalFindAtom. Využití tohoto příkladu ponechám na vás, jistě sami na něco přijdete.
procedure TForm1.FormShow(Sender : TObject);
var
Atom : integer;
begin
if GlobalFindAtom('TEXT_IDENTIFIKUJICI_NASI_APLIKACI') = 0 then Atom := GlobalAddAtom('TEXT_IDENTIFIKUJICI_NASI_APLIKACI')
else
begin
ShowMessage('Tato aplikace může být spuštěna pouze jednou za běhu Windows. Pro opětovné spuštění je třeba Windows restartovat');
Close;
end;
end;

2007-09-22T12:59:00.000-07:00

Jak vidíte, zobrazení nápovědy je kvůli zjednodušení vyvoláno po stisku tlačítka, což není právě praktické, doplnit si zobrazování po najetí myší vám ovšem nechám za domácí úkol. Ale zpět k samotnému zobrazení. Nejprve je třeba u daného tlačítka vyplnit položku Hint, protože odtud je text brán. Také by bylo dobré deaktivovat původní hint (ShowHint := false), aby se nám nezobrazovaly nápovědy dvě.
Samotné parametry "okna" nápovědy si můžete upravit jednak přímo v události OnCreate hlavního formuláře, kde je nastaveno několik základních vizuálních vlastností. Zbytek najdete přímo v proceduře ShowAHint, která má čtyři parametry – souřadnice, kde se má nápověda zobrazit, text nápovědy a dobu, po jakou bude nápověda zobrazena. Velikost okna nápovědy (tedy vlastně Panelu) je upravena podle velikosti zobrazovaného textu, ale nic vám nebrání si velikost přizpůsobit. Rovněž si můžete sami upravit vlastnosti, jako je barva podkladu nápovědy (v našem příkladu zvolena dost kontrastní barva Lime) či barvu a parametry samotného textu.

A ještě jednou bublinková nápověda

2007-09-21T00:39:00.000-07:00

A znovu tu máme téma bublinkové nápovědy. Tentokrát si vytvoříme přímo vlastní bublinkovou nápovědu (Hint), a to prostřednictvím komponenty Panel. Umístěte ji tedy na formulář. O její vlastnosti se nemusíte starat, budou měněny přímo programově. Dále bude potřeba jeden Timer, abychom náš Hint zobrazili na požadovaný časový interval. Poté si ještě na formulář umístěte jedno tlačítko, na kterém budeme funkčnost příkladu demonstrovat.
A nyní již samotný kód:
.
.
.
private
{ Private declarations }
procedure ShowAHint(x: integer; y: integer; Caption: string; Duration: LongInt);
.
.
.

procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Enabled := false;
Panel1.Visible := false;
Panel1.BevelInner := bvNone;
Panel1.BevelOuter := bvNone;
Panel1.BorderStyle := bsSingle;
end;

procedure TForm1.ShowAHint(x : integer; y : integer; Caption : string; Duration : LongInt);
var
dc : hdc;
OldFont : hFont;
pt : TSize;
p : pChar;
begin
if Timer1.Enabled <> false then Timer1.Enabled := false;
Timer1.Enabled := false;
if Panel1.Visible <> false then Panel1.Visible := false;
if Caption = '' then exit;
Panel1.Caption := caption;
GetMem(p, Length(Panel1.Caption) + 1);
StrPCopy(p, Panel1.Caption);
dc := GetDc(Panel1.Handle);
OldFont := SelectObject(dc, Panel1.Font.Handle);
GetTextExtentPoint32(dc, p, Length(Panel1.Caption), pt);
SelectObject(dc, OldFont);
ReleaseDc(Panel1.Handle, Dc);
FreeMem(p, Length(Panel1.Caption) + 1);
Panel1.Left := x;
Panel1.Top := y;
Panel1.Width := pt.cx + 6;
Panel1.Height := pt.cy + 2;
Panel1.Color:= clLime;
Panel1.Font.Color := clBlue;
Panel1.Visible := true;
Timer1.Interval := Duration;
Timer1.Enabled := true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if Panel1.Visible <> false then
Panel1.Visible := false;
Timer1.Enabled := false;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Application.ProcessMessages;
ShowAHint(Button1.Left, Button1.Top + Button1.Height + 6, Button1.Hint, 2000);
end;

Proto ji umístěte na formulář

2007-09-11T23:54:00.000-07:00

a dále vyplňte parametr FileName, který určuje název souboru, jehož první snímek chceme zobrazit. Nyní již stačí přidat tento jednoduchý kód a první snímek se zobrazí v okně MediaPlayeru:
procedure TForm1.Button1Click(Sender: TObject);
begin
Application.ProcessMessages;
MediaPlayer1.Open;
Application.ProcessMessages;
MediaPlayer1.Step;
Application.ProcessMessages;
MediaPlayer1.Previous;
end;

Zobrazení prvního snímku videa

2007-09-11T01:47:00.000-07:00

Pokud potřebujete vytvořit pouhý náhled a ne přehrát celé video, obvykle se k tomu používá první snímek, i když zrovna z prvního snímku nemusí být vždy zřejmé, oč se jedná. K jeho zobrazení použijeme komponentu MediaPlayer, čímž nám odpadne starost o všechny záležitosti související s prací se samotným video souborem. Můžeme tak zobrazit první snímek (frame) z téměř libovolného formátu videa, tedy přesněji řečeno z těch formátů, jejichž kodeky máme v systému nainstalovány. A o práci s nimi se právě postará komponenta MediaPlayer.

2007-09-09T23:15:00.000-07:00

Funkce NewWindowProc se vlastně stará o celé řízení samotného psaní textu, stará se o reakce na focus a na stisknutí kláves. Jako kurzor (či spíše kurzory – viz dále) se používá "obrázek", vytvořený v události OnCreate hlavního formuláře. Ta má dvě části, které jsou pro přehlednost odděleny čárou. První část popisuje vizuální podobu kurzoru při psaní textu, druhá část zase stejným způsobem nastavuje podobu kurzoru při mazání textu klávesou Backspace.
A jak tedy celý výsledek vypadá? Kurzor je jednak vykreslen ve tvaru "kostičky" a jako třešnička na dortu (a spíše z důvodů demonstračních než pro reálné použití) se na něm zobrazuje během psaní smějící se "smajlík" ze znakové sady WingDings. V případě mazání textu klávesou Backspace se smajlík změní na zamračeného.
Myslím, že princip samotné tvorby kurzoru je dostatečně zřejmý, takže se nebojte experimentování.

Další vylepšení komponenty Edit

2007-09-09T01:28:00.000-07:00

A máme tu další vylepšení komponenty Edit. Abych se přiznal, jako odchovanec osmibitových počítačů a dalších podobných staříků jsem měl moc rád, když kurzor při zadávání textu měl podobu blikajícího čtverečku a ve Windows (a dalších systémech) používaná svislá "čárka" se mi moc nelíbí. Ukážeme si teď, jak u komponenty Edit tento svislý a poněkud nudný kurzor změnit.
Umístěte si tedy na formulář nějaký EditBox a pak přidejte následující kód:
.
.
.
public
{ Public declarations }
CaretBm : TBitmap;
CaretBmBk : TBitmap;
OldEditsWindowProc : Pointer;
.
.
.
type
WParameter = LongInt;
LParameter = LongInt;
.
.
.
function NewWindowProc(WindowHandle : hWnd; TheMessage : WParameter; ParamW : WParameter; ParamL : LParameter) : LongInt stdcall;
begin
NewWindowProc := CallWindowProc(Form1.OldEditsWindowProc, WindowHandle, TheMessage, ParamW, ParamL);
if TheMessage = WM_SETFOCUS then
begin
CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
ShowCaret(WindowHandle);
end;
if TheMessage = WM_KILLFOCUS then
begin
HideCaret(WindowHandle);
DestroyCaret;
end;
if TheMessage = WM_KEYDOWN then
begin
if ParamW = VK_BACK then
CreateCaret(WindowHandle, Form1.CaretBmBk.Handle, 0, 0) else
CreateCaret(WindowHandle, Form1.CaretBm.Handle, 0, 0);
ShowCaret(WindowHandle);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
CaretBm := TBitmap.Create;
CaretBm.Canvas.Font.Name := 'WingDings';
CaretBm.Canvas.Font.Height := Edit1.Font.Height;
CaretBm.Canvas.Font.Color := clWhite;
CaretBm.Width := CaretBm.Canvas.TextWidth('J') + 2;
CaretBm.Height := CaretBm.Canvas.TextHeight('J') + 2;
CaretBm.Canvas.Brush.Color := clBlue;
CaretBm.Canvas.FillRect(Rect(0, 0, CaretBm.Width, CaretBm.Height));
CaretBm.Canvas.TextOut(1, 1, 'J');
{-----------------------------------------------------------------}

CaretBmBk := TBitmap.Create;
CaretBmBk.Canvas.Font.Name := 'WingDings';
CaretBmBk.Canvas.Font.Height := Edit1.Font.Height;
CaretBmBk.Canvas.Font.Color := clWhite;
CaretBmBk.Width := CaretBmBk.Canvas.TextWidth('L') + 2;
CaretBmBk.Height := CaretBmBk.Canvas.TextHeight('L') + 2;
CaretBmBk.Canvas.Brush.Color := clBlue;
CaretBmBk.Canvas.FillRect(Rect(0, 0, CaretBmBk.Width, CaretBmBk.Height));
CaretBmBk.Canvas.TextOut(1, 1, 'L');
OldEditsWindowProc := Pointer(SetWindowLong(Edit1.Handle, GWL_WNDPROC, LongInt(@NewWindowProc)));
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
SetWindowLong(Edit1.Handle, GWL_WNDPROC, LongInt(OldEditsWindowProc));
CaretBm.Free;
CaretBmBk.Free;
end;

Změna obrázku tlačítka Start

2007-09-06T13:42:00.000-07:00

Už dlouho jsme se nepokoušeli nějak "potrápit" Windows, takže si to tímto tipem zase trošku vynahradíme. Změna obrázku na tlačítku Start sice není dvakrát užitečná záležitost, ale proč se trošku nepobavit.
Nejprve si vytvořte vhodný obrázek patřičných rozměrů (mně se osvědčily rozměry přibližně 48 x 16 pixelů) a pak již stačí jen použít následující kód:
.
.
.
private
{ Private declarations }
StartButton : hWnd;
OldBitmap : THandle;
NewImage : TPicture;
.
.
.

procedure TForm1.Button1Click(Sender: TObject);
begin
NewImage := TPicture.Create;
NewImage.LoadFromFile('start.bmp');
StartButton := FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil);
OldBitmap := SendMessage(StartButton, BM_SetImage, 0, NewImage.Bitmap.Handle);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
try
SendMessage(StartButton, BM_SetImage, 0, OldBitmap);
NewImage.Free;
except end;
end;
Změna obrázku je opět vyvolána jako událost stisku tlačítka, a abychom nebyli na Windows tak zlí, po ukončení příkladu se vše vrátí do původního stavu v události OnDestroy formuláře.
Nutno připomenout, že Windows se brání seč můžou a tento příklad bude fungovat jen na "starší generaci", tj. Windows 9x. Pod Windows NT/2000 se zobrazí pouze prázdné tlačítko.

Úprava fontu bublinkové nápovědy

2007-09-05T23:23:00.000-07:00

Bublinkovou nápovědou (Hint) jsme se již zabývali mnohokrát. Ukázali jsme si, jak se dá nastavit doba, po jaké se má objevit, barva a další parametry. Nyní si ukážeme vlastně poslední z chybějících nastavení a to je druh písma nápovědy.
.
.
.
implementation

{$R *.DFM}

Type
TMyHintWindow = Class (THintWindow)
Constructor Create (AOwner: TComponent); override;
end;

Constructor TMyHintWindow.Create (AOwner: TComponent);
Begin
Inherited Create (Aowner);
Canvas.Font.Name := 'Verdana';
Canvas.Font.Style:= [fsBold];
Canvas.Font.Size := 18;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.ShowHint := False;
HintWindowClass := TMyHintWindow;
Application.ShowHint := True;
end;
.
.
.
Takto dosáhneme velkého a tučného fontu. Pravda, pro použití v reálu je poněkud nevhodný, ale jako ukázka ideální a vy si již určitě najdete vhodnou kombinaci. Někteří uživatelé jistě ocení, pokud jim nabídnete možnost zvolit si i takovýto drobný detail v nastavení aplikace.

2007-09-02T22:52:00.001-07:00

Když nyní projekt znovu zkompilujete, komponenta ListView už bude fungovat pod Windows XP bez problémů a většina potenciálních problémů je tak vyřešena. Zkompilovanou knihovnu (soubor comctrls.dcu) můžete poté zkopírovat do složky Lib a přepsat tak originální knihovnu, aby tato upravená verze byla použita i ve všech dalších projektech.

2007-09-02T02:32:00.000-07:00

Soubor si nakopírujte do složky s vaší aplikací, otevřete jej a najděte si proceduru TCustomListView.UpdateColumn, kterou upravte podle tohoto vzoru (stačí, když celou původní proceduru přepíšete tou, která je uvedena níže, neboť je kompletní):
procedure TCustomListView.UpdateColumn(AnIndex: Integer);
const IAlignment: array[Boolean, TAlignment] of LongInt =
((LVCFMT_LEFT, LVCFMT_RIGHT, LVCFMT_CENTER),
(LVCFMT_RIGHT, LVCFMT_LEFT, LVCFMT_CENTER));
var
Column: TLVColumn;
AAlignment: TAlignment;
begin
if HandleAllocated then
with Column, Columns.Items[AnIndex] do
begin
mask := LVCF_TEXT or LVCF_FMT;
if FImageIndex >= 0 then mask := mask or LVCF_IMAGE;
iImage := FImageIndex;
pszText := PChar(Caption);
AAlignment := Alignment;
if Index <> 0 then
fmt := IAlignment[UseRightToLeftAlignment, AAlignment]
else fmt := LVCFMT_LEFT;
if FImageIndex <> -1 then
fmt := fmt or LVCFMT_IMAGE or LVCFMT_COL_HAS_IMAGES;
if WidthType > ColumnTextWidth then
begin
mask := mask or LVCF_WIDTH;
cx := FWidth;
ListView_SetColumn(Handle, Columns[AnIndex].FOrderTag, Column);
end
else begin
ListView_SetColumn(Handle, Columns[AnIndex].FOrderTag, Column);
if ViewStyle = vsList then
ListView_SetColumnWidth(Handle, -1, WidthType)
else if (ViewStyle = vsReport) and not OwnerData then
ListView_SetColumnWidth(Handle, Columns[AnIndex].FOrderTag, WidthType);
end;
end;
end;

2007-08-31T23:18:00.001-07:00

Za jednu z nejvážnějších jsem tehdy označil chybu v komponentě ListView, kdy při použití stylu vsReport a nedefinování hlavičky jednotlivých sloupců (nebo i jednoho sloupce) se při spuštění aplikace pod Windows XP okamžitě zhroutí. Jak z toho tedy ven? Aktualizace vydané Borlandem bohužel věc neřeší, takže si v tomto konkrétním případě pomůžeme sami úpravou knihovny Comctrls, jejíž zdrojový kód (tedy soubor comctrls.pas) byste měli najít ve složce {Delphi}\Source\Vcl.

Úprava knihovny Comctrls pro použití ve Windows XP

2007-08-30T00:05:00.000-07:00

Před časem jsme se zabývali použitím vizuálních stylů ve Windows XP. Jistě si vzpomenete na jednoduchý postup, kterým jsme použití stylů do aplikace zakomponovali prostřednictvím souboru manifestu. Možná si také vzpomenete, že tato poměrně jednoduchá akce ale nebyla nakonec úplně bez komplikací, protože VCL knihovna Delphi obsahuje několik chyb, které se za určitých okolností projeví pádem aplikace pod Windows XP.

A na závěr

2007-08-28T00:16:00.001-07:00

nám zůstává mazání jednotlivých položek, což bude asi mnohem častější činnost než mazání celých sekcí. Dá se celkem snadno předpokládat, že funkce bude mít dva parametry – sekci a položku, kterou chceme mazat. Jedná se o funkci DeleteKey a příklad máte zde:
procedure TForm1.Button6Click(Sender: TObject);
var
INISoubor: TIniFile;
begin
INISoubor := TIniFile.Create('c:\pokus.ini');
INISoubor.DeleteKey('První sekce','Polozka5');
INISoubor.Free;
end;
Jak vidíte, práce s INI soubory je velmi jednoduchá, připravené funkce v Delphi zvládají všechny hlavní činnosti a jejich použití je bezproblémové. Neváhejte tedy a zkuste někdy místo registrů ukládat aplikační data do INI souboru. Uvidíte, že to není zase až tak zastaralá "technologie".

Zbývá nám naučit se,

2007-08-26T02:13:00.000-07:00

jak jednotlivé sekce či položky z INI souboru vymazat. Potřebujete-li hromadně smazat celou jednu sekci včetně všech jejích položek a hodnot, slouží k tomuto účelu funkce EraseSection. Ta danou sekci se souboru vymaže a soubor hezky upraví tak, aby mezi jednotlivými sekcemi byl opět vždy jeden prázdný řádek a nevznikaly nějaké mezery navíc. Pokud se pokusíte smazat neexistující sekci, nic se nestane. Nic se pochopitelně nesmaže, ale tento pokus nevyvolá ani chybu v programu. Obdobně "čistě" se chovají i ostatní již zmíněné funkce. Zde je tedy příklad:
procedure TForm1.Button5Click(Sender: TObject);
var
INISoubor: TIniFile;
begin
INISoubor := TIniFile.Create('c:\pokus.ini');
INISoubor.EraseSection('První sekce');
INISoubor.Free;
end;