Rotar Imagen Bmp

[DaniMir]

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

Ya que tengo el siguiente programa:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.ExtDlgs, math,
  Vcl.Dialogs, Vcl.Buttons;

type
  TParDePuntos = Packed Record
    Px: Integer;
    Py: Integer;
    Qx: Integer;
    Qy: Integer;
    function Equals(): boolean;
end;

type
  TPuntoAngulo = Packed Record
    X: Integer;
    Y: Integer;
    Theta: Integer;
    function Equals(): boolean;
end;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button0: TButton;
    editDatos: TEdit;
    Button8: TButton;
    Button9: TButton;
    Button12: TButton;
    Button13: TButton;
    CheckBox1: TCheckBox;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Panel2: TPanel;
    Label1: TLabel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;


    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Button0Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);


  private
    { Private declarations }
    procedure PintarMalla(X1, Y1, X2, Y2: Integer);
    procedure DibujarLinea(color: Cardinal; ancho: Integer);
    procedure BorrarLinea(Ancho: Integer);
    procedure DibujaImagen(var ArrPosicion: array of TPuntoAngulo;
      Fotos: array of TBitMap; Grados: Integer); overload;
    procedure DibujaImagen(var ArrPosicion: array of TPuntoAngulo; Foto: TBitmap); overload;

  public
    { Public declarations }
    textoCotizacion: String;
  end;

var
  Form1: TForm1;
  X1, Y1, X2, Y2: Integer;
  contTubos, contMangueras, contCasas, contDistrib,
    contEdificios, contBombas, contMedidores, contLlaves: Integer;

  FotosCasa, FotosEdificio: array[0..3] of TBitMap;
  FotoDistrib, FotoBomba, FotoMedidor, FotoLlave: TBitMap;

  ArregloTubos, ArregloMangueras: array of TParDePuntos;
  ArregloCasas, ArregloEdificios, ArregloDistrib, ArregloBombas,
    ArregloMedidores, ArregloLlaves: array of TPuntoAngulo;

  PP: TParDePuntos;
  PA: TPuntoAngulo;
  clCobre: Integer;

implementation

{$R *.dfm}

function TParDePuntos.Equals(): boolean;
begin
  Equals := false;
  if ((Self.Px = PP.Px) and (Self.Py = PP.Py) and (Self.Qx = PP.Qx)
      and (Self.Qy = PP.Qy)) or
      (((Self.Px = PP.Qx) and (Self.Py = PP.Qy) and (Self.Qx = PP.Px) and
      (Self.Qy = PP.Py)))  then
    Equals := true;
end;

function TPuntoAngulo.Equals(): boolean;
begin
  Equals := false;
  if (Self.X = PA.X) and (Self.Y = PA.Y) then
    Equals := true;
end;

{
  Funcion que dibuja la malla desde (X1,Y1) hasta (X2,Y2)
}
procedure TForm1.PintarMalla(X1, Y1, X2, Y2: Integer);
var
  I, J: Integer;
begin
  Image1.Canvas.Pen.Color := ClBlue;
  I := X1;
  J := Y1;
  while (I <= X2)  or (J <= Y2) do
  begin
    Image1.Canvas.MoveTo(I, Y1);
    Image1.Canvas.LineTo(I, Y2);
    Image1.Canvas.MoveTo(X1, J);
    Image1.Canvas.LineTo(X2, J);
    I := I + 20;
    J := J + 20;
  end;
  Image1.Canvas.Pen.Color := clBlack;
end;

{
  Funcion que dibuja una linea del ancho y color deseado
  con base en el objeto global PP
}

procedure TForm1.DibujarLinea(color: Cardinal; ancho: Integer);
begin
  Image1.Canvas.Pen.Color := color; //color cobre
  Image1.Canvas.Pen.Width := ancho;
  Image1.Canvas.MoveTo(PP.Px, PP.Py);
  Image1.Canvas.LineTo(PP.Qx, PP.Qy);
  Image1.Canvas.Pen.Color := clBlack;
  Image1.Canvas.Pen.Width := 1;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  close();
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  ShowMessage('DAVID MIRANDA FLORES' +sLineBreak+
     '[email protected]' +sLineBreak+ 'FCC BUAP');
