Центральная (перспективная) проекция усеченной пирамиды

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    PaintBox1: TPaintBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
  var X, Y, Z : Array[0..7] Of Real;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  //определяем координаты усеченной пирамиды
  X[0] := -1.0; Y[0] := -1.0; Z[0] :=  1.0;
  X[1] :=  1.0; Y[1] := -1.0; Z[1] :=  1.0;
  X[2] :=  1.0; Y[2] :=  1.0; Z[2] :=  1.0;
  X[3] := -1.0; Y[3] :=  1.0; Z[3] :=  1.0;
  X[4] := -0.5; Y[4] := -0.5; Z[4] :=  3.0;
  X[5] :=  0.5; Y[5] := -0.5; Z[5] :=  3.0;
  X[6] :=  0.5; Y[6] :=  0.5; Z[6] :=  3.0;
  X[7] := -0.5; Y[7] :=  0.5; Z[7] :=  3.0;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var i, minside, tmpx, tmpy : Integer;
  newx, newy, newz : Real;
  p1, p2 : TPoint;
begin
  //очищаем экран
  PaintBox1.Canvas.Clear;
 
  // вращение усеченной пирамиды
  // 1)Сдвигаем все точки в центр вращения
  for i := 0 to 7 do
  begin
    Z[i] := Z[i] - 2.0;
  end;
  // 2)вращаем точки
  for i := 0 to 7 do
  begin
    // пересчитываем значения
    // вращаем
    newx :=  0.9854317338*x[i]-0.1127537376*y[i]+0.1273220038*z[i];
    newy :=  0.1273220038*x[i]+0.9854317338*y[i]-0.1127537376*z[i];
    newz := -0.1127537376*x[i]+0.1273220038*y[i]+0.9854317338*z[i];
    x[i] := newx;
    y[i] := newy;
    z[i] := newz;
  end;
  // 3)сдвигаем обратно на исходную позицию
  for i := 0 to 7 do
  begin
    Z[i] := Z[i] + 2.0;
  end;
 
 
  // отрисовываем усеченную пирамиду:
  // 1) определяем меньшую сторону окна
  if (PaintBox1.Width < PaintBox1.Height) then minside := PaintBox1.Width
  else minside := PaintBox1.Height;
  // 2) перевод координат в экранные и отрисовка линий
  with PaintBox1.Canvas do
  begin
    //лицевая сторона
    tmpx := round((X[0]/Z[0]+2.0)*minside/4);
    tmpy := round((Y[0]/Z[0]+2.0)*minside/4);
    MoveTo(tmpx, tmpy);
    tmpx := round((X[1]/Z[1]+2.0)*minside/4);
    tmpy := round((Y[1]/Z[1]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
    tmpx := round((X[2]/Z[2]+2.0)*minside/4);
    tmpy := round((Y[2]/Z[2]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
    tmpx := round((X[3]/Z[3]+2.0)*minside/4);
    tmpy := round((Y[3]/Z[3]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
    tmpx := round((X[0]/Z[0]+2.0)*minside/4);
    tmpy := round((Y[0]/Z[0]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
 
    //задняя сторона
    tmpx := round((X[4]/Z[4]+2.0)*minside/4);
    tmpy := round((Y[4]/Z[4]+2.0)*minside/4);
    MoveTo(tmpx, tmpy);
    tmpx := round((X[5]/Z[5]+2.0)*minside/4);
    tmpy := round((Y[5]/Z[5]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
    tmpx := round((X[6]/Z[6]+2.0)*minside/4);
    tmpy := round((Y[6]/Z[6]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
    tmpx := round((X[7]/Z[7]+2.0)*minside/4);
    tmpy := round((Y[7]/Z[7]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
    tmpx := round((X[4]/Z[4]+2.0)*minside/4);
    tmpy := round((Y[4]/Z[4]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
 
    //левая сторона
    tmpx := round((X[0]/Z[0]+2.0)*minside/4);
    tmpy := round((Y[0]/Z[0]+2.0)*minside/4);
    MoveTo(tmpx, tmpy);
    tmpx := round((X[4]/Z[4]+2.0)*minside/4);
    tmpy := round((Y[4]/Z[4]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
    tmpx := round((X[7]/Z[7]+2.0)*minside/4);
    tmpy := round((Y[7]/Z[7]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
    tmpx := round((X[3]/Z[3]+2.0)*minside/4);
    tmpy := round((Y[3]/Z[3]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
    tmpx := round((X[0]/Z[0]+2.0)*minside/4);
    tmpy := round((Y[0]/Z[0]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
 
    //правая сторона
    tmpx := round((X[1]/Z[1]+2.0)*minside/4);
    tmpy := round((Y[1]/Z[1]+2.0)*minside/4);
    MoveTo(tmpx, tmpy);
    tmpx := round((X[2]/Z[2]+2.0)*minside/4);
    tmpy := round((Y[2]/Z[2]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
    tmpx := round((X[6]/Z[6]+2.0)*minside/4);
    tmpy := round((Y[6]/Z[6]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
    tmpx := round((X[5]/Z[5]+2.0)*minside/4);
    tmpy := round((Y[5]/Z[5]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
    tmpx := round((X[1]/Z[1]+2.0)*minside/4);
    tmpy := round((Y[1]/Z[1]+2.0)*minside/4);
    LineTo(tmpx, tmpy);
  end;
end;
 
end.