Bludiště 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:



Delphi

Bludiště v DelphiX

delphi_bludiste

27. srpna 2001, 00.00 | Chcete se dozvědět, jak v DelphiX nakreslit kruhový oblouk, nebo rovnou celé bludiště ? V tom případě je dnešní článek určen právě vám !



Při brouzdání internetem jsem našel celkem zajímavou soutěž inspirovanou demoscénou. A to velikostí - podle 4kB dem se tvoří 4kB velký webdesing (html, java a flash), přesně tedy 4096 bajtů. Podle toho má soutěž i název - WEB4096 a je na adrese http://web4096.message.sk.


Při takovýchto podmínkách jdou tvůrci většinou až na samou hranici prohlížečů, a tak není divu, že vznikají obdivuhodná díla. Co mě ale zaujalo byla tvorba v javě s názvem dynamic labyrint, kde labyrint v prohlížeči postupně měnil svůj tvar. A jelikož mě to zaujalo opravdu hodně, zkusil jsem něco podobného udělat v Delphi s DelphiX. Jak na to se vám pokusím popsat v dnešním článku.

Hlavní činnost programu bude spočívat v kreslení kruhovách výsečí, proto byschom si měli říct, jakým způsobem něco takového nakreslit. Použijeme k tomu funkci Arc která má osm parametrů. Lépe než nějaký text vám určitě k pochopení poslouží tento obrázek:


Opravdu to není nic složitého. Nesmíme hlavně zapomenout na to, že se oblouk kreslí proti směru hodinových ručiček od bodu 3 do bodu 4.
Budeme tedy kreslit řekněme třeba devět oblouků, každý bude od předchozího vzdálen o deset pixelů, přičemž první bude od středu o dvacet (to aby nebyl tak malý). V každém oblouku bude jednen průchod široký 20° (později toto ještě upravíme). Dále se bude každý lichý oblouk točit po směru a každý suchý proti směru hodinových ručiček (jestli je to přesně naopak tak se omlouvám). Víc toho ani znát nemusíme a můžeme se pustit do programování.

Nejprve si definujeme proměnnou kruhy jako pole typu TPoint, ve které bude uložen první a druhý úhel oblouku (nechtělo se mi definovat nový typ, proto jsem použil TPoint, jelikož jsem potřeboval dvě čísla. Nenechte se proto prosím zmást).


   kruhy : array [1..10] of TPoint; // uhel 1 a uhel 2


Dále vytvoříme proceduru Form1.OnCreate a v ní si hned všechny úhly nastavíme:


// ====== FORM CREATE ========================
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
 Randomize;
 // nastavení úhlů
 for i:=2 to 10 do
  begin
   kruhy[i].x:=Random(36)*10; // první úhel - náhodně
   kruhy[i].y:=kruhy[i].x-10; // druhý úhel
  end;
end;


Dále si vytvoříme proceduru DXTimer1.OnTimer. V ní si nejprve zjistíme střed plochy, který uložíme do proměnných cx a cy. Dále vymažeme plochu bílou barvou (všechno nemusí být černé :), vypočteme body pro průchody v kruhu (pt1 a pt2 typu TPoint), upravíme pro naše souřadnice (bod 0,0 odpovídá levému hornímu rohu zatímco ve skutečnosti je bod 0,0 vlevo dole). Dále každý oblouk pootočíme a nakonec nám nezbývá nic jiného než oblouky nakreslit. Výpis celé procedury je zde:


procedure TForm1.DXTimer1Timer(Sender: TObject; LagCount: Integer);
var cx,cy,pol:integer;
pt1,pt2,pt3,pt4:TPoint;
i:integer;
begin
 // vymazat pozadí
 DXDraw1.Surface.Fill(clWhite);

 // střed DXDraw...
 cx:=DXDraw1.SurfaceWidth div 2;
 cy:=DXDraw1.SurfaceHeight div 2;

