Speciální grafické efekty v DelphiX - Builder.cz - Informacni server o programovani

Navigace:  » Úvodní stránka  » Rubriky  » Delphi  

20. září 2001, 00.00 | Zkuste si podle návodu v dnešním článku vytvořit zajímavé grafické efekty v DelphiX. Například kreslení obrázku pouze jako tisíce kruhů s průměrnou barvou nebo rozpixelovaný obrázek, který se postupně změní v logo !

Před nedávnem jsem psal o knize v Delphi v příkladech (článek si můžete přečíst zde). K této knize se ještě vrátím, jelikož mě inspirovala natolik, že jsem podle ní vytvořil zajímavé grafické efekty. Samozřejmě, jak je zvykem - v DelphiX. Abych předešel dlouhým diskuzím - program jsem z knihy neokopíroval, pouze jsem si půjčil nápad a ten potom zrealizoval. Ostatně - přesvědčte se o tom sami a knihu si kupte... Tedy, dáme se do programování.

Průměrné barvy poprvé

Stejně jako ve výše jmenované knize se nyní pokusíme udělat program, který kreslí obrázek pouze pomocí náhodně umístěných kruhů dané velikosti. Abychom věděli, jakou barvou musíme daný kruh nakreslit, musíme si vypočítat průměrnou barvu okolních pixelů, které leží unitř kruhu. Musíme tedy sčítat každou složku barvy zvlášť (Red - červenou, Green - zelenou a Blue - modrou) a nakonec každou složku vydělik počtem testovaných pixelů. Pro nejlepší výsledek by bylo dobré testovat každý pixel v kruhu, to by však zabralo spoustu procesorového času, a to si nemůžeme dovolit. Proto budeme testovat pouze daný počet pixelů, který bude uložen v proměnné Pocet. To je vše, co musíme vědět a dáme se tedy už konečně do toho programování.

Začneme tím, že spustíme Delphi. Na formulář dáme komponentu Image, ve které bude obrázek, který chceme touto metodou nakreslit. Musíme si tedy nějaký nahrát. Například slunečnici, která byla použita v knize a pro tento účel hezky vyhovuje:

Máme obrázek, co dál ? Přidáme komponentu DXDraw, na kterou budeme kreslit a DXTimer, který se o kreslení postará. My si program ještě trochu rozšíříme, a to možností měnit velikost kruhů a počet testovaných pixelů. Dáme tedy na formulář ještě dvě komponenty Label a TrackBar. Jména můžete nechat defaultní. První TrackBar bude ovlivňovat velikost kruhu, nastavíme mu tedy Max na 5, Min na 2 a Position na 5. Druhý bude nastavovat počet testovaných pixelů, nastavíme mu min na 1, max na 10 a position opět 5. Labely umístíme někam nad komponenty.
Nyní je na čase definovat si pár proměnných - Poloměr kruhu bude uložen v proměnné Rad, počet testovaných pixelů v proměnné Pocet a krom kreslení se bude dát přepnout mezi kreslením kruhu a čtverců - k tomu bude sloužit proměnná CoKreslit. Tady to máte vše hezky pohromadě:

Rad:integer = 5; // poloměr kruhu Pocet:integer = 5; // pocet testovanych pixelu CoKreslit:(ctverce,kruhy) = kruhy; // co kreslit

Rovnou si můžeme také vytvořit procedury TrackBar1.OnChange a TrackBar2.OnChange:

procedure TForm1.TrackBar1Change(Sender: TObject); begin // velikost kruhů... Rad:=TrackBar1.Position; Label1.Caption:='Radius kruhu - ' +InTToSTr(TrackBar1.Position); end;

procedure TForm1.TrackBar2Change(Sender: TObject); begin // počet testovaných pixelů Pocet:=TrackBar2.Position; Label2.Caption:='Počet testovaných pix. - ' +InTToSTr(TrackBar2.Position); end;

A už nám zbývá pouze procedura DXTimer.OnTimer. V ní budeme kreslit několik (1000) kruhů. Nejprve si nastavíme náhodnou pozici středu kruhu, která bude uložena v proměnných x a y. Dále si vynulujeme jednotlivé složky barvy - sr, sg a sb. Poté budeme podle veliksoti proměnné Pocet zjišťovat r, g a b složky pixelů uvnitř kruhu a přičítat je právě k proměnným sr, sg a sb. Až toto skončíme, všechny tři proměnné vydělíme proměnnou Pocet, čímž získáme průměrnou barvu a touto barvou nakonec nakreslíme kruh. A to je celé. Výpis procedury i s komentáři je zde:

// DXTIMER =========================== procedure TForm1.DXTimer1Timer (Sender: TObject; LagCount: Integer); var X,Y: integer;// pozice aktualniho kruhu c: TColor; // barva testovaneho pixelu z image r,g,b: byte; // vysledna barva kruhu sr,sg,sb: integer; // pomocne promenne pro barvu i,j: integer;// pom. promenne pro cyklus begin for i:=1 to 1000 do begin // nastavime nahodnou pozici stredu kruhu - x,y x := random( Image1.Width ); y := random( Image1.Height ); sr := 0; sg := 0; sb := 0; for j:=1 to pocet do begin // vezmeme nahodny bod z obrazku, ktery je nekde // uvnitr kruhu, ktery budeme kreslit... c := Image1.Canvas.Pixels [x-Rad+random(2*Rad+1),y-Rad+random(2*Rad+1)]; // slozky barvy RGB pricteme k sr,sg,sb sr := sr+GetRValue(c); // R slozka barvy sg := sg+GetGValue(c); // G --//-- sb := sb+GetBValue(c); // B --//-- end; // delenim promennou pocet ziskame // konecnou barvu kresleneho kruhu... r := sr div pocet; g := sg div pocet; b := sb div pocet; // takze to uz staci jen nakreslit.. DXDraw1.Surface.Canvas.pen.Style := psClear; DXDraw1.Surface.Canvas.Brush.Color := RGB(r,g,b); if CoKreslit = kruhy then DXDraw1.Surface.Canvas.Ellipse( x-Rad, y-Rad, x+Rad, y+Rad ) else DXDraw1.Surface.Canvas.Rectangle( x-Rad, y-Rad, x+Rad, y+Rad ); end; // jeste pridame FPS with DXDraw1.Surface.Canvas do begin Brush.Color:=clWhite; TextOut(5,5,'FPS: '+IntTOStr(DXTimer1.Framerate)); Release; // !!!! end; DXDraw1.Flip; end;

