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 - gestore_del_form.pas

gestore_del_form.pas

Caricato da: Poggi Marco
Scarica il programma completo

  1. unit gestore_del_form;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  9.   ActnList, ExtCtrls, ComCtrls, Menus,
  10.   generico, eccezioni, tpenna, grafica, unit_figura_base, unit_linee, unit_Cerchi,
  11.   unit_punti, unit_ellissi, unit_poligoni;
  12.  
  13. type VettoreFigura = specialize Lista<FiguraBase>; // tipo lista di figure
  14.  
  15.   { TForm1 }
  16.  
  17. Type  TForm1 = class(TForm)
  18.     ColorDialogFinestraColori: TColorDialog;
  19.     ImageDisegno: TImage;
  20.     MainMenu1: TMainMenu;
  21.     MenuItemPoligoni: TMenuItem;
  22.     MenuItemPerimetri_E_Aree: TMenuItem;
  23.     MenuItemInfo: TMenuItem;
  24.     MenuItemPenna: TMenuItem;
  25.     MenuItemColoreSfondo: TMenuItem;
  26.     MenuItemModifica: TMenuItem;
  27.     MenuItemEllissi: TMenuItem;
  28.     MenuItemAnnulla: TMenuItem;
  29.     MenuItemPunti: TMenuItem;
  30.     MenuItemCerchi: TMenuItem;
  31.     MenuItemLinee: TMenuItem;
  32.     MenuItemDisegna: TMenuItem;
  33.     MenuItemEsci: TMenuItem;
  34.     MenuItemMenuPrincipale: TMenuItem;
  35.     MenuItemSalva: TMenuItem;
  36.     SaveDialogSalvaImmagine: TSaveDialog;
  37.     StatusBarInformazioni: TStatusBar;
  38.     procedure FormCreate(Sender: TObject);
  39.     procedure FormResize(Sender: TObject);
  40.     procedure ImageDisegnoMouseMove(Sender: TObject; Shift: TShiftState; X,
  41.       Y: Integer);
  42.     procedure ImageDisegnoMouseUp(Sender: TObject; Button: TMouseButton;
  43.       Shift: TShiftState; X, Y: Integer);
  44.     procedure MenuItemAnnullaClick(Sender: TObject);
  45.     procedure MenuItemCerchiClick(Sender: TObject);
  46.     procedure MenuItemColoreSfondoClick(Sender: TObject);
  47.     procedure MenuItemEllissiClick(Sender: TObject);
  48.     procedure MenuItemEsciClick(Sender: TObject);
  49.     procedure MenuItemLineeClick(Sender: TObject);
  50.     procedure MenuItemMenuPrincipaleClick(Sender: TObject);
  51.     procedure MenuItemPennaClick(Sender: TObject);
  52.     procedure MenuItemPerimetri_E_AreeClick(Sender: TObject);
  53.     procedure MenuItemPoligoniClick(Sender: TObject);
  54.     procedure MenuItemPuntiClick(Sender: TObject);
  55.     procedure MenuItemSalvaClick(Sender: TObject);
  56.   private
  57.     { private declarations }
  58.     procedure ridisegna();
  59.     var nuova:FiguraBase;
  60.         coloreSfondo:QWord;
  61.         pennaProvvisoria, pennaDefinitiva:TipoPenna;
  62.         seme:Ttavola;
  63.         elencoFigure:VettoreFigura;
  64.   public
  65.     { public declarations }
  66.   end;
  67.  
  68. var
  69.   Form1: TForm1;
  70.  
  71. implementation
  72.  
  73. {$R *.lfm}
  74.  
  75. { TForm1 }
  76.  
  77. procedure TForm1.MenuItemMenuPrincipaleClick(Sender: TObject);
  78. begin
  79.  
  80. end;
  81.  
  82. procedure TForm1.MenuItemPennaClick(Sender: TObject);
  83. var spessore:integer;
  84.     risposta:string;
  85. begin
  86.   ColorDialogFinestraColori.Color:=pennaDefinitiva.colore;
  87.   if ColorDialogFinestraColori.Execute then
  88.   begin
  89.      risposta:=IntToStr(pennaDefinitiva.spessore);
  90.      if InputQuery('Geometria', 'Spessore del pennino ? ', risposta) then
  91.      begin
  92.         spessore:=StrToInt64Def(risposta, -1);
  93.         if spessore > 1 then
  94.         begin
  95.           pennaDefinitiva.colore:=ColorDialogFinestraColori.Color;
  96.           pennaDefinitiva.spessore:=spessore;
  97.         end;
  98.      end;
  99.   end;
  100. end;
  101.  
  102. procedure TForm1.MenuItemPerimetri_E_AreeClick(Sender: TObject);
  103. var aree,perimetri:double;
  104.     esito:string;
  105.     messaggio:Pchar;
  106.     i,fine:integer;
  107. begin
  108.   aree:=0.0;
  109.   perimetri:=0.0;
  110.   fine:=elencoFigure.Count - 1;
  111.   for i:=0 to fine do
  112.   begin
  113.      aree:=aree + elencoFigure.Items[i].area();
  114.      perimetri:=perimetri + elencoFigure.Items[i].perimetro();
  115.   end;
  116.   esito:=Format('Somma dei perimetri: %0.3f.%sSomma delle aree: %0.3f.%sFigure presenti: %d.%s', [perimetri, #10+#13, aree, #10+#13,elencoFigure.Count, #10+#13]);
  117.   messaggio:=StrAlloc(length(esito) + 5);
  118.   StrPCopy(messaggio, esito);
  119.   Application.MessageBox(messaggio, 'Geometria');
  120.   StrDispose(messaggio);
  121. end;
  122.  
  123. procedure TForm1.MenuItemPoligoniClick(Sender: TObject);
  124. var lati:integer;
  125.     risposta:string;
  126. begin
  127.   risposta:='3';
  128.   StatusBarInformazioni.Panels.Items[1].Text:='Nuovo poligono';
  129.   if InputQuery('Geometria', 'Quanti lati ha il poligono ? ', risposta) then
  130.   begin
  131.      lati:=StrToIntDef(risposta, -1);
  132.      if lati >= 3 then
  133.      begin
  134.         nuova:=TPoligoni.crea(seme);
  135.         TPoligoni(nuova).setLati(lati);
  136.         nuova.penna:=pennaProvvisoria;
  137.      end
  138.      else
  139.         nuova:=nil;
  140.   end;
  141.   ridisegna();
  142. end;
  143.  
  144. procedure TForm1.MenuItemPuntiClick(Sender: TObject);
  145. begin
  146.   nuova:=TPunti.crea(seme);
  147.   nuova.penna:=pennaProvvisoria;
  148. end;
  149.  
  150. procedure TForm1.MenuItemSalvaClick(Sender: TObject);
  151. var nome:string;
  152. begin
  153.   if SaveDialogSalvaImmagine.Execute then
  154.   begin
  155.     nome:=SaveDialogSalvaImmagine.FileName + '.bmp';
  156.     // Application.MessageBox(Pchar(nome), 'Geometria');
  157.     ImageDisegno.Picture.SaveToFile(nome, '');
  158.   end;
  159. end;
  160.  
  161. procedure TForm1.MenuItemEsciClick(Sender: TObject);
  162. begin
  163.   elencoFigure.Clear;
  164.   self.Close;
  165. end;
  166.  
  167. procedure TForm1.MenuItemLineeClick(Sender: TObject);
  168. begin
  169.   nuova:=TLinee.crea(seme);
  170.   nuova.penna:=pennaProvvisoria;
  171. end;
  172.  
  173. procedure TForm1.FormCreate(Sender: TObject);
  174. begin
  175.   self.Text:='Geometria';
  176.   seme:=Ttavola.crea(ImageDisegno.Canvas, 0, 0, ImageDisegno.Canvas.Width, ImageDisegno.Canvas.Height);
  177.   seme.cancella(coloreSfondo);
  178.   StatusBarInformazioni.Panels.Items[0].Text:='        ';
  179.   StatusBarInformazioni.Panels.Items[1].Text:=' ';
  180.   coloreSfondo:=$052005;
  181.   pennaProvvisoria.colore:=$40EF20;
  182.   pennaProvvisoria.spessore:=1;
  183.   pennaDefinitiva.Colore:=$2020FF;
  184.   pennaDefinitiva.spessore:=3;
  185.   seme.cancella(coloreSfondo);
  186.   nuova:=nil;
  187.   elencoFigure:=VettoreFigura.crea(10);
  188.   SaveDialogSalvaImmagine.Filter:='Immagini |*bmp';
  189. end;
  190.  
  191. procedure TForm1.FormResize(Sender: TObject);
  192. var larghezza,altezza,i,fine:integer;
  193. begin
  194.    larghezza:=self.Width - 15;
  195.    altezza:=self.Height - 60;
  196.    if (larghezza > 0) and (altezza > 0) and false then
  197.    begin
  198.      ImageDisegno.Height:=altezza;
  199.      ImageDisegno.Width:=larghezza;
  200.      seme:=Ttavola.crea(ImageDisegno.Canvas, 0, 0, ImageDisegno.Width, ImageDisegno.Height);
  201.      fine:=elencoFigure.Count - 1;
  202.      for i:=0 to fine do
  203.      begin
  204.        elencoFigure.Items[i].setFoglio(seme);
  205.      end;
  206.      ridisegna();
  207.    end;
  208. end;
  209.  
  210. procedure TForm1.ImageDisegnoMouseMove(Sender: TObject; Shift: TShiftState; X,
  211.   Y: Integer);
  212. var ascissa:integer;
  213. begin
  214.   ascissa:=ImageDisegno.Canvas.Height - Y;
  215.   if (nuova <> nil) and (nuova.figuraInizializzata) then
  216.         nuova.setPuntoFine(x, ascissa);
  217.   StatusBarInformazioni.Panels.Items[0].Text:=Format('X: %4d Y: %4d', [X, ascissa]);
  218.   ridisegna();
  219. end;
  220.  
  221. procedure  TForm1.ridisegna();
  222. var i,fine:integer;
  223. begin
  224.   i:=0;
  225.   fine:=elencoFigure.Count;
  226.   seme.cancella(coloreSfondo);
  227.   while i < fine do
  228.   begin
  229.     elencoFigure.Items[i].traccia;
  230.     i:=i + 1;
  231.   end;
  232.   if (nuova <> nil) then
  233.   begin
  234.      nuova.traccia();
  235.      StatusBarInformazioni.Panels.Items[1].Text:=nuova.denominazione;
  236.   end
  237.   else
  238.      StatusBarInformazioni.Panels.Items[1].Text:='';
  239. end;
  240.  
  241. procedure TForm1.ImageDisegnoMouseUp(Sender: TObject; Button: TMouseButton;
  242.   Shift: TShiftState; X, Y: Integer);
  243. begin
  244.   if (Button=mbLeft) and (nuova <> nil) then
  245.   begin
  246.      if not nuova.figuraInizializzata then
  247.         nuova.setPuntoInizio(x, ImageDisegno.Canvas.Height - y)
  248.      else
  249.        begin
  250.          nuova.setPuntoFine(x, ImageDisegno.Canvas.Height - y);
  251.          nuova.penna:=pennaDefinitiva;
  252.          elencoFigure.addItem(nuova);
  253.          nuova:=nil;
  254.          ridisegna();
  255.        end;
  256.   end;
  257. end;
  258.  
  259. procedure TForm1.MenuItemAnnullaClick(Sender: TObject);
  260. begin
  261.   nuova:=nil;
  262.   ridisegna();
  263. end;
  264.  
  265. procedure TForm1.MenuItemCerchiClick(Sender: TObject);
  266. begin
  267.   nuova:=TCerchi.crea(seme);
  268.   nuova.penna:=pennaProvvisoria;
  269. end;
  270.  
  271. procedure TForm1.MenuItemColoreSfondoClick(Sender: TObject);
  272. begin
  273.   if ColorDialogFinestraColori.Execute then
  274.   begin
  275.      coloreSfondo:=ColorDialogFinestraColori.Color;
  276.      ridisegna();
  277.   end;
  278. end;
  279.  
  280. procedure TForm1.MenuItemEllissiClick(Sender: TObject);
  281. begin
  282.   nuova:=TEllissi.crea(seme);
  283.   nuova.penna:=pennaProvvisoria;
  284. end;
  285.  
  286. end.