PROJECTION 3D

cs_koko Messages postés 654 Date d'inscription lundi 14 janvier 2002 Statut Membre Dernière intervention 20 février 2005 - 7 déc. 2003 à 10:07
 Utilisateur anonyme - 20 nov. 2007 à 11:53
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/18474-projection-3d

Utilisateur anonyme
20 nov. 2007 à 11:53
Oui pas mal !
Petite amélioration pour eviter que ça devienne le bordel =)

unit Main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
T3DPoint = record
X : LongInt;
Y : LongInt;
Z : LongInt;
end;
type
TFrmMain = class(TForm)
Img: TImage;
procedure FormCreate(Sender: TObject);
private
{ Déclarations privées }
Points: array[1..8] of T3DPoint;
procedure CreerPoint(const Index, x, y, z: Integer);
procedure Bouge(const IndexPoint: Integer);
procedure Ligne(const IndexCible: Integer; const IndexDepart: Integer = 0);
public
{ Déclarations publiques }
function Get2DCoords(Point : T3DPoint): TPoint;
end;

var
FrmMain: TFrmMain;

implementation

{$R *.dfm}

function TfrmMain.Get2DCoords(Point : T3DPoint): TPoint;
var Buffer: TPoint;
begin
Buffer.X := Trunc(((Point.X - 344) * (256 / (256 + Point.Z))) + 344);
Buffer.Y := Trunc(((Point.Y - 223) * (256 / (256 + Point.Z))) + 223);
Get2DCoords := Buffer;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
var Buffer : T3DPoint;
L: Integer;
begin
FillChar(Points, SizeOf(Points), 0);
L:= 200;
CreerPoint(1, 0, 0, 0);
CreerPoint(2, L, 0, 0);
CreerPoint(3, L, 0, L);
CreerPoint(4, 0, 0, L);
CreerPoint(5, 0, L, 0);
CreerPoint(6, L, L, 0);
CreerPoint(7, L, L, L);
CreerPoint(8, 0, L, L);

with Img.Canvas do
begin
Bouge(1);
Ligne(2);
Ligne(3);
Ligne(4);
Ligne(1);
Ligne(5);
Ligne(6);
Ligne(7);
Ligne(8);
Ligne(5);
Ligne(1, 5);
Ligne(2, 6);
Ligne(3, 7);
Ligne(4, 8);
end;
end;

procedure TFrmMain.CreerPoint(const Index, x, y, z: Integer);
begin
Points[Index].X:= x;
Points[Index].Y:= y;
Points[Index].Z:= z;
end;

procedure TFrmMain.Bouge(const IndexPoint: Integer);
begin
Img.Canvas.PenPos := Get2DCoords(Points[IndexPoint]);
end;

procedure TFrmMain.Ligne(const IndexCible: Integer; const IndexDepart: Integer = 0);
begin
if IndexDepart > 0 then
Bouge(IndexDepart);
Img.Canvas.LineTo(Get2DCoords(Points[IndexCible]).X, Get2DCoords(Points[IndexCible]).Y);
end;

end.
cs_koko Messages postés 654 Date d'inscription lundi 14 janvier 2002 Statut Membre Dernière intervention 20 février 2005
7 déc. 2003 à 10:07
du beau travail !!!
Rejoignez-nous