end;

procedure TForm1.BorrarLinea(ancho: Integer);
begin
  Image1.Canvas.Pen.Color := clWhite; //color cobre
  Image1.Canvas.Pen.Width := ancho;
  Image1.Canvas.MoveTo(PP.Px, PP.Py);
  Image1.Canvas.LineTo(PP.Qx, PP.Qy);
  Image1.Canvas.Pen.Color := clBlack;
  Image1.Canvas.Pen.Width := 1;
  PintarMalla(PP.Px , PP.Py - 20, PP.Qx, PP.Qy + 20);
end;

function ExistePPEnArr(Arreglo: array of TParDePuntos; contador: Integer): Integer;
var I: Integer;
begin
  ExistePPEnArr := -1;
  for I := 0 to contador - 1 do begin
    if Arreglo[i].Equals() = true then begin
      ExistePPEnArr := I;
      Exit;
    end;
  end;
end;

function ExistePAEnArr(Arreglo: array of TPuntoAngulo; contador: Integer): Integer;
var I: Integer;
begin
  ExistePAEnArr := -1;
   for I := 0 to contador do begin
    if Arreglo[i].Equals() then  begin
      ExistePAEnArr := I;
      Exit;
    end;
  end;
end;

//TUBERIA
procedure TForm1.Button0Click(Sender: TObject);
var I: Integer;
begin

  if CheckBox1.Checked = true then begin
    CheckBox1.Checked := false;
    I := ExistePPEnArr(ArregloTubos, contTubos);
    if I <= -1 then begin
      ShowMessage('No existe ningun elemento que borrar :(');
      Exit;
    end;
    BorrarLinea(5);
    Delete(ArregloTubos, I, 1);
    Dec(contTubos);
    Exit;
  end;
  DibujarLinea(clCobre, 5);   //RGB(218,125,57) = color Cobre
  ArregloTubos[contTubos].Px := PP.Px;
  ArregloTubos[contTubos].Py := PP.Py;
  ArregloTubos[contTubos].Qx := PP.Qx;
  ArregloTubos[contTubos].Qy := PP.Qy;
  Inc(contTubos);
  editDatos.Text := 'Tubo agregado' + IntToStr(contTubos);
end;

//MANGUERA
procedure TForm1.Button1Click(Sender: TObject);
var I: Integer;
begin
  if(CheckBox1.Checked = true) then begin
    CheckBox1.Checked := false;
    I := ExistePPEnArr(ArregloMangueras, contMangueras);
    if (I = -1) then begin
      ShowMessage('No existe ningun elemento que borrar :(');
      Exit;
    end;

    BorrarLinea(3);
    Delete(ArregloMangueras, I, 1);
    Dec(contMangueras);

    Exit;
  end;

  DibujarLinea(clBlack, 3);
  ArregloMangueras[contMangueras] := PP;
  Inc(contMangueras);
  editDatos.Text := 'Manguera agregada' + IntToStr(contMangueras);

end;

{
  Funcion que solicita al usuario los grados de rotacion para
  dibujar una casa o un edificio
  Valores posibles:
    -1 -> Default
     0 -> 0*90 grados
     1 -> 1*90 grados = 90
     2 -> 2*90 grados = 180
     3 -> 3*90 grados = 270
}
function MuestraDialogoGrados(): Integer;
begin
  MuestraDialogoGrados := -1;
  with CreateMessageDialog('Ingresa la rotacion deseada:', mtInformation,
    [mbYes,mbNo,mbOK,mbRetry,mbClose]) do
    try
      TButton(FindComponent('Yes')).Caption := '0 grados';
      TButton(FindComponent('No')).Caption := '90 grados';
      TButton(FindComponent('Ok')).Caption := '180 grados';
      TButton(FindComponent('Retry')).Caption := '270 grados';
          TButton(FindComponent('Close')).Caption := 'Cancelar';
      case ShowModal of
        mrYes: MuestraDialogoGrados := 0;
        mrNo: MuestraDialogoGrados := 1;
        mrOK: MuestraDialogoGrados := 2;
        mrRetry: MuestraDialogoGrados := 3;
      end;
    finally
      Free;
    end;
