На форму кинуть Timage. Выставить Width:=640;Height:=480;
| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormActivate(Sender: TObject);
Function F3D(X,Y:Real):Real;
Begin
F3D:=Sin (X);
End;
Procedure Build_Gr_3D(X1,Y1,X2,Y2,D:Integer);
Var
I,J,Mx,My,Mz,Nx,Ny,Xi,Yi:Integer;
F,X,Y,A1,B1,A2,B2,H1,H2,K,Min,Max:Real;
Up_Gor,Down_Gor:Array[0..640] Of Integer;
Begin
With Image1.Canvas Do
Begin
Brush.Color:=Clblack;
FillRect(Rect(0,0,640,480));
Nx:=50;
Ny:=50;
My:=X2-X1;
Mx:=D;
Mz:=Y2-Y1;
A1:=-2;
B1:=2;
A2:=-4;
B2:=5;
H1:=(B1-A1)/Mx;
H2:=(B2-A2)/My;
Max:=F3D(A1,A2);
Min:=Max;
For J:=0 To My Do
For I:=0 To Mx Do
Begin
X:=A1+H1*I;
Y:=A2+H2*J;
F:=F3D(X,Y);
If Max<F Then Max:=F;
If Min>F Then Min:=F;
End;
Pen.Color:=Clgray;
//SetColor(8);
//SetLineStyle(3,1,1);
Pen.Style := Psdash;
//Line(Mx,0,Mx,Mz);
MoveTo(Mx,0);
LineTo(Mx,Mz);
//Line(Mx,Mz,My+Mx,Mz);
MoveTo(Mx,Mz);
LineTo(My+Mx,Mz);
//Line(Mx,Mz,0,Mz+Mx);
MoveTo(Mx,Mz);
LineTo(0,Mz+Mx);
Pen.Style := Pssolid;
//SetLineStyle(0,1,1);
K:=Mz/(Max-Min);
//SetColor(150);
Pen.Color:=$00A0A0;
For I:=0 To My Do
Begin
Up_Gor[I]:=Round(Mz+Mx-(F3D(A1,I*H2+A2)-Min)*K);
Down_Gor[I]:=Up_Gor[I];
End;
For I:=0 To Mx Do
Begin
Up_Gor[I+My]:=Round(Mz+Mx-(F3D(I*H1+A1,H2*My+A2)-Min)*K-I);
Down_Gor[I+My]:=Up_Gor[I+My];
End;
For J:=0 To Nx Do
Begin
MoveTo(Round(J*Mx/Nx),Round(Mz+Mx-(F3D(H1*J*Mx/Nx+A1,A2)-Min)*K-J*Mx/Nx));
For I:=1 To My Do
Begin
Xi:=I+Round(J*Mx/Nx);
Yi:=Round(Mz+Mx-(F3D(H1*J*Mx/Nx+A1,I*H2+A2)-Min)*K-J*Mx/Nx);
If (Down_Gor[Xi]<=Yi)And(Yi<=Up_Gor[Xi])And(J<>0) Then MoveTo(Xi,Yi)
Else
Begin
LineTo(Xi,Yi);
If Down_Gor[Xi]>Yi Then Down_Gor[Xi]:=Yi;
If Up_Gor[Xi]<Yi Then Up_Gor[Xi]:=Yi;
End;
End;
End;
For I:=0 To My Do
Begin
Up_Gor[I]:=Round(Mz+Mx-(F3D(A1,I*H2+A2)-Min)*K);
Down_Gor[I]:=Up_Gor[I];
End;
For I:=0 To Mx Do
Begin
Up_Gor[I+My]:=Round(Mz+Mx-(F3D(I*H1+A1,H2*My+A2)-Min)*K-I);
Down_Gor[I+My]:=Up_Gor[I+My];
End;
For J:=Ny Downto 0 Do
Begin
MoveTo(Round(J*My/Ny),Round(Mz+Mx-(F3D(A1,H2*J*My/Ny+A2)-Min)*K));
For I:=1 To Mx Do
Begin
Xi:=I+Round(J*My/Ny);
Yi:=Round(Mz+Mx-(F3D(I*H1+A1,H2*J*My/Ny+A2)-Min)*K-I);
If (Down_Gor[Xi]<=Yi)And(Yi<=Up_Gor[Xi])And(J<>Ny) Then MoveTo(Xi,Yi)
Else
Begin LineTo(Xi,Yi);
If Down_Gor[Xi]>Yi Then Down_Gor[Xi]:=Yi;
If Up_Gor[Xi]<Yi Then Up_Gor[Xi]:=Yi;
End;
End;
End;
//SetColor(7);
Pen.Color:=Clwhite;
//Rectangle(0,Mx,My,Mz+Mx);
MoveTo(0,Mx);
LineTo(My,Mx);
LineTo(My,Mz+Mx);
LineTo(0,Mz+Mx);
LineTo(0,Mx);
//Line(0,Mx,Mx,0);
MoveTo(0,Mx);
LineTo(Mx,0);
//Line(Mx,0,My+Mx,0);
MoveTo(Mx,0);
LineTo(My+Mx,0);
//Line(My+Mx,0,My,Mx);
MoveTo(My+Mx,0);
LineTo(My,Mx);
//Line(My+Mx,0,My+Mx,Mz);
MoveTo(My+Mx,0);
LineTo(My+Mx,Mz);
//Line(My,Mz+Mx,My+Mx,Mz);
MoveTo(My,Mz+Mx);
LineTo(My+Mx,Mz);
End;
End;
Begin
Build_Gr_3D(1,200,410,479,200);
End;
end.
|
Удачи! |