Programowanie w języku Delphi » Gotowce

Engine 3D

POPRAWIONA WERSJA



Na początek proponuję stworzyć sobie bazkę procedur których często będziesz
używał w swoim późniejszym programie. Pozamykaj wszystkie projekty w delphi i
naciśnij z menu "Nowy Unit", zapisz go i zaczniemy pisać.


X=szerość
Y=wysokość
Z=odległość

2D = 2 wymiar X, Y
3D = 3 wymiar X, Y, Z


W uses napisz:
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls.


Na początku napisz (za uses)
type
   _3DPoint = record
   X:integer;
   Y:integer;
   Z:integer;
end;


Tworzy on rekord _3DPoint składający się z 3 wartości X, Y, Z. Czyli jest to
punkt w przestrzeni (3D).

Teraz przydałaby się nam funkcja która zwraca z trzech wartości X, Y i Z punkt _3DPoint:
function _3DP(X, Y, Z: integer): _3Dpoint;
begin
   result.X:=X;
   result.Y:=Y;
   result.Z:=Z;
end; 


Teraz procedura, która tworzy z punktu 3D punkt 2D. Potrzebne jest to dlatego, że przecież
nie narysujesz na ekranie 2D punktu 3D, skoro ekran jest płaski.
Procedure _3Dto2D(X, Y, Z: Real; ScreenWidth, ScreenHeight: Integer; Var 
TargetX, TargetY: Integer);
begin
   TargetX := (ScreenWidth div 2) + Trunc(X / Z);
   TargetY := (ScreenHeight div 2) + Trunc(Y / Z);
end;


Parametry TargetX i TargetY muszą być zmiennymi, ponieważ procedura zapisuje w
nich wartości:
TargetX = rzeczywista szerokość z punktu X,Y,Z [3D]
TargetY = rzeczywista wysokość z punktu X,Y,Z [3D]

Parametry ScreenWidth i ScreenHeight to:
ScreenHeight = wysokość powierzchni po której chcesz rysować,
ScreenWidth = szerokść powierzchni po której chcesz rysować

Muszą być uwzględnione ponieważ punkt 0,0,0 [3D] będzie się znajdował w środku
powierzchni po której chcesz rysować. Czyli:

-x,-y | x,-y
      |
 -----+-----
      |
-x,y  |  x,y


+ to jest punkt 0,0,0 [3D]

Teraz procedura rysująca linie 3D w kolorze podanym jako col na powierzchni image
z puktu xyz do puntu toxyz:
Procedure _3Dline(xyz: _3Dpoint; toXYZ: _3Dpoint; col: TColor; Var image: TBitmap);
var
   nx, ny, xx, yy: integer;
begin
   _3dto2d(xyz.X, xyz.y, xyz.z, image.Width, image.Height, nX, nY);
   _3dto2d(toxyz.X, toxyz.y, toxyz.z, image.Width, image.Height, XX, YY);
   image.Canvas.Pen.Color:=col;
   image.Canvas.Brush.Color:=col;
   image.Canvas.MoveTo(nx, ny);
   image.Canvas.LineTo(XX, YY);
end;


Teraz kwadrat [3D]: jeżeli transparent:=true to jest przezroczysty, jeżeli nie, to
jest kolorowany przez kolor background i jest rysowany na powierzchni image
Procedure _3DRectange(p1, p2, p3, p4: _3Dpoint; transparent: boolean; background: TColor; col: TColor; Var image: TBitmap);
var
pt:array [1..4] of Tpoint;
begin
   _3dto2d(p1.x, p1.y, p1.y, image.Width, image.Height, pt[1].x, pt[1].y);
   _3dto2d(p2.x, p2.y, p2.y, image.Width, image.Height, pt[2].x, pt[2].y);
   _3dto2d(p3.x, p3.y, p3.y, image.Width, image.Height, pt[3].x, pt[3].y);
   _3dto2d(p4.x, p4.y, p4.y, image.Width, image.Height, pt[4].x, pt[4].y);
   image.Canvas.Pen.Color:=col;
      if not transparent then image.Canvas.Brush.Color:=background else 
   image.Canvas.Brush.Style:=bsclear;
   image.Canvas.Polygon(pt);
end;


Kostka działa podobnie do kwadratu, ale niezbyt dobrze. Punkty połączeń:

  5----8
  |\   |\
  | 1--+-4
  | |  | |
  6-+--7 |
   \|   \|  
    2----3