end;

//dibuja imagen CON angulo
procedure TForm1.DibujaImagen(var ArrPosicion: array of TPuntoAngulo;
  Fotos: array of TBitMap; Grados: Integer);
begin
  Image1.Canvas.Brush.Color := clWhite;
  Image1.Canvas.Draw(PA.x, PA.y, Fotos[grados]);

end;

//dibuja imagen SIN angulo
procedure TForm1.DibujaImagen(var ArrPosicion: array of TPuntoAngulo;
  Foto: TBitmap);
begin
  Image1.Canvas.Brush.Color := clWhite;
  Image1.Canvas.Draw(PA.x, PA.y, Foto);
end;

//DISTRIBUIDOR
procedure TForm1.Button2Click(Sender: TObject);
var
  I: Integer;
  begin
  if CheckBox1.Checked = true then begin

      CheckBox1.Checked := false;
      I := ExistePAEnArr(ArregloDistrib, contDistrib);
      if I <= -1 then begin
        ShowMessage('No existe ningun elemento que borrar :(');
        Exit;
      end;

      //Borrar elemento de image1
      Image1.Canvas.Rectangle(PA.X, Pa.Y, PA.X + 81, Pa.Y + 81);
      PintarMalla(PA.X, Pa.Y, PA.X + 80, Pa.Y + 80);
      //Eliminar de arreglo
      Delete(ArregloDistrib, I, 1);
      Dec(contDistrib);
      Exit;
  end;

  DibujaImagen(ArregloDistrib, FotoDistrib);
  PA.Theta := 0;
  ArregloDistrib[contDistrib] := PA;
  Inc(contDistrib);
  editDatos.Text := 'Distribuidor agregado' + IntToStr(contDistrib);
end;

//CASA
procedure TForm1.Button3Click(Sender: TObject);
var I, grados: Integer;
begin
  if CheckBox1.Checked = true then begin

    CheckBox1.Checked := false;
    I := ExistePAEnArr(ArregloCasas, contCasas);
    if I <= -1 then begin
      ShowMessage('No existe ningun elemento que borrar :(');
      Exit;
    end;

    //Borrar elemento de image1
    Image1.Canvas.Rectangle(PA.X, Pa.Y, PA.X + 81, Pa.Y + 81);
    PintarMalla(PA.X, Pa.Y, PA.X + 80, Pa.Y + 80);
    //Eliminar de arreglo
    Delete(ArregloCasas, I, 1);
    Dec(contCasas);
    Exit;
  end;
  grados := MuestraDialogoGrados;
  if grados = -1 then
    Exit;
  DibujaImagen(ArregloCasas, FotosCasa, grados);
  ArregloCasas[contCasas] := PA;
  Inc(contCasas);
  editDatos.Text := 'Casa + ' + IntToStr(contCasas);
end;

//EDIFICIO
procedure TForm1.Button4Click(Sender: TObject);
var I, grados: Integer;
begin
    if CheckBox1.Checked = true then begin

      CheckBox1.Checked := false;
      I := ExistePAEnArr(ArregloEdificios, contEdificios);
      if I <= -1 then begin
        ShowMessage('No existe ningun elemento que borrar :(');
        Exit;
      end;

      //Borrar elemento de image1
      Image1.Canvas.Rectangle(PA.X, Pa.Y, PA.X + 81, Pa.Y + 81);
      PintarMalla(PA.X, Pa.Y, PA.X + 80, Pa.Y + 80);
      //Eliminar de arreglo
      Delete(ArregloEdificios, I, 1);
      Dec(contEdificios);
      Exit;
  end;
  grados := MuestraDialogoGrados;
  if grados = -1 then
    Exit;
  DibujaImagen(ArregloEdificios, FotosEdificio, grados);
  ArregloEdificios[contEdificios] := PA;
  Inc(contEdificios);
  editDatos.Text := 'Edificio + ' + IntToStr(contEdificios);
