Программа "Построение поверхности": различия между версиями

Материал из Wiki Mininuniver
Перейти к навигацииПерейти к поиску
 
Строка 1: Строка 1:
 
<center>[[Изображение:Построение поверхности.JPG]]</center>
 
<center>[[Изображение:Построение поверхности.JPG]]</center>
 +
 +
'''Код программы:'''
 +
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.

Версия 23:31, 26 мая 2009

Построение поверхности.JPG

Код программы: 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.

Источник — https://wiki.mininuniver.ru/index.php?title=Программа_%22Построение_поверхности%22&oldid=4732