Procedure _3DCube(XYZ, XYZ2, XYZ3, XYZ4, XYZ5, XYZ6, XYZ7, XYZ8: _3Dpoint; transparent:boolean; background: TColor; col: TColor; Var image: TBitmap);
begin
   _3drectange(Xyz5, Xyz6, Xyz7, Xyz8, transparent, background, col, image);
   _3drectange(Xyz6, Xyz2, Xyz3, Xyz7, transparent, background, col, image);
   _3drectange(Xyz5, Xyz6, Xyz2, Xyz, transparent, background, col, image);
   _3drectange(Xyz4, Xyz3, Xyz7, Xyz8, transparent, background, col, image);
   _3drectange(Xyz5, Xyz, Xyz4, Xyz8, transparent, background, col, image);
   _3drectange(Xyz, Xyz2, Xyz3, Xyz4, transparent, background, col, image);
end;


Cały kod unitu poniżej:
unit _3dengine;
 
interface
 
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls;
 
type
_3DPoint = record
   X:integer;
   Y:integer;
   Z:integer;
end;
 
function _3DP(X, Y, Z: integer): _3Dpoint;
procedure _3Dto2D(X, Y, Z: Real; ScreenWidth, ScreenHeight: Integer; Var TargetX, TargetY: Integer);
procedure _3Dline(xyz: _3Dpoint; toXYZ: _3Dpoint; col: TColor; Var Image: TBitmap);
procedure _3DRectange(p1, p2, p3, p4:_3Dpoint; transparent: boolean; background: TColor; col: TColor; Var image: TBitmap);
procedure _3DCube(XYZ, XYZ2, XYZ3, XYZ4, XYZ5, XYZ6, XYZ7, XYZ8: _3Dpoint; transparent: boolean; background: TColor; col: TColor; Var image: TBitmap);
 
implementation
 
function _3DP(X, Y, Z: integer): _3Dpoint;
begin
   result.X:=X;
   result.Y:=Y;
   result.Z:=Z;
end;
 
Procedure _3Dto2D(X,Y,Z:Real; ScreenWidth,ScreenHeight:Integer; Var 
TargetX,TargetY:Integer);<br>
begin
   TargetX := (ScreenWidth div 2) + Trunc(X / Z);
   TargetY := (ScreenHeight div 2) + Trunc(Y / Z);
end;
 
procedure _3Dline(xyz: _3Dpoint; toXYZ: _3Dpoint; col: TColor; Var image: TBitmap);
var
nx, ny, xx, yy: integer;
begin
   _3dto2d(xyz.X, xyz.y, xyz.z, image.Width, image.Height, nX, nY);
   _3dto2d(toxyz.X, toxyz.y, toxyz.z, image.Width, image.Height, XX, YY);
   image.Canvas.Pen.Color:=col;
   image.Canvas.Brush.Color:=col;
   image.Canvas.MoveTo(nx, ny);
   image.Canvas.LineTo(XX, YY);
end;
 
procedure _3DRectange(p1, p2, p3, p4: _3Dpoint; transparent: boolean; background: TColor; col: TColor; Var image: TBitmap);
var
pt:array [1..4] of Tpoint;
begin
   _3dto2d(p1.x, p1.y, p1.y, image.Width, image.Height, pt[1].x, pt[1].y);
   _3dto2d(p2.x, p2.y, p2.y, image.Width, image.Height, pt[2].x, pt[2].y);
   _3dto2d(p3.x, p3.y, p3.y, image.Width, image.Height, pt[3].x, pt[3].y);
   _3dto2d(p4.x, p4.y, p4.y, image.Width, image.Height, pt[4].x, pt[4].y);
   image.Canvas.Pen.Color:=col;
      if not transparent then image.Canvas.Brush.Color:=background else 
   image.Canvas.Brush.Style:=bsclear;
   image.Canvas.Polygon(pt);
end;
 
procedure _3DCube(XYZ, XYZ2, XYZ3, XYZ4, XYZ5, XYZ6, XYZ7, XYZ8: _3Dpoint; transparent:boolean; background: TColor; col: TColor; Var image: TBitmap);
begin
   _3drectange(Xyz5, Xyz6, Xyz7, Xyz8, transparent, background, col, image);
   _3drectange(Xyz6, Xyz2, Xyz3, Xyz7, transparent, background, col, image);
   _3drectange(Xyz5, Xyz6, Xyz2, Xyz, transparent, background, col, image);
   _3drectange(Xyz4, Xyz3, Xyz7, Xyz8, transparent, background, col, image);
   _3drectange(Xyz5, Xyz, Xyz4, Xyz8, transparent, background, col, image);
   _3drectange(Xyz, Xyz2, Xyz3, Xyz4, transparent, background, col, image);
end;
 
end.


Autor PsYcHoSzAyBeR, Paweł Wilkowski.

16 komentarzy

mopsiok 2008-12-01 20:43