end;

//BOMBA
procedure TForm1.Button5Click(Sender: TObject);
var I: Integer;
begin
    if CheckBox1.Checked = true then begin

      CheckBox1.Checked := false;
      I := ExistePAEnArr(ArregloBombas, contBombas);
      if I <= -1 then begin
        ShowMessage('No existe ningun elemento que borrar :(');
        Exit;
      end;

      //Borrar elemento de image1
      Image1.Canvas.Rectangle(PA.X, Pa.Y, PA.X + 81, Pa.Y + 81);
      PintarMalla(PA.X, Pa.Y, PA.X + 80, Pa.Y + 80);
      //Eliminar de arreglo
      Delete(ArregloBombas, I, 1);
      Dec(contBombas);
      Exit;
  end;
  DibujaImagen(ArregloBombas, FotoBomba);
  PA.Theta := 0;
  ArregloBombas[contBombas] := PA;
  Inc(contBombas);
  editDatos.Text := 'Bomba + ' + IntToStr(contBombas);
end;

//MEDIDOR
procedure TForm1.Button6Click(Sender: TObject);
var I: Integer;
begin
    if CheckBox1.Checked = true then begin

      CheckBox1.Checked := false;
      I := ExistePAEnArr(ArregloMedidores, contMedidores);
      if I <= -1 then begin
        ShowMessage('No existe ningun elemento que borrar :(');
        Exit;
      end;

      //Borrar elemento de image1
      Image1.Canvas.Rectangle(PA.X, Pa.Y, PA.X + 81, Pa.Y + 81);
      PintarMalla(PA.X, Pa.Y, PA.X + 80, Pa.Y + 80);
      //Eliminar de arreglo
      Delete(ArregloMedidores, I, 1);
      Dec(contMedidores);
      Exit;
  end;
  DibujaImagen(ArregloMedidores, FotoMedidor);
  PA.Theta := 0;
  ArregloMedidores[contMedidores] := PA;
  Inc(contMedidores);
  editDatos.Text := 'Medidor + ' + IntToStr(contMedidores);
end;

//LLAVE DE PASO
procedure TForm1.Button7Click(Sender: TObject);
var I: Integer;
begin
    if CheckBox1.Checked = true then begin
      CheckBox1.Checked := false;
      I := ExistePAEnArr(ArregloLlaves, contLlaves);
      if I <= -1 then begin
        ShowMessage('No existe ningun elemento que borrar :(');
        Exit;
      end;

      //Borrar elemento de image1
      Image1.Canvas.Rectangle(PA.X, Pa.Y, PA.X + 81, Pa.Y + 81);
      PintarMalla(PA.X, Pa.Y, PA.X + 80, Pa.Y + 80);
      //Eliminar de arreglo
      Delete(ArregloLlaves, I, 1);
      Dec(contLlaves);
      Exit;
  end;
  DibujaImagen(ArregloLlaves, FotoLlave);
  PA.Theta := 0;
  ArregloLlaves[contLlaves] := PA;
  Inc(contLlaves);
  editDatos.Text := 'Llave + ' + IntToStr(contLlaves);
end;