for i:=2 to 10 do
 begin
   // poloměr kruhu
   Pol:=i*10;

   // začátek "díry" v kruhu
   pt1.x:=Trunc(cos(DegToRad(kruhy[i].x))*pol);
   pt1.y:=Trunc(sin(DegToRad(kruhy[i].x))*pol);

   // konec "díry" v kruhu
   pt2.x:=Trunc(cos(DegToRad(kruhy[i].y))*pol);
   pt2.y:=Trunc(sin(DegToRad(kruhy[i].y))*pol);

 // sudý kruh otáčíme naopak než lichý...
 if i mod 2 = 1 then
  begin
   Dec(kruhy[i].x,1);
   Dec(kruhy[i].y,1);
  end
 else
  begin
   Inc(kruhy[i].x,1);
   Inc(kruhy[i].y,1);
  end;

 // posuneme body na naše souřadnice - cx,cy...
 pt1.x:=pt1.x+cx;
 pt1.y:=cy-pt1.y;
 pt2.x:=pt2.x+cx;
 pt2.y:=cy-pt2.y;

 with DXDraw1.Surface.Canvas do
  begin
   Brush.Style:=bsClear;
   Pen.Color:=clBlack;

   // vlastní kreslení oblouku
   Arc(cx-pol,cy-pol,cx+pol,cy+pol,pt1.x,pt1.y,pt2.x,pt2.y);

  end;

end; // end for

 // nakonec ještě otazník
 with DXDraw1.Surface.Canvas do
  begin
   with Font do
    begin
      COlor:=clBlack;
      Name:='Arial';
      Size:=10;
      Style:=[fsBold];
    End;

   TextOut(cx-3,cy-7,'?');
   release;    // !!
  end;

 // a už jen flip... 
 DXDraw1.FLip;
end;


Pokud program spustíme, bude vypadat nějak takto:


Na první pohled je však zřejmé, že tím, že jsme nastavili každý průchod pevně na úhel 20° vznikl celkem nehezký efekt. A to ten, že u nejmenšího kruhu je průchod sotva patrný, zatímco u největšího je opravdu velký. To samozřejmě nechceme, proto si teď ukážeme, jak nastavit šířku průchodu pevně například na dvacet pixelů, což znamená, že u každého oblouku bude jiný úhel.

Opět to nebude nic jiného, než trocha matematiky:


Pokud známe tento vzorec, není žádný problém vytvořit nový pro výpočet úhlu alpha a poté přidat do procedury OnCreate. První úhel necháme opět náhodně a druhý pracně dopočítáme. Výsledek bude vypadat nějak takto:


// ====== FORM CREATE ========================
procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
alpha,a,pol:integer;
begin
 Randomize;
 // nastavení úhlů
 for i:=2 to 10 do
  begin
   kruhy[i].x:=Random(36)*10; // první úhel - náhodně

   // kruhový oblouk                     .
   //      2pi * r                       .
   // a = ---------  * alpha             .
   //        360                         .

   a:=20;  // velikost průchodu bludiště
   pol:=i*10;
   alpha:=Trunc(a/((2*pi*pol)/(360)));

   kruhy[i].y:=kruhy[i].x-alpha; // druhý úhel
  end;
end;


Program můžete znovu spustit a opravdu - všechny průchody jsou již stejně široké.


Když už jsme u toho, proč si nepřidělat ještě nějaké ty čáry mezi jednotlivými oblouky ? Řekněme, že každá čára bude začínat u bodu pt2 a půjde pod stejným ůhlem až k druhému oblouku (tedy k bodu pt4 který si vypočítáme). U posledního, tedy desátého samozřejmě kreslit čáru nebudeme. Zde je kód který musíme přidat pro správné fungování:


...
   // p4 - čára mezi kruhy
   pt4.x:=Trunc(cos(DegToRad(kruhy[i].y))*(pol+10));
   pt4.y:=Trunc(sin(DegToRad(kruhy[i].y))*(pol+10));
...

...
 // posuneme body na naše souřadnice - cx,cy...
 pt4.x:=pt4.x+cx;
 pt4.y:=cy-pt4.y;
...

...
   // kreslení čáry
   if i <> 10 then
    begin
     MoveTo(pt2.x,pt2.y);
     LineTo(pt4.x,pt4.y);
    end;
...


Jako obvykle si program přeložíme a spustíme, výsledek bude zřejmě podobný tomuto:


A tím bychom mohli i dnes skončit. Pokud však opravdu chcete ještě něco extra, zkuste místo nastavení barvy pera na čarnou přidat tento řádek:


   // barva podle vzdálenosti od středu...
   Pen.Color:=RGB(i*22,i*22,i*22);


Výsledek bude ještě hezčí. A to je pro dnešek opravdu vše.


Download

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

Relevantní články

Seriál - Tvorba her v DelphiX
Seriál - Tvorba hry Had v DelphiX
Zobrazení části obrázku v DelphiX
Komponenta DXImageList
Simulace sněžení v DelphiX
Zobrazení kurzoru v DelphiX
Posuvný text v DelphiX
Isometrický engine v DelphiX
Sprity v DelphiX (C++ Builder)


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: