unit perspective1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, math; type TForm1 = class(TForm) Panel1: TPanel; Label4: TLabel; Label9: TLabel; Label2: TLabel; Label3: TLabel; Label1: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; Label10: TLabel; Label11: TLabel; Label12: TLabel; Label13: TLabel; Label14: TLabel; Label15: TLabel; Label16: TLabel; Label17: TLabel; Label18: TLabel; Label19: TLabel; Label20: TLabel; Label21: TLabel; Label22: TLabel; Label23: TLabel; Image1: TImage; Button4: TButton; Button1: TButton; Edit1: TEdit; Edit2: TEdit; Edit3: TEdit; Edit4: TEdit; Edit5: TEdit; ScrollBar1: TScrollBar; Edit6: TEdit; Edit7: TEdit; Edit8: TEdit; Edit9: TEdit; Edit10: TEdit; Edit11: TEdit; Edit12: TEdit; Edit13: TEdit; Edit14: TEdit; Edit15: TEdit; Edit16: TEdit; Edit17: TEdit; Edit18: TEdit; SaveDialog1: TSaveDialog; Button2: TButton; procedure Button4Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure ScrollBar1Change(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; const PI_TIMES_2 = 6.2831853; NOISEDX = 2; NOISEDY = 2; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.Button4Click(Sender: TObject); begin Close; end; procedure TForm1.Button1Click(Sender: TObject); var i,j,ix,jy3,jy4,jy,nx,nx2,ny,ny2,ny3,ny4,x,y,h,xx,yy, bd,aa,aa4,aa2,aa24,bb,bb4,mx,mx4:integer; a,b,costheta,sintheta: double; begin image1.canvas.pen.color:=255*(256*256+256+1); image1.canvas.brush.color:=255*(256*256+256+1); image1.canvas.rectangle(0,0,501,501); image1.canvas.brush.style:=bsclear; image1.canvas.pen.color:=0*(256*256+256+1); image1.canvas.ellipse(250-round(50*pi),250-round(50*pi), 250+round(50*pi),250+round(50*pi)); image1.canvas.brush.color:=0*(256*256+256+1); // drawoval(512,384,round(100*pi),round(100*pi)); bd:=strtoint(edit1.text); b:=bd*pi/180; h:=strtoint(edit2.text); ix:=strtoint(edit3.text); nx:=strtoint(edit4.text); ny:=strtoint(edit5.text); jy:=strtoint(edit6.text); ny2:=strtoint(edit7.text); nx2:=strtoint(edit8.text); jy3:=strtoint(edit9.text); ny3:=strtoint(edit10.text); aa:=strtoint(edit11.text); aa2:=strtoint(edit13.text); mx:=strtoint(edit12.text); jy4:=strtoint(edit14.text); ny4:=strtoint(edit15.text); aa4:=strtoint(edit16.text); aa24:=strtoint(edit17.text); mx4:=strtoint(edit18.text); if nx<>0 then begin for i:=-nx to nx do begin for y:=ny downto -ny do begin x:=i*ix; if (sqr(x*(1+sqr(tan(b))))+sqr(y-tan(b)*h) +sqr(tan(b)*y-sqr(tan(b))*h)) <> 0 then begin costheta:=x*(1+sqr(tan(b)))/sqrt(sqr(x*(1+sqr(tan(b))))+sqr(y-tan(b)*h) +sqr(tan(b)*y-sqr(tan(b))*h)); if tan(b)*h <= y then sintheta:=sqrt(1-sqr(costheta)) else sintheta:=-sqrt(1-sqr(costheta)); end; if ((sin(b)*y+cos(b)*h) <>0) and ((y*tan(b)) > -h) then begin a:=arctan(sqrt(sqr(x)+sqr(cos(b)*y-sin(b)*h))/(sin(b)*y+cos(b)*h)); xx:=round(a*costheta*100)+250; yy:=-round(a*sintheta*100)+250; image1.canvas.rectangle(xx-1,yy-1,xx+1,yy+1); end; end; end; end; if ny2<>0 then begin for j:=-ny2 to ny2 do begin for x:=nx2 downto -nx2 do begin y:=j*jy; if (sqr(x*(1+sqr(tan(b))))+sqr(y-tan(b)*h) +sqr(tan(b)*y-sqr(tan(b))*h)) <> 0 then begin costheta:=x*(1+sqr(tan(b)))/sqrt(sqr(x*(1+sqr(tan(b))))+sqr(y-tan(b)*h) +sqr(tan(b)*y-sqr(tan(b))*h)); if tan(b)*h <= y then sintheta:=sqrt(1-sqr(costheta)) else sintheta:=-sqrt(1-sqr(costheta)); end; if ((sin(b)*y+cos(b)*h) <>0) and ((y*tan(b)) > -h) then begin a:=arctan(sqrt(sqr(x)+sqr(cos(b)*y-sin(b)*h))/(sin(b)*y+cos(b)*h)); xx:=round(a*costheta*100)+250; yy:=-round(a*sintheta*100)+250; image1.canvas.rectangle(xx-1,yy-1,xx+1,yy+1); end; end; end; end; if ny3<>0 then begin for j:=-ny3 to ny3 do begin for i:=-mx to mx do begin x:=i; bb:=j*jy3; y:=round((aa/aa2)*x+bb); if (sqr(x*(1+sqr(tan(b))))+sqr(y-tan(b)*h) +sqr(tan(b)*y-sqr(tan(b))*h)) <> 0 then begin costheta:=x*(1+sqr(tan(b)))/sqrt(sqr(x*(1+sqr(tan(b))))+sqr(y-tan(b)*h) +sqr(tan(b)*y-sqr(tan(b))*h)); if tan(b)*h <= y then sintheta:=sqrt(1-sqr(costheta)) else sintheta:=-sqrt(1-sqr(costheta)); end; if ((sin(b)*y+cos(b)*h) <>0) and ((y*tan(b)) > -h) then begin a:=arctan(sqrt(sqr(x)+sqr(cos(b)*y-sin(b)*h))/(sin(b)*y+cos(b)*h)); xx:=round(a*costheta*100)+250; yy:=-round(a*sintheta*100)+250; image1.canvas.rectangle(xx-1,yy-1,xx+1,yy+1); end; end; end; end; if ny4<>0 then begin for j:=-ny4 to ny4 do begin for i:=-mx4 to mx4 do begin x:=i; bb4:=j*jy4; y:=round((aa4/aa24)*x+bb4); if (sqr(x*(1+sqr(tan(b))))+sqr(y-tan(b)*h) +sqr(tan(b)*y-sqr(tan(b))*h)) <> 0 then begin costheta:=x*(1+sqr(tan(b)))/sqrt(sqr(x*(1+sqr(tan(b))))+sqr(y-tan(b)*h) +sqr(tan(b)*y-sqr(tan(b))*h)); if tan(b)*h <= y then sintheta:=sqrt(1-sqr(costheta)) else sintheta:=-sqrt(1-sqr(costheta)); end; if ((sin(b)*y+cos(b)*h) <>0) and ((y*tan(b)) > -h) then begin a:=arctan(sqrt(sqr(x)+sqr(cos(b)*y-sin(b)*h))/(sin(b)*y+cos(b)*h)); xx:=round(a*costheta*100)+250; yy:=-round(a*sintheta*100)+250; image1.canvas.rectangle(xx-1,yy-1,xx+1,yy+1); end; end; end; end; image1.canvas.pen.color:=0*256*256+0*256+255*1; image1.canvas.brush.color:=0*256*256+0*256+255*1; image1.canvas.ellipse(250-4,250-4, 250+4,250+4); end; procedure TForm1.ScrollBar1Change(Sender: TObject); begin edit1.text:=inttostr(scrollbar1.position); Button1Click(Sender); end; procedure TForm1.FormCreate(Sender: TObject); begin image1.canvas.pen.color:=255*(256*256+256+1); image1.canvas.brush.color:=255*(256*256+256+1); image1.canvas.rectangle(0,0,501,501); // randomize; SaveDialog1.InitialDir:='d:\}`'; {GetCurrentDir} image1.picture.bitmap.pixelformat:=pf24bit; button1click(sender); activecontrol:=edit1; end; procedure TForm1.Button2Click(Sender: TObject); var currentfile: string; begin if savedialog1.execute then begin currentfile:=savedialog1.filename; image1.picture.SaveToFile(currentfile) end; end; end.