//ABRIR DISEÑO
procedure TForm1.Button8Click(Sender: TObject);
var
  TxtFileName: string;
  F: TextFile;


  procedure LeeDatos(var Arreglo: array of TParDePuntos;
    var Contador: Integer); overload;
  var
    p: TParDePuntos;
    I: Integer;
  begin
    Readln(F, Contador);
    for I := 0 to Contador - 1 do begin
      Readln(F, p.Px, p.Py, p.Qx, p.Qy);
      Arreglo[i] := p;
      PP := p;
    end;
  end;

  procedure LeeDatos(var Arreglo: array of TPuntoAngulo;
    var Contador: Integer); overload;
  var
    p: TPuntoAngulo;
    I: Integer;
  begin
    Readln(F, Contador);
    for I := 0 to Contador - 1 do begin
      Readln(F, p.X, p.Y, p.Theta);
      Arreglo[i] := p;
    end;
  end;

  procedure PintaLineas(Arreglo: array of TParDePuntos;
    Contador: Integer; Color, Ancho: Integer);
  var
   I: Integer;
  begin
    for I := 0 to Contador - 1 do begin
      PP := Arreglo[i];
      DibujarLinea(Color, Ancho);
    end;
  end;

  procedure PintaUno(Arreglo: array of TPuntoAngulo;
    Fotos: array of TBitMap; Contador: Integer);
  var
   I: Integer;
  begin
    for I := 0 to Contador - 1 do begin
      PA := Arreglo[i];
      DibujaImagen(Arreglo, Fotos, PA.Theta div 90);
    end;
  end;

  procedure PintaMuchos(Arreglo: array of TPuntoAngulo;
    Foto: array of TBitMap; Contador: Integer);
  var
   I: Integer;
  begin
    for I := 0 to Contador - 1 do begin
      PA := Arreglo[i];
      DibujaImagen(Arreglo, Foto, PA.Theta div 90);
    end;
  end;

begin
    {Carga Foto}
  if not OpenDialog1.Execute then Exit;
  Button12Click(Sender);
  TxtFileName := OpenDialog1.FileName;

  try
    AssignFile(F, TxtFileName);
    Reset(F);
    LeeDatos(ArregloTubos, contTubos);
    LeeDatos(ArregloMangueras, contMangueras);
    LeeDatos(ArregloDistrib, contDistrib);
    LeeDatos(ArregloCasas, contCasas);
    LeeDatos(ArregloEdificios, contEdificios);
    LeeDatos(ArregloBombas, contBombas);
    LeeDatos(ArregloMedidores, contMedidores);
    LeeDatos(ArregloLlaves, contLlaves);
  finally
    CloseFile(F);
  end;
  //repinta todos los componentes
  PintaLineas(ArregloTubos, contTubos, clCobre, 5);
  PintaLineas(ArregloMangueras, contMangueras, clBlack, 3);
  PintaUno(ArregloDistrib, FotoDistrib, contDistrib);
  PintaMuchos(ArregloCasas, FotosCasa, contCasas);
  PintaMuchos(ArregloEdificios, FotosEdificio, contEdificios);
  PintaUno(ArregloBombas, FotoBomba, contBombas);
  PintaUno(ArregloMedidores, FotoMedidor, contMedidores);
  PintaUno(ArregloLlaves, FotoLlave, contLlaves);
end;

//GUARDAR DISEÑO
procedure TForm1.Button9Click(Sender: TObject);
var
  TxtFileName: string;
  F: TextFile;
  procedure EscribeDatos(Arreglo: array of TParDePuntos; var Cont: Integer); overload;
  var I: Integer;
  begin
    for I := 0 to Cont - 1 do begin
      Write(f, Arreglo[i].Px, ' ');
      Write(f, Arreglo[i].Py, ' ');
      Write(f, Arreglo[i].Qx, ' ');
      Writeln(f, Arreglo[i].Qy);
    end;
  end;

  procedure EscribeDatos(Arreglo: array of TPuntoAngulo; var Cont: Integer); overload;
  var I: Integer;
  begin
    for I := 0 to Cont - 1 do begin
      Write(f, Arreglo[i].X, ' ');
      Write(f, Arreglo[i].Y, ' ');
      Writeln(f, Arreglo[i].Theta);
    end;
  end;
