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.

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

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.

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

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.

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

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.

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.

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ě.

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

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

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?

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.

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.

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;