Tím máme program hotov a můžeme jej rovnou přeložit a spustit. Jak vypadá vidíte zde (program kreslí každý kruh pořád na jiném místě, tudíž nakonec vznikne efekt animace, který je opravdu hezký :)

Pokud si nastavíte proměnnou CoKreslit na ctverce, vypadá efekt také zajímavě:

Průměrné barvy podruhé

V našem druhém příkladě se pokusíme o trochu něco jiného - budeme obrázek rozpixelovávat tak, jak to dělají grafické editory. Každý čtverec přesně pasuje k čtvercům okolním. Kreslit budeme od největšího k nejmenšímu, až se nakonec dostaneme k výslednému obrázku. Tento efekt se dá hezky použít například ve hře na začátku při zobrazování loga tvůrců. Pokud žádný obrázek nemáte zrovna při ruce, zde jeden je (není to logo žádné firmy, nakreslil jsem jej já ve photoshopu):

Spustíme delphi a můžeme otevřít minulý projekt. Do komponenty Image nahrajeme nový obrázek a podle nové velikosti nastavíme novou velikost DXDraw. Komponenty Label a TrackBar můžete vymazat, stejně tak jako všechny procedury a proměnné. Ty si definujeme trochu jiné a pouze dvě - RSize:integer ve které bude uložena velikost kresleného obdélníku (nastavíme na začátek na 50) a Pocet:integer definující počet testovaných pixelů (na začátek nastavíme na 25).
Nyní se již můžeme vrhnout na proceduru DXTimer.OnTimer. Kód je přibližně stejný jako u minulého příkladu, pouze zmenšujeme velikost proměnných RSize a Pocet. Pokud se dostaneme s velikostí čtverce na 2 pixely, nekreslíme čtverec, ale jednoduše kopírujeme obrázek z komponenty Image. A to je opravdu celé. Zde je výpis procedury:

// DXTIMER ====================== procedure TForm1.DXTimer1Timer (Sender: TObject; LagCount: Integer); var c: TColor; // barva testovaneho pixelu z image r,g,b: byte; // vysledna barva kruhu sr,sg,sb: integer; // pomocne promenne pro barvu i,j: integer;// pom. promenne pro cyklus ix,iy:integer;// pozice kresleného čtverce begin DXDraw1.Surface.Fill(0); // kreslit pixelovany obrazek, nebo normal ? if RSize <> 0 then begin // pocet kruhu, ktere se kresli for ix:=0 to (DXDraw1.SurfaceWidth div RSize-1) do begin for iy:=0 to (DXDraw1.SurfaceHeight div RSize-1) do begin sr := 0; sg := 0; sb := 0; for j:=1 to pocet do begin // vezmeme nahodny bod z obrazku, ktery je nekde // uvnitr kruhu, ktery budeme kreslit... c := Image1.Canvas.Pixels [ix*(RSize)+random(RSize),iy*RSize+random(RSize)]; // slozky barvy RGB pricteme k sr,sg,sb sr := sr+GetRValue(c); // R slozka barvy sg := sg+GetGValue(c); // G --//-- sb := sb+GetBValue(c); // B --//-- end; // delenim promennou pocet ziskame // konecnou barvu kresleneho kruhu... r := sr div pocet; g := sg div pocet; b := sb div pocet; // takze to uz staci jen nakreslit.. DXDraw1.Surface.Canvas.pen.Style := psClear; DXDraw1.Surface.Canvas.Brush.Color := RGB(r,g,b); DXDraw1.Surface.Canvas.Rectangle (ix*RSize,iy*RSize, (ix*RSize+RSize)+1,(iy*RSIze+RSize)+1); end; end; RSize:=RSize-1; if RSize=2 then RSize:=0; // podle velikosti ctverce nastavime // pocet testovanych pixelu Pocet:=(RSize div 2)+1; if Pocet = 1 then Pocet:=2; end else begin // pokud je RSize 0, tj ctverce jsou velke 1 pixel, // nekreslime ctverce, ale kopirujeme obrazek... DXDraw1.Surface.Canvas.CopyRect (rect(0,0,200,300),Image1.Picture.Bitmap.Canvas, rect(0,0,200,300)); end; // jeste pridame FPS with DXDraw1.Surface.Canvas do begin Brush.Color:=clBlack; Font.Color:=clAqua; TextOut(5,5,'FPS: '+IntTOStr(DXTimer1.Framerate)); Release; // !!!! end; DXDraw1.Flip; end;

Program můžete přeložit, spustit a sledovat, jak se hezky mění zprvu pár čtverců na hezké logo. Zde je pár screenshotů chvíli po sobě:

A to je pro dnešek opravdu vše.

Download

Zde si můžete stáhnout dnes vytvořený příklad a zdrojáky (210 kB).