Ir al contenido


Foto

Rotar Imagen Bmp

#delphi #funciones

  • Por favor identifícate para responder
3 respuestas en este tema

#1 Dan Morales

Dan Morales

    Newbie

  • Miembros
  • Pip
  • 3 mensajes

Escrito 05 octubre 2021 - 05:51

Hola buena tarde a todos, espero me puedan orientar y saber si lo que estoy aplicando esta bien:
 
Ya que tengo el siguiente programa:
 


delphi
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  7.   Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ExtDlgs, math,
  8.   Vcl.Dialogs, Vcl.Buttons;
  9.  
  10. type
  11.   TParDePuntos = Packed Record
  12.     Px: Integer;
  13.     Py: Integer;
  14.     Qx: Integer;
  15.     Qy: Integer;
  16.     function Equals(): boolean;
  17. end;
  18.  
  19. type
  20.   TPuntoAngulo = Packed Record
  21.     X: Integer;
  22.     Y: Integer;
  23.     Theta: Integer;
  24.     function Equals(): boolean;
  25. end;
  26.  
  27. type
  28.   TForm1 = class(TForm)
  29.     Panel1: TPanel;
  30.     ScrollBox1: TScrollBox;
  31.     Image1: TImage;
  32.     Button1: TButton;
  33.     Button2: TButton;
  34.     Button3: TButton;
  35.     Button4: TButton;
  36.     Button5: TButton;
  37.     Button6: TButton;
  38.     Button7: TButton;
  39.     Button0: TButton;
  40.     editDatos: TEdit;
  41.     Button8: TButton;
  42.     Button9: TButton;
  43.     Button12: TButton;
  44.     Button13: TButton;
  45.     CheckBox1: TCheckBox;
  46.     OpenDialog1: TOpenDialog;
  47.     SaveDialog1: TSaveDialog;
  48.     Panel2: TPanel;
  49.     Label1: TLabel;
  50.     BitBtn1: TBitBtn;
  51.     BitBtn2: TBitBtn;
  52.  
  53.  
  54.     procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
  55.       Shift: TShiftState; X, Y: Integer);
  56.     procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
  57.       Shift: TShiftState; X, Y: Integer);
  58.     procedure FormCreate(Sender: TObject);
  59.     procedure Button0Click(Sender: TObject);
  60.     procedure Button1Click(Sender: TObject);
  61.     procedure Button2Click(Sender: TObject);
  62.     procedure Button3Click(Sender: TObject);
  63.     procedure Button4Click(Sender: TObject);
  64.     procedure Button5Click(Sender: TObject);
  65.     procedure Button6Click(Sender: TObject);
  66.     procedure Button7Click(Sender: TObject);
  67.     procedure Button8Click(Sender: TObject);
  68.     procedure Button9Click(Sender: TObject);
  69.     procedure Button11Click(Sender: TObject);
  70.     procedure Button12Click(Sender: TObject);
  71.     procedure Button13Click(Sender: TObject);
  72.     procedure Button14Click(Sender: TObject);
  73.     procedure BitBtn1Click(Sender: TObject);
  74.     procedure BitBtn2Click(Sender: TObject);
  75.  
  76.  
  77.   private
  78.     { Private declarations }
  79.     procedure PintarMalla(X1, Y1, X2, Y2: Integer);
  80.     procedure DibujarLinea(color: Cardinal; ancho: Integer);
  81.     procedure BorrarLinea(Ancho: Integer);
  82.     procedure DibujaImagen(var ArrPosicion: array of TPuntoAngulo;
  83.       Fotos: array of TBitMap; Grados: Integer); overload;
  84.     procedure DibujaImagen(var ArrPosicion: array of TPuntoAngulo; Foto: TBitmap); overload;
  85.  
  86.   public
  87.     { Public declarations }
  88.     textoCotizacion: String;
  89.   end;
  90.  
  91. var
  92.   Form1: TForm1;
  93.   X1, Y1, X2, Y2: Integer;
  94.   contTubos, contMangueras, contCasas, contDistrib,
  95.     contEdificios, contBombas, contMedidores, contLlaves: Integer;
  96.  
  97.   FotosCasa, FotosEdificio: array[0..3] of TBitMap;
  98.   FotoDistrib, FotoBomba, FotoMedidor, FotoLlave: TBitMap;
  99.  
  100.   ArregloTubos, ArregloMangueras: array of TParDePuntos;
  101.   ArregloCasas, ArregloEdificios, ArregloDistrib, ArregloBombas,
  102.     ArregloMedidores, ArregloLlaves: array of TPuntoAngulo;
  103.  
  104.   PP: TParDePuntos;
  105.   PA: TPuntoAngulo;
  106.   clCobre: Integer;
  107.  
  108. implementation
  109.  
  110. {$R *.dfm}
  111.  
  112. function TParDePuntos.Equals(): boolean;
  113. begin
  114.   Equals := false;
  115.   if ((Self.Px = PP.Px) and (Self.Py = PP.Py) and (Self.Qx = PP.Qx)
  116.       and (Self.Qy = PP.Qy)) or
  117.       (((Self.Px = PP.Qx) and (Self.Py = PP.Qy) and (Self.Qx = PP.Px) and
  118.       (Self.Qy = PP.Py)))  then
  119.     Equals := true;
  120. end;
  121.  
  122. function TPuntoAngulo.Equals(): boolean;
  123. begin
  124.   Equals := false;
  125.   if (Self.X = PA.X) and (Self.Y = PA.Y) then
  126.     Equals := true;
  127. end;
  128.  
  129. {
  130.   Funcion que dibuja la malla desde (X1,Y1) hasta (X2,Y2)
  131. }
  132. procedure TForm1.PintarMalla(X1, Y1, X2, Y2: Integer);
  133. var
  134.   I, J: Integer;
  135. begin
  136.   Image1.Canvas.Pen.Color := ClBlue;
  137.   I := X1;
  138.   J := Y1;
  139.   while (I <= X2)  or (J <= Y2) do
  140.   begin
  141.     Image1.Canvas.MoveTo(I, Y1);
  142.     Image1.Canvas.LineTo(I, Y2);
  143.     Image1.Canvas.MoveTo(X1, J);
  144.     Image1.Canvas.LineTo(X2, J);
  145.     I := I + 20;
  146.     J := J + 20;
  147.   end;
  148.   Image1.Canvas.Pen.Color := clBlack;
  149. end;
  150.  
  151. {
  152.   Funcion que dibuja una linea del ancho y color deseado
  153.   con base en el objeto global PP
  154. }
  155.  
  156. procedure TForm1.DibujarLinea(color: Cardinal; ancho: Integer);
  157. begin
  158.   Image1.Canvas.Pen.Color := color; //color cobre
  159.   Image1.Canvas.Pen.Width := ancho;
  160.   Image1.Canvas.MoveTo(PP.Px, PP.Py);
  161.   Image1.Canvas.LineTo(PP.Qx, PP.Qy);
  162.   Image1.Canvas.Pen.Color := clBlack;
  163.   Image1.Canvas.Pen.Width := 1;
  164. end;
  165.  
  166. procedure TForm1.BitBtn1Click(Sender: TObject);
  167. begin
  168.   close();
  169. end;
  170.  
  171. procedure TForm1.BitBtn2Click(Sender: TObject);
  172. begin
  173.   ShowMessage('DAVID MIRANDA FLORES' +sLineBreak+
  174.      'david2490603@live.com.mx' +sLineBreak+ 'FCC BUAP');
  175. end;
  176.  
  177. procedure TForm1.BorrarLinea(ancho: Integer);
  178. begin
  179.   Image1.Canvas.Pen.Color := clWhite; //color cobre
  180.   Image1.Canvas.Pen.Width := ancho;
  181.   Image1.Canvas.MoveTo(PP.Px, PP.Py);
  182.   Image1.Canvas.LineTo(PP.Qx, PP.Qy);
  183.   Image1.Canvas.Pen.Color := clBlack;
  184.   Image1.Canvas.Pen.Width := 1;
  185.   PintarMalla(PP.Px , PP.Py - 20, PP.Qx, PP.Qy + 20);
  186. end;
  187.  
  188. function ExistePPEnArr(Arreglo: array of TParDePuntos; contador: Integer): Integer;
  189. var I: Integer;
  190. begin
  191.   ExistePPEnArr := -1;
  192.   for I := 0 to contador - 1 do begin
  193.     if Arreglo[I].Equals() = true then begin
  194.       ExistePPEnArr := I;
  195.       Exit;
  196.     end;
  197.   end;
  198. end;
  199.  
  200. function ExistePAEnArr(Arreglo: array of TPuntoAngulo; contador: Integer): Integer;
  201. var I: Integer;
  202. begin
  203.   ExistePAEnArr := -1;
  204.    for I := 0 to contador do begin
  205.     if Arreglo[I].Equals() then  begin
  206.       ExistePAEnArr := I;
  207.       Exit;
  208.     end;
  209.   end;
  210. end;
  211.  
  212. //TUBERIA
  213. procedure TForm1.Button0Click(Sender: TObject);
  214. var I: Integer;
  215. begin
  216.  
  217.   if CheckBox1.Checked = true then begin
  218.     CheckBox1.Checked := false;
  219.     I := ExistePPEnArr(ArregloTubos, contTubos);
  220.     if I <= -1 then begin
  221.       ShowMessage('No existe ningun elemento que borrar :(');
  222.       Exit;
  223.     end;
  224.     BorrarLinea(5);
  225.     Delete(ArregloTubos, I, 1);
  226.     Dec(contTubos);
  227.     Exit;
  228.   end;
  229.   DibujarLinea(clCobre, 5);   //RGB(218,125,57) = color Cobre
  230.   ArregloTubos[contTubos].Px := PP.Px;
  231.   ArregloTubos[contTubos].Py := PP.Py;
  232.   ArregloTubos[contTubos].Qx := PP.Qx;
  233.   ArregloTubos[contTubos].Qy := PP.Qy;
  234.   Inc(contTubos);
  235.   editDatos.Text := 'Tubo agregado' + IntToStr(contTubos);
  236. end;
  237.  
  238. //MANGUERA
  239. procedure TForm1.Button1Click(Sender: TObject);
  240. var I: Integer;
  241. begin
  242.   if(CheckBox1.Checked = true) then begin
  243.     CheckBox1.Checked := false;
  244.     I := ExistePPEnArr(ArregloMangueras, contMangueras);
  245.     if (I = -1) then begin
  246.       ShowMessage('No existe ningun elemento que borrar :(');
  247.       Exit;
  248.     end;
  249.  
  250.     BorrarLinea(3);
  251.     Delete(ArregloMangueras, I, 1);
  252.     Dec(contMangueras);
  253.  
  254.     Exit;
  255.   end;
  256.  
  257.   DibujarLinea(clBlack, 3);
  258.   ArregloMangueras[contMangueras] := PP;
  259.   Inc(contMangueras);
  260.   editDatos.Text := 'Manguera agregada' + IntToStr(contMangueras);
  261.  
  262. end;
  263.  
  264. {
  265.   Funcion que solicita al usuario los grados de rotacion para
  266.   dibujar una casa o un edificio
  267.   Valores posibles:
  268.     -1 -> Default
  269.      0 -> 0*90 grados
  270.      1 -> 1*90 grados = 90
  271.      2 -> 2*90 grados = 180
  272.      3 -> 3*90 grados = 270
  273. }
  274. function MuestraDialogoGrados(): Integer;
  275. begin
  276.   MuestraDialogoGrados := -1;
  277.   with CreateMessageDialog('Ingresa la rotacion deseada:', mtInformation,
  278.     [mbYes,mbNo,mbOK,mbRetry,mbClose]) do
  279.     try
  280.       TButton(FindComponent('Yes')).Caption := '0 grados';
  281.       TButton(FindComponent('No')).Caption := '90 grados';
  282.       TButton(FindComponent('Ok')).Caption := '180 grados';
  283.       TButton(FindComponent('Retry')).Caption := '270 grados';
  284.           TButton(FindComponent('Close')).Caption := 'Cancelar';
  285.       case ShowModal of
  286.         mrYes: MuestraDialogoGrados := 0;
  287.         mrNo: MuestraDialogoGrados := 1;
  288.         mrOK: MuestraDialogoGrados := 2;
  289.         mrRetry: MuestraDialogoGrados := 3;
  290.       end;
  291.     finally
  292.       Free;
  293.     end;
  294. end;
  295.  
  296. //dibuja imagen CON angulo
  297. procedure TForm1.DibujaImagen(var ArrPosicion: array of TPuntoAngulo;
  298.   Fotos: array of TBitMap; Grados: Integer);
  299. begin
  300.   Image1.Canvas.Brush.Color := clWhite;
  301.   Image1.Canvas.Draw(PA.x, PA.y, Fotos[grados]);
  302.  
  303. end;
  304.  
  305. //dibuja imagen SIN angulo
  306. procedure TForm1.DibujaImagen(var ArrPosicion: array of TPuntoAngulo;
  307.   Foto: TBitmap);
  308. begin
  309.   Image1.Canvas.Brush.Color := clWhite;
  310.   Image1.Canvas.Draw(PA.x, PA.y, Foto);
  311. end;
  312.  
  313. //DISTRIBUIDOR
  314. procedure TForm1.Button2Click(Sender: TObject);
  315. var
  316.   I: Integer;
  317.   begin
  318.   if CheckBox1.Checked = true then begin
  319.  
  320.       CheckBox1.Checked := false;
  321.       I := ExistePAEnArr(ArregloDistrib, contDistrib);
  322.       if I <= -1 then begin
  323.         ShowMessage('No existe ningun elemento que borrar :(');
  324.         Exit;
  325.       end;
  326.  
  327.       //Borrar elemento de image1
  328.       Image1.Canvas.Rectangle(PA.X, Pa.Y, PA.X + 81, Pa.Y + 81);
  329.       PintarMalla(PA.X, Pa.Y, PA.X + 80, Pa.Y + 80);
  330.       //Eliminar de arreglo
  331.       Delete(ArregloDistrib, I, 1);
  332.       Dec(contDistrib);
  333.       Exit;
  334.   end;
  335.  
  336.   DibujaImagen(ArregloDistrib, FotoDistrib);
  337.   PA.Theta := 0;
  338.   ArregloDistrib[contDistrib] := PA;
  339.   Inc(contDistrib);
  340.   editDatos.Text := 'Distribuidor agregado' + IntToStr(contDistrib);
  341. end;
  342.  
  343. //CASA
  344. procedure TForm1.Button3Click(Sender: TObject);
  345. var I, grados: Integer;
  346. begin
  347.   if CheckBox1.Checked = true then begin
  348.  
  349.     CheckBox1.Checked := false;
  350.     I := ExistePAEnArr(ArregloCasas, contCasas);
  351.     if I <= -1 then begin
  352.       ShowMessage('No existe ningun elemento que borrar :(');
  353.       Exit;
  354.     end;
  355.  
  356.     //Borrar elemento de image1
  357.     Image1.Canvas.Rectangle(PA.X, Pa.Y, PA.X + 81, Pa.Y + 81);
  358.     PintarMalla(PA.X, Pa.Y, PA.X + 80, Pa.Y + 80);
  359.     //Eliminar de arreglo
  360.     Delete(ArregloCasas, I, 1);
  361.     Dec(contCasas);
  362.     Exit;
  363.   end;
  364.   grados := MuestraDialogoGrados;
  365.   if grados = -1 then
  366.     Exit;
  367.   DibujaImagen(ArregloCasas, FotosCasa, grados);
  368.   ArregloCasas[contCasas] := PA;
  369.   Inc(contCasas);
  370.   editDatos.Text := 'Casa + ' + IntToStr(contCasas);
  371. end;
  372.  
  373. //EDIFICIO
  374. procedure TForm1.Button4Click(Sender: TObject);
  375. var I, grados: Integer;
  376. begin
  377.     if CheckBox1.Checked = true then begin
  378.  
  379.       CheckBox1.Checked := false;
  380.       I := ExistePAEnArr(ArregloEdificios, contEdificios);
  381.       if I <= -1 then begin
  382.         ShowMessage('No existe ningun elemento que borrar :(');
  383.         Exit;
  384.       end;
  385.  
  386.       //Borrar elemento de image1
  387.       Image1.Canvas.Rectangle(PA.X, Pa.Y, PA.X + 81, Pa.Y + 81);
  388.       PintarMalla(PA.X, Pa.Y, PA.X + 80, Pa.Y + 80);
  389.       //Eliminar de arreglo
  390.       Delete(ArregloEdificios, I, 1);
  391.       Dec(contEdificios);
  392.       Exit;
  393.   end;
  394.   grados := MuestraDialogoGrados;
  395.   if grados = -1 then
  396.     Exit;
  397.   DibujaImagen(ArregloEdificios, FotosEdificio, grados);
  398.   ArregloEdificios[contEdificios] := PA;
  399.   Inc(contEdificios);
  400.   editDatos.Text := 'Edificio + ' + IntToStr(contEdificios);
  401. end;
  402.  
  403. //BOMBA
  404. procedure TForm1.Button5Click(Sender: TObject);
  405. var I: Integer;
  406. begin
  407.     if CheckBox1.Checked = true then begin
  408.  
  409.       CheckBox1.Checked := false;
  410.       I := ExistePAEnArr(ArregloBombas, contBombas);
  411.       if I <= -1 then begin
  412.         ShowMessage('No existe ningun elemento que borrar :(');
  413.         Exit;
  414.       end;
  415.  
  416.       //Borrar elemento de image1
  417.       Image1.Canvas.Rectangle(PA.X, Pa.Y, PA.X + 81, Pa.Y + 81);
  418.       PintarMalla(PA.X, Pa.Y, PA.X + 80, Pa.Y + 80);
  419.       //Eliminar de arreglo
  420.       Delete(ArregloBombas, I, 1);
  421.       Dec(contBombas);
  422.       Exit;
  423.   end;
  424.   DibujaImagen(ArregloBombas, FotoBomba);
  425.   PA.Theta := 0;
  426.   ArregloBombas[contBombas] := PA;
  427.   Inc(contBombas);
  428.   editDatos.Text := 'Bomba + ' + IntToStr(contBombas);
  429. end;
  430.  
  431. //MEDIDOR
  432. procedure TForm1.Button6Click(Sender: TObject);
  433. var I: Integer;
  434. begin
  435.     if CheckBox1.Checked = true then begin
  436.  
  437.       CheckBox1.Checked := false;
  438.       I := ExistePAEnArr(ArregloMedidores, contMedidores);
  439.       if I <= -1 then begin
  440.         ShowMessage('No existe ningun elemento que borrar :(');
  441.         Exit;
  442.       end;
  443.  
  444.       //Borrar elemento de image1
  445.       Image1.Canvas.Rectangle(PA.X, Pa.Y, PA.X + 81, Pa.Y + 81);
  446.       PintarMalla(PA.X, Pa.Y, PA.X + 80, Pa.Y + 80);
  447.       //Eliminar de arreglo
  448.       Delete(ArregloMedidores, I, 1);
  449.       Dec(contMedidores);
  450.       Exit;
  451.   end;
  452.   DibujaImagen(ArregloMedidores, FotoMedidor);
  453.   PA.Theta := 0;
  454.   ArregloMedidores[contMedidores] := PA;
  455.   Inc(contMedidores);
  456.   editDatos.Text := 'Medidor + ' + IntToStr(contMedidores);
  457. end;
  458.  
  459. //LLAVE DE PASO
  460. procedure TForm1.Button7Click(Sender: TObject);
  461. var I: Integer;
  462. begin
  463.     if CheckBox1.Checked = true then begin
  464.       CheckBox1.Checked := false;
  465.       I := ExistePAEnArr(ArregloLlaves, contLlaves);
  466.       if I <= -1 then begin
  467.         ShowMessage('No existe ningun elemento que borrar :(');
  468.         Exit;
  469.       end;
  470.  
  471.       //Borrar elemento de image1
  472.       Image1.Canvas.Rectangle(PA.X, Pa.Y, PA.X + 81, Pa.Y + 81);
  473.       PintarMalla(PA.X, Pa.Y, PA.X + 80, Pa.Y + 80);
  474.       //Eliminar de arreglo
  475.       Delete(ArregloLlaves, I, 1);
  476.       Dec(contLlaves);
  477.       Exit;
  478.   end;
  479.   DibujaImagen(ArregloLlaves, FotoLlave);
  480.   PA.Theta := 0;
  481.   ArregloLlaves[contLlaves] := PA;
  482.   Inc(contLlaves);
  483.   editDatos.Text := 'Llave + ' + IntToStr(contLlaves);
  484. end;
  485.  
  486. //ABRIR DISEÑO
  487. procedure TForm1.Button8Click(Sender: TObject);
  488. var
  489.   TxtFileName: string;
  490.   F: TextFile;
  491.  
  492.  
  493.   procedure LeeDatos(var Arreglo: array of TParDePuntos;
  494.     var Contador: Integer); overload;
  495.   var
  496.     p: TParDePuntos;
  497.     I: Integer;
  498.   begin
  499.     Readln(F, Contador);
  500.     for I := 0 to Contador - 1 do begin
  501.       Readln(F, p.Px, p.Py, p.Qx, p.Qy);
  502.       Arreglo[I] := p;
  503.       PP := p;
  504.     end;
  505.   end;
  506.  
  507.   procedure LeeDatos(var Arreglo: array of TPuntoAngulo;
  508.     var Contador: Integer); overload;
  509.   var
  510.     p: TPuntoAngulo;
  511.     I: Integer;
  512.   begin
  513.     Readln(F, Contador);
  514.     for I := 0 to Contador - 1 do begin
  515.       Readln(F, p.X, p.Y, p.Theta);
  516.       Arreglo[I] := p;
  517.     end;
  518.   end;
  519.  
  520.   procedure PintaLineas(Arreglo: array of TParDePuntos;
  521.     Contador: Integer; Color, Ancho: Integer);
  522.   var
  523.    I: Integer;
  524.   begin
  525.     for I := 0 to Contador - 1 do begin
  526.       PP := Arreglo[I];
  527.       DibujarLinea(Color, Ancho);
  528.     end;
  529.   end;
  530.  
  531.   procedure PintaUno(Arreglo: array of TPuntoAngulo;
  532.     Fotos: array of TBitMap; Contador: Integer);
  533.   var
  534.    I: Integer;
  535.   begin
  536.     for I := 0 to Contador - 1 do begin
  537.       PA := Arreglo[I];
  538.       DibujaImagen(Arreglo, Fotos, PA.Theta div 90);
  539.     end;
  540.   end;
  541.  
  542.   procedure PintaMuchos(Arreglo: array of TPuntoAngulo;
  543.     Foto: array of TBitMap; Contador: Integer);
  544.   var
  545.    I: Integer;
  546.   begin
  547.     for I := 0 to Contador - 1 do begin
  548.       PA := Arreglo[I];
  549.       DibujaImagen(Arreglo, Foto, PA.Theta div 90);
  550.     end;
  551.   end;
  552.  
  553. begin
  554.     {Carga Foto}
  555.   if not OpenDialog1.Execute then Exit;
  556.   Button12Click(Sender);
  557.   TxtFileName := OpenDialog1.FileName;
  558.  
  559.   try
  560.     AssignFile(F, TxtFileName);
  561.     Reset(F);
  562.     LeeDatos(ArregloTubos, contTubos);
  563.     LeeDatos(ArregloMangueras, contMangueras);
  564.     LeeDatos(ArregloDistrib, contDistrib);
  565.     LeeDatos(ArregloCasas, contCasas);
  566.     LeeDatos(ArregloEdificios, contEdificios);
  567.     LeeDatos(ArregloBombas, contBombas);
  568.     LeeDatos(ArregloMedidores, contMedidores);
  569.     LeeDatos(ArregloLlaves, contLlaves);
  570.   finally
  571.     CloseFile(F);
  572.   end;
  573.   //repinta todos los componentes
  574.   PintaLineas(ArregloTubos, contTubos, clCobre, 5);
  575.   PintaLineas(ArregloMangueras, contMangueras, clBlack, 3);
  576.   PintaUno(ArregloDistrib, FotoDistrib, contDistrib);
  577.   PintaMuchos(ArregloCasas, FotosCasa, contCasas);
  578.   PintaMuchos(ArregloEdificios, FotosEdificio, contEdificios);
  579.   PintaUno(ArregloBombas, FotoBomba, contBombas);
  580.   PintaUno(ArregloMedidores, FotoMedidor, contMedidores);
  581.   PintaUno(ArregloLlaves, FotoLlave, contLlaves);
  582. end;
  583.  
  584. //GUARDAR DISEÑO
  585. procedure TForm1.Button9Click(Sender: TObject);
  586. var
  587.   TxtFileName: string;
  588.   F: TextFile;
  589.   procedure EscribeDatos(Arreglo: array of TParDePuntos; var Cont: Integer); overload;
  590.   var I: Integer;
  591.   begin
  592.     for I := 0 to Cont - 1 do begin
  593.       Write(f, Arreglo[I].Px, ' ');
  594.       Write(f, Arreglo[I].Py, ' ');
  595.       Write(f, Arreglo[I].Qx, ' ');
  596.       Writeln(f, Arreglo[I].Qy);
  597.     end;
  598.   end;
  599.  
  600.   procedure EscribeDatos(Arreglo: array of TPuntoAngulo; var Cont: Integer); overload;
  601.   var I: Integer;
  602.   begin
  603.     for I := 0 to Cont - 1 do begin
  604.       Write(f, Arreglo[I].X, ' ');
  605.       Write(f, Arreglo[I].Y, ' ');
  606.       Writeln(f, Arreglo[I].Theta);
  607.     end;
  608.   end;
  609. begin
  610.   if not SaveDialog1.Execute then Exit;
  611.   {Guarda datos}
  612.   TxtFileName := SaveDialog1.FileName;
  613.   try
  614.     AssignFile(F, TxtFileName);
  615.     Rewrite(F);
  616.     Writeln(f, contTubos, ' Tubos');
  617.     EscribeDatos(ArregloTubos, contTubos);
  618.     Writeln(f, contMangueras, ' Mangueras');
  619.     EscribeDatos(ArregloMangueras, contMangueras);
  620.     Writeln(f, contDistrib, ' Distribuidores');
  621.     EscribeDatos(ArregloDistrib, contDistrib);
  622.     Writeln(f, contCasas, ' Casas');
  623.     EscribeDatos(ArregloCasas, contCasas);
  624.     Writeln(f, contEdificios, ' Edificios');
  625.     EscribeDatos(ArregloEdificios, contEdificios);
  626.     Writeln(f, contBombas, ' Bombas');
  627.     EscribeDatos(ArregloBombas, contBombas);
  628.     Writeln(f, contMedidores, ' Medidores');
  629.     EscribeDatos(ArregloMedidores, contMedidores);
  630.     Writeln(f, contLlaves, ' Llaves');
  631.     EscribeDatos(ArregloLlaves, contLlaves);
  632.   finally
  633.     CloseFile(F);
  634.   end;
  635. end;
  636.  
  637. procedure InitVariables();
  638. begin
  639.   contTubos := 0;
  640.   contMangueras := 0;
  641.   contEdificios := 0;
  642.   contCasas := 0;
  643.   contDistrib := 0;
  644.   contBombas := 0;
  645.   contMedidores := 0;
  646.   contLlaves := 0;
  647.  
  648.   SetLength(ArregloTubos, 0);
  649.   SetLength(ArregloTubos, 0);
  650.   SetLength(ArregloMangueras, 0);
  651.   SetLength(ArregloCasas, 0);
  652.   SetLength(ArregloEdificios, 0);
  653.   SetLength(ArregloDistrib, 0);
  654.   SetLength(ArregloBombas, 0);
  655.   SetLength(ArregloMedidores, 0);
  656.   SetLength(ArregloLlaves, 0);
  657.  
  658.   SetLength(ArregloTubos, 50);
  659.   SetLength(ArregloMangueras, 50);
  660.   SetLength(ArregloCasas, 20);
  661.   SetLength(ArregloEdificios, 20);
  662.   SetLength(ArregloDistrib, 20);
  663.   SetLength(ArregloBombas, 20);
  664.   SetLength(ArregloMedidores, 20);
  665.   SetLength(ArregloLlaves, 20);
  666. end;
  667.  
  668. //AUTOR
  669. procedure TForm1.Button11Click(Sender: TObject);
  670. begin
  671.   ShowMessage('///' +sLineBreak+
  672.      '////' +sLineBreak+ '////');
  673. end;
  674.  
  675. //BORRA TODO
  676. procedure TForm1.Button12Click(Sender: TObject);
  677. begin
  678.   InitVariables();
  679.   Image1.Canvas.Rectangle(0,0, Image1.Width, Image1.Width);
  680.   PintarMalla(0, 0, Image1.Width, Image1.Height);
  681.   editDatos.Alignment := taCenter;
  682.   //editDatos.Text := 'Panel Reiniciado!';
  683. end;
  684.  
  685. //HACER COTIZACIÓN
  686. procedure TForm1.Button13Click(Sender: TObject);
  687. var I, Total: Integer;
  688.   PreciosXMetro, Cotizacion: array of Integer;
  689.   //devuelve la long de una linea en pixeles
  690.   function LongLinea(P: TParDePuntos): Integer;
  691.   begin
  692.    LongLinea := round( sqrt( power(P.Qx - P.Px, 2) + power(p.Qy - p.Py, 2)));
  693.   end;
  694.  
  695.   procedure DetCotizacion(Arreglo: array of TParDePuntos; c, index: Integer);
  696.     var J: Integer;
  697.   begin
  698.    for J := 0 to c - 1  do begin
  699.      Cotizacion[index] := Cotizacion[index] + (LongLinea(Arreglo[J]) div 2) *
  700.                     PreciosXMetro[index];
  701.    end;
  702.   end;
  703.  
  704. begin
  705.   PreciosXMetro := [200 ,100, 650, 1500, 1000, 150];
  706.   SetLength(Cotizacion, 6);
  707.   DetCotizacion(ArregloTubos, contTubos, 0);
  708.   DetCotizacion(ArregloMangueras, contMangueras, 1);
  709.   Cotizacion[2] := contDistrib*PreciosXMetro[2];
  710.   Cotizacion[3] := contBombas*PreciosXMetro[3];
  711.   Cotizacion[4] := contMedidores*PreciosXMetro[4];
  712.   Cotizacion[5] := contLlaves*PreciosXMetro[5];
  713.   Total := 0;
  714.   for I := 0 to length(Cotizacion) - 1 do
  715.     Total := Total + Cotizacion[I];
  716.   textoCotizacion := '################COTIZACION################' + sLineBreak;
  717.   textoCotizacion := textoCotizacion + '########################################'+ sLineBreak;
  718.   textoCotizacion := textoCotizacion + 'Total: '#9 + '$' + IntToStr(Total)+ sLineBreak;
  719.   textoCotizacion := textoCotizacion + #9'Desgloce:' + sLineBreak;
  720.   textoCotizacion := textoCotizacion + 'Tubos:'#9#9+ IntToStr(contTubos) ;
  721.   textoCotizacion := textoCotizacion + #9#9'$' +IntToStr(Cotizacion[0]) + sLineBreak;
  722.   textoCotizacion := textoCotizacion + 'Mangueras:'#9+ IntToStr(contMangueras) ;
  723.   textoCotizacion := textoCotizacion + #9#9'$' +IntToStr(Cotizacion[1]) + sLineBreak;
  724.   textoCotizacion := textoCotizacion + 'Distribuidores:'#9+ IntToStr(contDistrib) ;
  725.   textoCotizacion := textoCotizacion + #9#9'$' +IntToStr(Cotizacion[2]) + sLineBreak;
  726.   textoCotizacion := textoCotizacion + 'Bombas:'#9#9+ IntToStr(contBombas) ;
  727.   textoCotizacion := textoCotizacion + #9#9'$' +IntToStr(Cotizacion[3]) + sLineBreak;
  728.   textoCotizacion := textoCotizacion + 'Medidores:'#9+ IntToStr(contMedidores) ;
  729.   textoCotizacion := textoCotizacion + #9#9'$' +IntToStr(Cotizacion[4]) + sLineBreak;
  730.   textoCotizacion := textoCotizacion + 'Llaves:'#9#9+ IntToStr(contLlaves) ;
  731.   textoCotizacion := textoCotizacion + #9#9'$' +IntToStr(Cotizacion[5]) + sLineBreak;
  732.   {frmCotizacion.Show;
  733.   frmCotizacion.memoCotizacion.Text := textoCotizacion;}
  734. end;
  735.  
  736. procedure TForm1.Button14Click(Sender: TObject);
  737. begin
  738.   close();
  739. end;
  740.  
  741. procedure TForm1.FormCreate(Sender: TObject);
  742. var
  743.   W: TWICImage;
  744.   I, J: Integer;
  745. begin
  746.  
  747.   /////////////////////// cargar imágenes
  748.   W := TWicImage.Create;
  749.   J := 0;
  750.   try
  751.     for I := 0 to 3 do begin
  752.       W.LoadFromFile('casa'+IntToStr(J)+'.bmp');
  753.       FotosCasa[I] := TBitmap.Create;
  754.         FotosCasa[I].Assign(W);
  755.  
  756.       FotosEdificio[I] := TBitmap.Create;
  757.       W.LoadFromFile('edificio'+IntToStr(J)+'.bmp');
  758.         FotosEdificio[I].Assign(W);
  759.     end;
  760.  
  761.     W.LoadFromFile('distribuidor0.bmp');
  762.     FotoDistrib := TBitmap.Create;
  763.     FotoDistrib.Assign(W);
  764.  
  765.     W.LoadFromFile('bomba0.bmp');
  766.     FotoBomba := TBitmap.Create;
  767.     FotoBomba.Assign(W);
  768.  
  769.     W.LoadFromFile('medidor0.bmp');
  770.     FotoMedidor := TBitmap.Create;
  771.     FotoMedidor.Assign(W);
  772.  
  773.     W.LoadFromFile('llave0.bmp');
  774.     FotoLlave := TBitmap.Create;
  775.     FotoLlave.Assign(W);
  776.     clCobre := RGB(218,125,57); //color cobre
  777.   finally
  778.     W.Free;
  779.  
  780.   end;
  781.   //dibujar malla e inicializar variables
  782.   clCobre :=  RGB(218,125,57);
  783.   PintarMalla(0,0, Image1.Width, Image1.Height);
  784.   InitVariables;
  785. end;
  786.  
  787. procedure RoundToGrid(var X: Integer; var Y: Integer);
  788. begin
  789.     X := Round(X/20)*20;
  790.     Y := Round(Y/20)*20;
  791. end;
  792.  
  793. procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  794.   Shift: TShiftState; X, Y: Integer);
  795. begin
  796.   RoundToGrid(X, Y);
  797.   PP.Px := X;
  798.   PP.Py := Y;
  799.   PA.X := X;
  800.   PA.Y := Y;
  801.   //DrawPoint(X,Y, clRed);
  802. end;
  803.  
  804. procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  805.   Shift: TShiftState; X, Y: Integer);
  806. begin
  807.   RoundToGrid(X, Y);
  808.   PP.Qx := X;
  809.   PP.Qy := Y;
  810.   //DrawPoint(X,Y, clBlue);
  811. end;
  812.  
  813. end.
  814.  

 
