[shorox]

Вот чтото наподобии, что и как тут можно изменить чтобы получился однополостный гиперболоид?

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons;

type
  matrix = array[1..4,1..4] of real;
  vector = array[1..4] of real;
  TForm1 = class(TForm)
    Image1: TImage;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn6: TBitBtn;
    BitBtn7: TBitBtn;
    function ii(x:real):integer;
    function jj(y:real):integer;
    function Mult_matr_vect(m:matrix;v:vector):vector;
    function Mult_matr(m1,m2:matrix):matrix;
    procedure Draw(m:matrix);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure BitBtn7Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }

  public
    { Public declarations }

  end;
const
  D_plus:matrix=((1.1,0,0,0),
                 (0,1.1,0,0),
                 (0,0,1.1,0),
                 (0,0,0,1));
  D_minus:matrix=((0.9,0,0,0),
                  (0,0.9,0,0),
                  (0,0,0.9,0),
                  (0,0,0,1));
  cosp=0.9945;
  sinp=0.1045;
  Matr1:matrix=((1,0,0,0),
                (0,1,0,0),
                (0,0,1,0),
                (0,0,0,1));
  Rx:matrix=((1,0,0,0),
             (0,cosp,sinp,0),
             (0,-sinp,cosp,0),
             (0,0,0,1));
  Ry:matrix=((cosp,0,-sinp,0),
             (0,1,0,0),
             (sinp,0,cosp,0),
             (0,0,0,1));
  Rz:matrix=((cosp,sinp,0,0),
             (-sinp,cosp,0,0),
             (0,0,1,0),
             (0,0,0,1));
  PRO:matrix=((1,0,0,0),
              (0,1,0,0),
              (0.35,0.35,0,0),
              (0,0,0,1));
  e1:vector=(1,0,0,1);
  e2:vector=(0,1,0,1);
  e3:vector=(0,0,1,1);


var
  Form1: TForm1;
  x0:real=-4;
  x1:real=4;
  y0:real=-4;
  y1:real=4;
  mat:matrix;


implementation

{$R *.dfm}

function TForm1.Mult_matr_vect(m:matrix;v:vector):vector;
  var
    w:vector;
    k,l:integer;
    s:real;
begin
  for k:=1 to 4 do
  begin
    s:=0;
    for l:=1 to 4 do
      s:=s+v[l]*m[k,l];
    w[k]:=s;
  end;
  result:=w;
end;

function TForm1.ii(x:real):integer;
begin
  ii:=trunc((x-x0)/(x1-x0)*Form1.Image1.Width);
end;

function TForm1.jj(y:real):integer;
begin
  jj:=trunc((y1-y)/(y1-y0)*Form1.Image1.Height);
end;

function TForm1.Mult_matr(m1,m2:matrix):matrix;
  var
    k,l,n:integer;
    w:matrix;
    s:real;
begin
  for k:=1 to 4 do
  begin
    for l:=1 to 4 do
    begin
      s:=0;
      for n:=1 to 4 do
      s:=s+m1[k,n]*m2[n,l];
      w[k,l]:=s;
    end;
  end;
  result:=w;
end;

procedure TForm1.Draw(m:matrix);
  var
    a,b,c:vector;
    i,j,w,h,Ic,Jc:integer;
    t:real;

  procedure figur(c1,c2,c3,c4:real);
  begin
    c[1]:=c1;
    c[2]:=c2;
    c[3]:=c3;
    c[4]:=c4;
    a:=Mult_matr_vect(m,c);
    b:=Mult_matr_vect(PRO,a);
    i:=ii(b[1]);
    j:=jj(b[2]);
    Form1.Image1.Canvas.Pixels[i,j]:=clred;
  end;

  procedure koord(e:vector; ch:char);
  begin
    a:=Mult_matr_vect(m,e);
    b:=Mult_matr_vect(PRO,a);
    i:=ii(b[1]);
    j:=jj(b[2]);
    Form1.Image1.Canvas.MoveTo(Ic,Jc);
    Form1.Image1.Canvas.LineTo(i,j);
    Form1.Image1.Canvas.TextOut(i,j,ch);
  end;
begin
  w:=Form1.Image1.Width-1;
  h:=Form1.Image1.Height-1;
  Ic:=w div 2;
  Jc:=h div 2;
  Form1.Image1.Canvas.Rectangle(0,0,w,h);
  koord(e1,'X');
  koord(e2,'Y');
  koord(e3,'Z');
  t:=-1;
  while t<1 do
  begin
    figur(t,t*t,0,1);
    figur(t,t*t+0.25,0.5,1);
    figur(t,t*t+0.25,-0.5,1);
    figur(0,t*t,t,1);
    figur(0.5,t*t+0.25,t,1);
    figur(-0.5,t*t+0.25,t,1);
    figur(-1,t*t+1,t,1);
    figur(1,t*t+1,t,1);
    figur(t,t*t+1,-1,1);
    figur(t,t*t+1,1,1);
    t:=t+0.001;
  end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  mat:=Mult_matr(mat,Rx);
  Draw(mat);
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  mat:=Mult_matr(mat,Ry);
  Draw(mat);
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  mat:=Mult_matr(mat,Rz);
  Draw(mat);
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
begin
  mat:=Mult_matr(mat,D_plus);
  Draw(mat);
end;

procedure TForm1.BitBtn7Click(Sender: TObject);
begin
  mat:=Mult_matr(mat,D_minus);
  Draw(mat);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  image1.Width:=ClientWidth;
  image1.Height:=ClientHeight-50;
  Draw(Matr1);
  mat:=Matr1;
end;

end.