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

Odběr fotomagazínu

Fotografický magazín "iZIN IDIF" každý týden ve Vašem e-mailu.
Co nového ve světě fotografie!

 

Zadejte Vaši e-mailovou adresu:

Kamarád fotí rád?

Přihlas ho k odběru fotomagazínu!

 

Zadejte e-mailovou adresu kamaráda:

Soutěž

Sponzorem soutěže je:

IDIF

 

Kde se koná výstava fotografií Luďka Vojtěchovského?

V dnešní soutěži hrajeme o:



Delphi

Speciální grafické efekty v DelphiX

delphi_effects

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



Obsah seriálu (více o seriálu):

Tématické zařazení:

 » Rubriky  » Delphi  

 » Rubriky  » Windows  

 

 

 

Nejčtenější články
Nejlépe hodnocené články

 

Přihlášení k mému účtu

Uživatelské jméno:

Heslo: