Шустрый
Профиль
Группа: Участник
Сообщений: 89
Регистрация: 21.5.2005
Где: UnderGround
Репутация: нет
Всего: нет
|
Вот у меня есть код построения поверхности. Как мне исправить его, чтобы вместо поверхности был куд в этом ТриДэ пространстве? | Код |
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;
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.
|
|
Поверхность, Будет кубик 
Загрузка ...
