Построение перспективной проекции трехмерного объекта

var
  f: extended;
...
  f := 1000; // Дальность схождения координат. Подберите значение, которое больше устраивает.
...
procedure perspect(var x, y, z: extended);
begin
  x := f*x/(f-z);
  y := f*y/(f-z);
end;

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;
 
type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
 const VertexCount=8;
 const ViewDist=200;
 
type
TFigure = record
Vertexes: array[0..VertexCount - 1] of record
X, Y, Z: Double;
end;
Ribs: array[0..VertexCount - 1, 0..VertexCount - 1] of Boolean;
PrVertexes: array[0..VertexCount - 1] of record
prX, prY: Integer;
end;
end;
 
procedure ProjectFigure(var F: TFigure);//расчет координат проекции
var
I: Integer;
P: Double;
maxX, maxY:integer;
begin
maxX:=round(form1.Width/2);
maxY:=round(form1.Height/2);
for I := 0 to VertexCount - 1 do
with F.Vertexes[I], F.PrVertexes[I] do
begin
P:=z+ViewDist;
prX := maxX + Round(x * ViewDist/p);
prY := maxY + Round(y * ViewDist/p);
end;
 
 
 end;
procedure DrawProjection(F: TFigure); var I, J: Integer; //отрисовка проекции фигуры
  begin with F do for I := 0 to VertexCount - 2 do for J := I + 1 to VertexCount - 1 do
  if Ribs[I, J] then
  begin form1.Canvas.MoveTo(PrVertexes[I].prX, PrVertexes[I].prY);
  form1.Canvas.LineTo(PrVertexes[j].prX, PrVertexes[j].prY);
   end;
end;
 
 
procedure InitFigure; //инициальзация фигуры
 
  begin
    with Figure do
  begin
   Vertexes[0].x := 0;
   Vertexes[0].y := 0;
   Vertexes[0].z := 0;
   Vertexes[1].x := 0;
   Vertexes[1].y := 50;
   Vertexes[1].z := 0;
   Vertexes[2].x := 50;
   Vertexes[2].y := 0;
   Vertexes[2].z := 0;
   Vertexes[3].x := 50;
   Vertexes[3].y := 50;
   Vertexes[3].z := 0;
   Vertexes[4].x := 50;
   Vertexes[4].y := 0;
   Vertexes[4].z := 50;
   Vertexes[5].x := 50;
   Vertexes[5].y := 50;
   Vertexes[5].z := 50;
   Vertexes[6].x := 0;
   Vertexes[6].y := 0;
   Vertexes[6].z := 50;
   Vertexes[7].x := 0;
   Vertexes[7].y := 50;
   Vertexes[7].z := 50;
 
   Ribs[i, j] := True;
 
    end;
   end;
 
 
end.