begin
  if not SaveDialog1.Execute then Exit;
  {Guarda datos}
  TxtFileName := SaveDialog1.FileName;
  try
    AssignFile(F, TxtFileName);
    Rewrite(F);
    Writeln(f, contTubos, ' Tubos');
    EscribeDatos(ArregloTubos, contTubos);
    Writeln(f, contMangueras, ' Mangueras');
    EscribeDatos(ArregloMangueras, contMangueras);
    Writeln(f, contDistrib, ' Distribuidores');
    EscribeDatos(ArregloDistrib, contDistrib);
    Writeln(f, contCasas, ' Casas');
    EscribeDatos(ArregloCasas, contCasas);
    Writeln(f, contEdificios, ' Edificios');
    EscribeDatos(ArregloEdificios, contEdificios);
    Writeln(f, contBombas, ' Bombas');
    EscribeDatos(ArregloBombas, contBombas);
    Writeln(f, contMedidores, ' Medidores');
    EscribeDatos(ArregloMedidores, contMedidores);
    Writeln(f, contLlaves, ' Llaves');
    EscribeDatos(ArregloLlaves, contLlaves);
  finally
    CloseFile(F);
  end;
end;

procedure InitVariables();
begin
  contTubos := 0;
  contMangueras := 0;
  contEdificios := 0;
  contCasas := 0;
  contDistrib := 0;
  contBombas := 0;
  contMedidores := 0;
  contLlaves := 0;

  SetLength(ArregloTubos, 0);
  SetLength(ArregloTubos, 0);
  SetLength(ArregloMangueras, 0);
  SetLength(ArregloCasas, 0);
  SetLength(ArregloEdificios, 0);
  SetLength(ArregloDistrib, 0);
  SetLength(ArregloBombas, 0);
  SetLength(ArregloMedidores, 0);
  SetLength(ArregloLlaves, 0);

  SetLength(ArregloTubos, 50);
  SetLength(ArregloMangueras, 50);
  SetLength(ArregloCasas, 20);
  SetLength(ArregloEdificios, 20);
  SetLength(ArregloDistrib, 20);
  SetLength(ArregloBombas, 20);
  SetLength(ArregloMedidores, 20);
  SetLength(ArregloLlaves, 20);
end;

//AUTOR
procedure TForm1.Button11Click(Sender: TObject);
begin
  ShowMessage('D' +sLineBreak+
     '[email protected]' +sLineBreak+ 'FCCP');
end;

//BORRA TODO
procedure TForm1.Button12Click(Sender: TObject);
begin
  InitVariables();
  Image1.Canvas.Rectangle(0,0, Image1.Width, Image1.Width);
  PintarMalla(0, 0, Image1.Width, Image1.Height);
  editDatos.Alignment := taCenter;
  //editDatos.Text := 'Panel Reiniciado!';
end;

//HACER COTIZACIÓN
procedure TForm1.Button13Click(Sender: TObject);
var I, Total: Integer;
  PreciosXMetro, Cotizacion: array of Integer;
  //devuelve la long de una linea en pixeles
  function LongLinea(P: TParDePuntos): Integer;
  begin
   LongLinea := round( sqrt( power(P.Qx - P.Px, 2) + power(p.Qy - p.Py, 2)));
  end;

  procedure DetCotizacion(Arreglo: array of TParDePuntos; c, index: Integer);
    var J: Integer;
  begin
   for J := 0 to c - 1  do begin
     Cotizacion[index] := Cotizacion[index] + (LongLinea(Arreglo[J]) div 2) *
                    PreciosXMetro[index];
   end;
  end;

