Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Gráficos
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

 
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 06-10-2021
DaniMir DaniMir is offline
Registrado
 
Registrado: sep 2021
Posts: 6
Poder: 0
DaniMir Va por buen camino
Question Rotar Imagen Bmp

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

Ya que tengo el siguiente programa:

Código:
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+
     'david2490603@live.com.mx' +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+
     'd@live.com.mx' +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:
Código:
//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
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Rotar imagen panorámica Fossy Gráficos 3 05-09-2012 19:05:24
rotar imagen en c++ builder pulpin C++ Builder 20 09-09-2008 23:06:28
Rotar Imagen Rako Gráficos 5 23-11-2007 12:51:14
Rotar imagen jpg ElDioni Gráficos 6 09-11-2007 11:05:50
Rotar una imagen zuriel_zrf Gráficos 2 29-12-2003 19:37:53


La franja horaria es GMT +2. Ahora son las 13:50:15.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi