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

Проект программы "Построение поверхности" (Delphi)

Код программы:

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.