begin
  PreciosXMetro := [200 ,100, 650, 1500, 1000, 150];
  SetLength(Cotizacion, 6);
  DetCotizacion(ArregloTubos, contTubos, 0);
  DetCotizacion(ArregloMangueras, contMangueras, 1);
  Cotizacion[2] := contDistrib*PreciosXMetro[2];
  Cotizacion[3] := contBombas*PreciosXMetro[3];
  Cotizacion[4] := contMedidores*PreciosXMetro[4];
  Cotizacion[5] := contLlaves*PreciosXMetro[5];
  Total := 0;
  for I := 0 to length(Cotizacion) - 1 do
    Total := Total + Cotizacion[i];
  textoCotizacion := '################COTIZACION################' + sLineBreak;
  textoCotizacion := textoCotizacion + '########################################'+ sLineBreak;
  textoCotizacion := textoCotizacion + 'Total: '#9 + '$' + IntToStr(Total)+ sLineBreak;
  textoCotizacion := textoCotizacion + #9'Desgloce:' + sLineBreak;
  textoCotizacion := textoCotizacion + 'Tubos:'#9#9+ IntToStr(contTubos) ;
  textoCotizacion := textoCotizacion + #9#9'$' +IntToStr(Cotizacion[0]) + sLineBreak;
  textoCotizacion := textoCotizacion + 'Mangueras:'#9+ IntToStr(contMangueras) ;
  textoCotizacion := textoCotizacion + #9#9'$' +IntToStr(Cotizacion[1]) + sLineBreak;
  textoCotizacion := textoCotizacion + 'Distribuidores:'#9+ IntToStr(contDistrib) ;
  textoCotizacion := textoCotizacion + #9#9'$' +IntToStr(Cotizacion[2]) + sLineBreak;
  textoCotizacion := textoCotizacion + 'Bombas:'#9#9+ IntToStr(contBombas) ;
  textoCotizacion := textoCotizacion + #9#9'$' +IntToStr(Cotizacion[3]) + sLineBreak;
  textoCotizacion := textoCotizacion + 'Medidores:'#9+ IntToStr(contMedidores) ;
  textoCotizacion := textoCotizacion + #9#9'$' +IntToStr(Cotizacion[4]) + sLineBreak;
  textoCotizacion := textoCotizacion + 'Llaves:'#9#9+ IntToStr(contLlaves) ;
  textoCotizacion := textoCotizacion + #9#9'$' +IntToStr(Cotizacion[5]) + sLineBreak;
  {frmCotizacion.Show;
  frmCotizacion.memoCotizacion.Text := textoCotizacion;}
end;

procedure TForm1.Button14Click(Sender: TObject);
begin
  close();
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  W: TWICImage;
  I, J: Integer;
begin

  /////////////////////// cargar imágenes
  W := TWicImage.Create;
  J := 0;
  try
    for I := 0 to 3 do begin
      W.LoadFromFile('casa'+IntToStr(J)+'.bmp');
      FotosCasa[i] := TBitmap.Create;
        FotosCasa[i].Assign(W);

      FotosEdificio[i] := TBitmap.Create;
      W.LoadFromFile('edificio'+IntToStr(J)+'.bmp');
        FotosEdificio[i].Assign(W);
    end;

    W.LoadFromFile('distribuidor0.bmp');
    FotoDistrib := TBitmap.Create;
    FotoDistrib.Assign(W);

    W.LoadFromFile('bomba0.bmp');
    FotoBomba := TBitmap.Create;
    FotoBomba.Assign(W);

    W.LoadFromFile('medidor0.bmp');
    FotoMedidor := TBitmap.Create;
    FotoMedidor.Assign(W);

    W.LoadFromFile('llave0.bmp');
    FotoLlave := TBitmap.Create;
    FotoLlave.Assign(W);
    clCobre := RGB(218,125,57); //color cobre
  finally
    W.Free;

  end;
  //dibujar malla e inicializar variables
  clCobre :=  RGB(218,125,57);
  PintarMalla(0,0, Image1.Width, Image1.Height);
  InitVariables;
end;

procedure RoundToGrid(var X: Integer; var Y: Integer);
begin
    X := Round(X/20)*20;
    Y := Round(Y/20)*20;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  RoundToGrid(X, Y);
  PP.Px := X;
  PP.Py := Y;
  PA.X := X;
  PA.Y := Y;
  //DrawPoint(X,Y, clRed);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  RoundToGrid(X, Y);
  PP.Qx := X;
  PP.Qy := Y;
  //DrawPoint(X,Y, clBlue);
end;

end.

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

//dibuja imagen CON angulo
procedure TForm1.DibujaImagen(var ArrPosicion: array of TPuntoAngulo;
  Fotos: array of TBitMap; Grados: Integer);
