Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Geometria - grafica.pas

grafica.pas

Caricato da: Poggi Marco
Scarica il programma completo

  1. unit grafica;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Graphics;
  9.  
  10. type pointf=record
  11.     x,y:double;
  12.     valido:boolean;
  13. end;
  14.  
  15. type tSegmento=object
  16.     inizio,fine:pointf;
  17.     function trapezio:double;
  18.     function distanza:double;
  19. end;
  20.  
  21. type Ttavola=class
  22.   private
  23.     foglio:TCanvas;
  24.     bassoSinistra,scale:pointf;
  25.     procedure trasla(var p:pointf);
  26.     procedure setColore(colore:qword);
  27.     function getColore:qword;
  28.     procedure setSpessore(spessore:integer);
  29.     function getSpessore:integer;
  30.   public
  31.     constructor crea(posto:TCanvas);
  32.     constructor crea(posto:TCanvas; x0,y0,xf:double);
  33.     constructor crea(posto:TCanvas; x0,y0,xf,yf:double);
  34.     procedure cancella(colore:qword);
  35.     procedure assi(colore:qword);
  36.     procedure linea(tratto:tSegmento);
  37.     procedure linea(x0,y0,xf,yf:double);
  38.     procedure cerchio(xo,yo,raggio:double);
  39.     procedure punto(coordinate:pointf);
  40.     property tinta:qword read getColore write setColore;
  41.     property spessore:integer read getSpessore write setSpessore;
  42. end;
  43.  
  44. implementation
  45.  
  46.  
  47. constructor Ttavola.crea(posto:TCanvas);
  48. begin
  49.   crea(posto, -10.0, -5.0, 10.0, 5.0);
  50. end;
  51.  
  52. constructor Ttavola.crea(posto:TCanvas; x0,y0,xf:double);
  53. begin
  54.   foglio:=posto;
  55.   cancella($101010);
  56.   foglio.Pen.Color:=clRed;
  57.   bassoSinistra.x:=x0;
  58.   bassoSinistra.y:=y0;
  59.   scale.x:=(xf - x0) / posto.Width;
  60.   if scale.x = 0 then scale.x:=1;
  61.   scale.y:=scale.x;
  62. end;
  63.  
  64. constructor Ttavola.crea(posto:TCanvas; x0,y0,xf,yf:double);
  65. begin
  66.   foglio:=posto;
  67.   cancella($101010);
  68.   foglio.Pen.Color:=clRed;
  69.   bassoSinistra.x:=x0;
  70.   bassoSinistra.y:=y0;
  71.   scale.x:=(xf - x0) / posto.Width;
  72.   scale.y:=(yf - y0) / posto.Height;
  73.   if scale.x=0 then scale.x:=1;
  74.   if scale.y=0 then scale.y:=1;
  75. end;
  76.  
  77. procedure Ttavola.cancella(colore:qword);
  78. var x,y:integer;
  79. begin
  80.   foglio.Brush.Color:=colore mod clWhite;
  81.   x:=foglio.Width;
  82.   y:=foglio.Height;
  83.   foglio.FillRect(0, 0, x, y);
  84. end;
  85.  
  86. procedure Ttavola.trasla(var p:pointf);
  87. begin
  88.   p.x:=(p.x - bassoSinistra.x) / scale.x;
  89.   p.y:=foglio.Height + ((bassoSinistra.y - p.y) / scale.y);
  90.   if p.x < 0 then p.x:=-1;
  91.   if p.x > foglio.Width then p.x:=foglio.Width + 1;
  92.   if p.y < 0 then p.y:=-1;
  93.   if p.y > foglio.Height then p.y:=foglio.Height + 1;
  94. end;
  95.  
  96. procedure Ttavola.assi(colore:qword);
  97. var vecchio:qword;
  98.     origine:pointf;
  99. begin
  100.   origine.x:=0.0; origine.y:=0.0;
  101.   vecchio:=tinta;
  102.   tinta:=colore;
  103.   trasla(origine);
  104.   foglio.Line(0, round(origine.y), foglio.Width, round(origine.y));
  105.   foglio.Line(round(origine.x), 0, round(origine.x), foglio.Height);
  106.   tinta:=vecchio;
  107. end;
  108.  
  109. procedure Ttavola.linea(tratto:tSegmento);
  110. begin
  111.   trasla(tratto.inizio);
  112.   trasla(tratto.fine);
  113.   foglio.Line(round(tratto.inizio.x), round(tratto.inizio.y), round(tratto.fine.x), round(tratto.fine.y));
  114. end;
  115.  
  116. procedure Ttavola.linea(x0,y0,xf,yf:double);
  117. var tratto:tSegmento;
  118. begin
  119.   tratto.inizio.x:=x0;
  120.   tratto.inizio.y:=y0;
  121.   tratto.fine.x:=xf;
  122.   tratto.fine.y:=yf;
  123.   linea(tratto);
  124. end;
  125.  
  126. procedure Ttavola.punto(coordinate:pointf);
  127. begin
  128.   trasla(coordinate);
  129.   foglio.Pixels[round(coordinate.x), round(coordinate.y)]:=foglio.Pen.Color;
  130. end;
  131.  
  132. procedure Ttavola.cerchio(xo,yo,raggio:double);
  133. var tratto:tSegmento;
  134.     alfa,passo:double;
  135. begin
  136.   tratto.inizio.x:=xo + raggio;
  137.   tratto.inizio.y:=yo;
  138.   passo:=0.05;
  139.   alfa:=passo;
  140.   while alfa <= 6.3 do
  141.   begin
  142.     tratto.fine.x:=xo + raggio * cos(alfa);
  143.     tratto.fine.y:=yo + raggio * sin(alfa);
  144.     linea(tratto);
  145.     tratto.inizio:=tratto.fine;
  146.     alfa:=alfa + passo;
  147.   end;
  148. end;
  149.  
  150. procedure Ttavola.setColore(colore:qword);
  151. begin
  152.   foglio.Pen.Color:=colore mod clWhite;
  153. end;
  154.  
  155. function Ttavola.getColore:qword;
  156. begin
  157.   getColore:=foglio.Pen.Color;
  158. end;
  159.  
  160. procedure Ttavola.setSpessore(spessore:integer);
  161. begin
  162.   foglio.Pen.Width:=abs(spessore) mod 50;
  163. end;
  164.  
  165. function Ttavola.getSpessore:integer;
  166. begin
  167.   getSpessore:=foglio.Pen.Width;
  168. end;
  169.  
  170. function tSegmento.trapezio:double;
  171. var base,altezza:double;
  172. begin
  173.   base:=fine.x - inizio.x;
  174.   altezza:=fine.y + inizio.y;
  175.   trapezio:=0.5 * base * altezza;
  176. end;
  177.  
  178. function tSegmento.distanza:double;
  179. var dx,dy:double;
  180. begin
  181.   dx:=fine.x-inizio.x;
  182.   dy:=fine.y-inizio.y;
  183.   distanza:=sqrt(dx*dx + dy*dy);
  184. end;
  185.  
  186. end.