Программа "Построение поверхности"

Код программы: unit Unit1;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, ExtCtrls, Spin;

type

 TForm1 = class(TForm)
   PaintBox1: TPaintBox;
   SpinEdit1: TSpinEdit;
   SpinEdit2: TSpinEdit;
   Label1: TLabel;
   Label2: TLabel;
   procedure PaintBox1Paint(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure SpinEdit1Change(Sender: TObject);
   procedure SpinEdit2Change(Sender: TObject);
   procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
   procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
     Y: Integer);

 private
   { Private declarations }

 public
   { Public declarations }

 end;

var

 Form1: TForm1;

implementation {$R *.DFM} var O, A, B, C, OA, OB, OC, Mouse : TPoint;

 iP, R : integer;
 xmin, xmax, ymin, ymax, zmin, zmax : double;
 nx, ny : word;

// Функция инициализации структуры;

function Init(x,y : Longint) : TPoint; var S : TPoint; begin

 S.x:=x;
 S.y:=y;
 Init:=S;

end;

// Функция получения вектора по его началу и концу;

function Vect(A,B : TPoint) : TPoint; var S : TPoint; begin

 S.x:=B.x-A.x;
 S.y:=B.y-A.y;
 Vect:=S;

end;

// Функция проверяющая попадание курсора мыши в окресности заданной точки экрана

function InCircle(A: TPoint; R : double): boolean; begin

 if sqr(Mouse.x-A.x)+sqr(Mouse.y-A.y) < R*R then InCircle:=True
 else InCircle:=False;

end;

// Вычисление функции z

function f(x,y : double) : double; begin

 f:=cos(x)*sin(y)/(1+y*y);

end;

//Процедура созданиям формы

procedure TForm1.FormCreate(Sender: TObject); begin

 xmin:=-2; xmax:=4;
 ymin:=-2; ymax:=4;
 zmin:=-2; zmax:=2;
 nx:=SpinEdit1.Value;
 ny:=SpinEdit2.Value;
 O:=Init(100, 200);
 A:=Init(20, 300);
 B:=Init(300, 200);
 C:=Init(100, 20);
 R:=5;

end;

// Процедура рисования поверхности

procedure TForm1.PaintBox1Paint(Sender: TObject);

 procedure MoveTo(A : TPoint);
 begin
   PaintBox1.Canvas.MoveTo(A.x, A.y);
 end;
 procedure LineTo(A : TPoint);
 begin
   PaintBox1.Canvas.LineTo(A.x, A.y);
 end;
 procedure Line(A, B : TPoint);
 begin
   PaintBox1.Canvas.MoveTo(A.x, A.y);
   PaintBox1.Canvas.LineTo(B.x, B.y);
 end;
 procedure Circle(A: TPoint; R : word);
 begin
   PaintBox1.Canvas.Ellipse(A.x-R,A.y-R,A.x+R,A.y+R);
 end;

var x, y, dx, dy, z, Qa, Qb, Qc : double;

 P : TPoint;
 kx, ky : integer;

begin

 OA:=Vect(O,A);
 OB:=Vect(O,B);
 OC:=Vect(O,C);

 //Вычисление шагов

 dx:=(xmax-xmin)/nx;
 dy:=(ymax-ymin)/ny;
 with PaintBox1 do begin

   //Фон изображения

   Canvas.Brush.Color:=clWhite;
   Canvas.Rectangle(0,0,Width, Height);
   //Рисование осей
   Circle(O,R);
   Line(O,A); Circle(A,R);
   Line(O,B); Circle(B,R);
   Line(O,C); Circle(C,R);
 end;

 //Рисование поверхности

 for kx:=0 to nx do begin
   x:=xmin+kx*dx;
   for ky:=0 to ny do begin
     y:=ymin+ky*dy;
     z:=f(x,y);
     Qa:=(x-xmin)/(xmax-xmin);
     Qb:=(y-ymin)/(ymax-ymin);
     Qc:=(z-zmin)/(zmax-zmin);
     P.x:=round(O.x+Qa*OA.x+Qb*OB.x+Qc*OC.x);
     P.y:=round(O.y+Qa*OA.y+Qb*OB.y+Qc*OC.y);
     if y=ymin then MoveTo(P) else LineTo(P);
   end;
 end;
 for ky:=0 to ny do begin
   y:=ymin+ky*dy;
   for kx:=0 to nx do begin
     x:=xmin+kx*dx;
     z:=f(x,y);
     Qa:=(x-xmin)/(xmax-xmin);
     Qb:=(y-ymin)/(ymax-ymin);
     Qc:=(z-zmin)/(zmax-zmin);
     P.x:=round(O.x+Qa*OA.x+Qb*OB.x+Qc*OC.x);
     P.y:=round(O.y+Qa*OA.y+Qb*OB.y+Qc*OC.y);
     if x=xmin then MoveTo(P) else LineTo(P);
   end;
 end;

end;

//Количество точек по оси х

procedure TForm1.SpinEdit1Change(Sender: TObject); begin

 nx:=SpinEdit1.Value;
 PaintBox1Paint(Sender);

end;

//Количество точек по оси у

procedure TForm1.SpinEdit2Change(Sender: TObject); begin

 ny:=SpinEdit2.Value;
 PaintBox1Paint(Sender);

end;

//Определение номера выбранной точки

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;

 Shift: TShiftState; X, Y: Integer);

begin

 iP:=-1;
 Mouse:=Init(X,Y);
 if InCircle(O, R) then iP:=0
 else if InCircle(A, R) then iP:=1
 else if InCircle(B, R) then iP:=2
 else if InCircle(C, R) then iP:=3;

end;

//Процедура вычисления новых координат выбранной базисной точки и перерисовывания граффика

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;

 Shift: TShiftState; X, Y: Integer);

begin

 case iP of
   0: O:=Init(X,Y);
   1: A:=Init(X,Y);
   2: B:=Init(X,Y);
   3: C:=Init(X,Y);
 end;
 PaintBox1Paint(Sender);

end;

//Процедура обработки движения мыши

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer); begin

 Mouse:=Init(X,Y);
 if InCircle(O,R) or InCircle(A,R) or InCircle(B,R) or InCircle(C,R)
 then Cursor:=crHandPoint
 else Cursor:=crDefault;

end;

end.