a jak sie tego uzywa? :D znaczy co trzeba wpisac, bo nie do konca kminie, zrobilem to wszystko w jednym unicie, i nie wiem co trzeba na forme wrzucic zeby dzialalo (np na kostce 3D). Wrzucilem imageboxa, buttona i w buttonie dalem funkcje:
_3DCube(001,021,221,201,000,020,220,200,false,clBlue,clRed,image1);
i wywala blad w tych wszystkich 001,021 itp. bo musze okreslic 3dpointy a nie integery, tylko jakbym wiedzial jak sie to okresla...

skalniak 2006-07-24 12:54

Slepak : ale to nie bedzie rzutowanie perspektywistytczne:)

konik 2006-07-24 12:30

Uffff... Właśnie zrobiłem poprawki :).
Zmiany:

  • Poprawienie literówek oraz błędów ortograficznych i (rażących) gramatycznych
  • tagi <delphi>
  • formatowanie kodu
  • poprawki wizualne
  • usunięcie niepotrzebnego formatowania HTML

W treść kodu się zbytnio nie zagłębiałem, więc ewentualnych błędów nie poprawiłem...

Slepak 2006-04-14 16:09

jednym najszybszych renderow jakim znam jest:

pomoc = z/ (z + d)
xe = x * pomoc
ye = y * pomoc

gdzie

x - współrzędna x punktu
y - współrzędna y punktu
z - współrzędna z punktu
d - odległość ekranu od obserwatora
xe - współrzędna x punktu na ekranie
ye - współrzędna y punktu na ekranie

tylko jedno dzielenie = 2x szybszy algorytm

T-kOrreD 2004-05-18 13:43

Ale nie wziąłeś pod uwagę tego, że "kamera" może się znaleźć przed obiektem. Ja też próbowałem napisać coś takiego, z uwzględnieniem kątów nachylenia, ale efekt jest dość interesujący :)

psychoszayber 2003-04-06 14:25

Jak Crono Napisał To jest "3D linear"

ZIOMBER 2003-04-06 13:39

nie czytalem dokladnie kodu ale mam jedne ale, nie ma czegos tutaj takiego jak przeksztalcenie wzgledem pozycji kamery oraaz wzgledem padania kata widzenia[x axis, y axis] oraz przeksztalcenia kata widzenia fov :/

Crono 2003-04-05 22:21

rysunek mi nie wyszedł, ale mam nadzieje, że rozumieć się da bez niego

Crono 2003-04-05 22:19

No tak, ale to jest "3D linear"
Wzory pozmieniaj na:

X':= x0- (x-x0)/(z-z0)*z0
Y':= k(y0- (y-y0)/(z-z0)*z0)

przy czym:

k - szerokość ekr/wysokość ekranu


x0,y0,z0 - współrzędne pynktu w przestrzeni
x,y,z      - współrzędne obserwatora przed ekranem....(można dzć stałe [0,0,0] im większe z tym węższy zakres widzialności pynktów)

 \                                     /

  • \ * / *
A  \                B             /         C
      \                           /
       ----------------------    ekran
         \          |          /
            \       |       /
               \    |    /
                 \  | /
                    * obserwator
 


jak widać tylko punkt B może być widoczny na ekranie więc trza napisać w procedurce zabezpieczenie

z jest ujemne!!!!


zwiększając y daje się efekt podnoszenia kamery


do tego można pynkty obracać o kąt względem osi OX OY OZ.
Skalować względem punktu...
no i zmieniać połoźenie "kamery" a takrze jej kąt nachylenia do OX OY OZ.


TO BY BYŁO PROSTE 3D






Ktos 2003-04-05 16:47

mam 2 zastrzeżenia: 1. ENGINE nie ENGIN i 2. używaj tagu < delphi > i jakos napisz czytelniej kod. Źle się czyta/analizuje :) ale, art spoko

roSzi 2003-04-05 14:38

skoro sa problemy z odpaleniem, to moze moglbys zalaczyc zrodla gotowego projektu, ktory mozna o razu uruchomic?

psychoszayber 2003-04-05 12:53

Drajwer to sie tak nie robi. Jeżeli chcesz narysować to to musisz użyć double bufferingu i będzie chodzić supeer płynnie.

Drajwer 2003-04-05 09:36

STARY TO JEST POPIEPRZONE :[

PS. naprawde duzo czasu potrzeba zaby to uruchomic... ale sie da
PS2. sory za capsa;)

Drajwer 2003-04-05 09:31

hehe moze sie przydac:)

psychoszayber 2003-04-04 22:45

Sory za błędy ale pisałem w pośpiechu

psychoszayber 2003-04-04 22:44

Jeżeli czegoś nie rozumiesz to mail ślij do mnie