Engine 3D

<font face="Courier New" size="5">POPRAWIONA WERSJA</span>

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
</dfn>

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:

<font face="Courier New">-x,-y | x,-y
|
-----+-----
|
-x,y | x,y </span>

• 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ń:

<font face="Courier New"> 5----8
|\ |
| 1--+-4
| | | |
6-+--7 |
| |
2----3</span>

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.