Wednesday, July 30, 2008

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

Thursday, July 17, 2008

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

Tuesday, July 08, 2008

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

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í

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.