Y para totar la imagen cuando sale el cuadro de Dialogo, se supone que tengo las Funciones:


delphi
  1. //dibuja imagen CON angulo
  2. procedure TForm1.DibujaImagen(var ArrPosicion: array of TPuntoAngulo;
  3.   Fotos: array of TBitMap; Grados: Integer);
  4. begin
  5.   Image1.Canvas.Brush.Color := clWhite;
  6.   Image1.Canvas.Draw(PA.x, PA.y, Fotos[grados]);
  7.  
  8. end;
  9.  
  10. //dibuja imagen SIN angulo
  11. procedure TForm1.DibujaImagen(var ArrPosicion: array of TPuntoAngulo;
  12.   Foto: TBitmap);
  13. begin
  14.   Image1.Canvas.Brush.Color := clWhite;
  15.   Image1.Canvas.Draw(PA.x, PA.y, Foto);
  16. end;

 
Y pues por lo mismo guardo las imagenes en .bmp y con el nombre por ejemplo de: casa0.bmp, casa90.bmp, casa180.bmp, casa270.bmp, etc...
 
Así que no entiendo bien donde puede estar el error del por que no las rota :( :confused

  • 1

#2 egostar

egostar

    missing my father, I love my mother.

  • Administrador
  • 14.289 mensajes
  • LocationMéxico

Escrito 06 octubre 2021 - 07:09

Buen día Dan Morales

 

Vamos a ver si podemos ayudarte. 

 

Saludos


  • 1

#3 escafandra

escafandra

    Advanced Member

  • Moderadores
  • PipPipPip
  • 4.009 mensajes
  • LocationMadrid - España

Escrito 06 octubre 2021 - 11:55

...Y para totar la imagen cuando sale el cuadro de Dialogo, se supone que tengo las Funciones:
 


delphi
  1. //dibuja imagen CON angulo
  2. procedure TForm1.DibujaImagen(var ArrPosicion: array of TPuntoAngulo;
  3.   Fotos: array of TBitMap; Grados: Integer);
  4. begin
  5.   Image1.Canvas.Brush.Color := clWhite;
  6.   Image1.Canvas.Draw(PA.x, PA.y, Fotos[grados]);
  7.  
  8. end;
  9.  
  10. //dibuja imagen SIN angulo
  11. procedure TForm1.DibujaImagen(var ArrPosicion: array of TPuntoAngulo;
  12.   Foto: TBitmap);
  13. begin
  14.   Image1.Canvas.Brush.Color := clWhite;
  15.   Image1.Canvas.Draw(PA.x, PA.y, Foto);
  16. end;

 
Y pues por lo mismo guardo las imagenes en .bmp y con el nombre por ejemplo de: casa0.bmp, casa90.bmp, casa180.bmp, casa270.bmp, etc...
 
Así que no entiendo bien donde puede estar el error del por que no las rota :( :confused

 


Sin ahondar mucho en el código que expones y fijándome en el procedimiento que dices para la rotación, no veo ningún algoritmo de rotación, simplemente intuyo que pretendes un array con los bitmaps ya rotados y que quieres dibujarlos. En dicho procedimiento declaras el array pero está vacío, no hay nada que dibujar.
 
En el foro se han publicado varias cosas sobre este tema. Por mi parte creo que la rotación usando la API GDI plus es la más eficiente.
Como rotar un BitMap (Jose Fco)
Rotar un Bitmap (cHackAll)
Girar un Bitmap (sir.dev.a.lot)
FlipImage con GDI+ (escafandra)
Rotar una imagen con GDI+ flat API dado un ángulo (escafandra)
 
fb7c1f23b98a923450e28bc8cc62f33bo.gif
Ejemplo de rotación dinámica con GDI+ de la clase TPelota publicada en el foro

 
Saludos.


  • 1

#4 Dan Morales

Dan Morales

    Newbie

  • Miembros
  • Pip
  • 3 mensajes

Escrito 06 octubre 2021 - 05:42

Me parece bien, me daré mi vuelta por el foro  (y)  Mil gracias


  • 0