|
unit Grafica; interface uses graph, crt; function inizio_graf:boolean; procedure assi; procedure fine_graf; type finestra=record x0,y0,xf,yf:double; end; {fine record finestra } type punto=object px,py,maxx,maxy:word; gx,gy:double; f:finestra; constructor inizio(g:finestra); constructor inizio(a,b,c,d:double); constructor IsoInizio(cx0,cy0,cxf:double); destructor DistruggiPunto; procedure assi(c:word); procedure SetX(a:double); procedure SetY(a:double); procedure SetXY(a,b:double); procedure punto(x,y:double; c:word); procedure rettangolo(x,y,x1,y1:double; c:word); procedure RuotaPunto(x,y,al:double; c:word); procedure TraslaRuotaPunto(x0,y0,x,y,al:double; c:word); procedure cerchio(xc,yc,r:double; c:word); procedure ellisse(xc,yc,rx,ry:double; c:word); procedure linea(c:finestra; col:word); end; { fine classe punto } const nero=black; blu=blue; verde=green; ciano=cyan; rosso=red; magenta=magenta; marrone=brown; GrigioChiaro=LightGray; GrigioScuro=DarkGray; BluChiaro=LightBlue; VerdeChiaro=LightGreen; CianoChiaro=LightCyan; RossoChiaro=LightRed; MagentaChiaro=LightMagenta; giallo=yellow; bianco=white; lampeggio=blink; { solo per il testo } implementation function inizio_graf:boolean; var sg,ng,ec:smallint(*integer*); ch:boolean; begin sg:=detect; initgraph(sg, ng, ''); ec:=graphresult; if ec=grok then begin ch:=true; settextstyle(DefaultFont, HorizDir, 1); end else begin ch:=false; gotoxy(1, wherey+1); write('Errore grafico: ',grapherrormsg(ec)); repeat until keypressed; writeln(' ',readkey); end; inizio_graf:=ch; end; procedure assi; var finx,finy,sx,sy:word; begin finx:=getmaxx; finy:=getmaxy; sx:=finx div 2; sy:=finy div 2; setcolor(7); line(sx,0,sx-3,10); line(sx,0,sx+3,10); line(finx,sy,finx-10,sy-3); line(finx,sy,finx-10,sy+3); setcolor(15); line(sx,0,sx,finy); line(0,sy,finx,sy); outtextxy(finx-10,sy-15,'x'); outtextxy(sx+10,0,'y'); end; procedure fine_graf; var tasto:char; begin repeat ; until keypressed; tasto:=readkey; closegraph; end; constructor punto.inizio(a,b,c,d:double); var t:finestra; begin with t do begin x0:=a; y0:=b; xf:=c; yf:=d; end; inizio(t); end; constructor punto.inizio(g:finestra); begin maxx:=GetMaxX; maxy:=GetMaxY; f:=g; with f do begin gx:=maxx/(xf-x0); gy:=maxy/(yf-y0); SetX(x0); SetY(y0); end; end; constructor punto.IsoInizio(cx0,cy0,cxf:double); begin maxx:=GetMaxX; maxy:=GetMaxY; with f do begin x0:=cx0; xf:=cxf; y0:=cy0; gx:=maxx/(xf-x0); gy:=gx; yf:=(maxy/gy)+y0; SetX(x0); SetY(y0); end; end; destructor punto.DistruggiPunto; begin { Distruttore } end; procedure punto.assi(c:word); var cx0,cy0:longint; begin with f do begin cx0:=round(gx*(0.0-x0)); cy0:=maxy-round(gy*(0.0-y0)); end; SetColor(c); if (cy0>=0) and (cy0<=maxx) then begin line(0, cy0, maxx, cy0); { asse x } end; if (cx0>=0) and (cx0<=maxy) then begin line(cx0, 0, cx0, maxy); { asse y } end; end; procedure punto.SetX(a:double); begin a:=gx*(a-f.x0); if (a>=0) and (a<=maxx) then px:=round(a) else px:=maxx+10; end; procedure punto.SetY(a:double); begin a:=maxy-(gy*(a-f.y0)); if (a>=0) and (a<=maxx) then py:=round(a) else py:=maxy+10; end; procedure punto.SetXY(a,b:double); begin SetX(a); SetY(b); end; procedure punto.punto(x,y:double; c:word); begin SetX(x); SetY(y); putpixel(px, py, c); end; procedure punto.rettangolo(x,y,x1,y1:double; c:word); var lato:finestra; begin with lato do begin x0:=x; y0:=y; xf:=x1; yf:=y; linea(lato, c); x0:=x1; yf:=y1; linea(lato, c); x0:=x; y0:=y1; linea(lato, c); xf:=x; yf:=y; linea(lato, c); end; end; procedure punto.RuotaPunto(x,y,al:double; c:word); var rx,ry:double; begin rx:=x*cos(al)-y*sin(al); ry:=y*cos(al)+x*sin(al); punto(rx, ry, c); end; procedure punto.TraslaRuotaPunto(x0,y0,x,y,al:double; c:word); var rx,ry:double; begin rx:=x*cos(al)-y*sin(al); ry:=y*cos(al)+x*sin(al); punto(rx+x0, ry+y0, c); end; procedure punto.cerchio(xc,yc,r:double; c:word); var al,dal:double; begin al:=0; dal:=1/(gy*2*pi*r); while al<=2*pi do begin TraslaRuotaPunto(xc, yc, r, 0, al, c); al:=al+dal; end; end; procedure punto.linea(c:finestra; col:word); var x1,y1:word; begin with c do begin SetXY(x0, y0); x1:=px; y1:=py; SetXY(xf, yf); SetColor(col); line(x1, y1, px, py); end; end; procedure punto.ellisse(xc,yc,rx,ry:double; c:word); var al,dal,be,rm:double; begin al:=0; be:=2*pi; rm:=0.5*(rx+ry); dal:=0.5/(gy*be*rm); while al<=be do begin punto(xc+rx*cos(al), yc+ry*sin(al), c); al:=al+dal; end; end; begin {Inizializzazione} end.
|
|