begin
  Image1.Canvas.Brush.Color := clWhite;
  Image1.Canvas.Draw(PA.x, PA.y, Fotos[grados]);

end;

//dibuja imagen SIN angulo
procedure TForm1.DibujaImagen(var ArrPosicion: array of TPuntoAngulo;
  Foto: TBitmap);
begin
  Image1.Canvas.Brush.Color := clWhite;
  Image1.Canvas.Draw(PA.x, PA.y, Foto);
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

[Neftali [Germán.Estévez]]

Deberías intentar acotar un poco el problema e intentar además de explicar el problema, añadir el código para poder probarlo.
Si quieres añadir un pequeño ejemplo donde se pueda reproducir el problema mejor (si no puedes colocar enlaces envíame el fichero por privado y yo mismo lo coloco).

El código que has puesto del formulario no sirve de mucho sin el fichero DFM. Es complicado saber también qué hacen los botones si no es mirando el código e intuyendo qué puede ser. No se puede probar.

Lo dicho, creo que lo más fácil sería montar un ejemplo sencillo donde añadas las funciones de rotar, para poder probarlas.

[DaniMir]

Muchas gracias por la atención, ya he enviado el archivo con el programa al privado, estaba pensanedo si es mejor así el metodo de la rotación o también quede mejor enlazar un edit con un boton que se llame rotar, y solo aplicar condicionales para que si por ejemplo, edit1.text := 0,90,180,270 , etc. Imprima la imagen según sea el caso

[Neftali [Germán.Estévez]]

Añado el ejemplo que has puesto del proyecto.

[Neftali [Germán.Estévez]]

Por lo que he visto, no estás cargando las imágenes correctamente.
Si ejecutas paso a paso la aplicación, verás que cuando cargas las imágenes ejecutas este código:

Código Delphi [-]
for I := 0 to 3 do begin
      W.LoadFromFile('casa'+IntToStr(J)+'.jpg');
      FotosCasa[i] := TBitmap.Create;
        FotosCasa[i].Assign(W);

      FotosEdificio[i] := TBitmap.Create;
      W.LoadFromFile('edificio'+IntToStr(J)+'.bmp');
        FotosEdificio[i].Assign(W);
    end;

Lo que intenta es cargar imágenes que se llamen: casa0.jpg, casa90.jpg casa180.jpg y casa270.jpg

(1) Lo primero es que deberías cambiar el código par que cargue imágenes BMP, que son las que tienes en el directorio.
(2) Lo segundo es que si te fijas bien, el bucle usa la variable I y en el nombre del fichero usas la variable J, por lo tanto, estás cargando 4 veces la imagen casa0.JPG (que si existe).
(3) Por último, si quieres cargar las imágenes con números 0, 90, 180 y 270, tendrás que multiplicar el índice por 90.

El código para cargar las imágenes correctamente sería algo así:

Código Delphi [-]
var
  ...

  fName:string;
begin

...

/////////////////////// cargar imágenes
  W := TWicImage.Create;
  J := 0;
  try
    for I := 0 to 3 do begin
      fName := 'casa'+IntToStr(90*I)+'.bmp';
      W.LoadFromFile(fName);
      _FotosCasa[i] := TBitmap.Create;
      _FotosCasa[i].Assign(W);

      FotosEdificio[i] := TBitmap.Create;
      fName := 'edificio'+IntToStr(90*I)+'.bmp';
      W.LoadFromFile(fName);
      FotosEdificio[i].Assign(W);
    end;

[DaniMir]

Mil gracias, me sirvió de mucho!!!

quién diria que sólo era agregar un par de líneas

[DaniMir]

Ya sólo me queda una duda y espero no sea demasiado inoportuna...

Se supone que en guardar elijo todas la imágenes de casa y edificio rotadas también, pero al abrir el archivo no me las coloca como tal

[Neftali [Germán.Estévez]]

Es posible que sea problema de GUARDAR, no del RECUPERAR, ya que da la impresión de que en el fichero no hay información de la rotación.