FTP | CCD | Buscar | Trucos | Trabajo | Foros |
|
Registrarse | FAQ | Miembros | Calendario | Guía de estilo | Temas de Hoy |
|
Herramientas | Buscar en Tema | Desplegado |
#1
|
|||
|
|||
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. 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; Así que no entiendo bien donde puede estar el error del por que no las rota |
#2
|
||||
|
||||
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.
__________________
Germán Estévez => Web/Blog Guía de estilo, Guía alternativa Utiliza TAG's en tus mensajes. Contactar con el Clubdelphi P.D: Más tiempo dedicado a la pregunta=Mejores respuestas. |
#3
|
|||
|
|||
@Neftali
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
|
#4
|
||||
|
||||
Añado el ejemplo que has puesto del proyecto.
__________________
Germán Estévez => Web/Blog Guía de estilo, Guía alternativa Utiliza TAG's en tus mensajes. Contactar con el Clubdelphi P.D: Más tiempo dedicado a la pregunta=Mejores respuestas. |
#5
|
||||
|
||||
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:
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í:
__________________
Germán Estévez => Web/Blog Guía de estilo, Guía alternativa Utiliza TAG's en tus mensajes. Contactar con el Clubdelphi P.D: Más tiempo dedicado a la pregunta=Mejores respuestas. |
#6
|
|||
|
|||
@Neftali
Mil gracias, me sirvió de mucho!!!
quién diria que sólo era agregar un par de líneas |
#7
|
|||
|
|||
@Neftali
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 |
#8
|
||||
|
||||
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.
__________________
Germán Estévez => Web/Blog Guía de estilo, Guía alternativa Utiliza TAG's en tus mensajes. Contactar con el Clubdelphi P.D: Más tiempo dedicado a la pregunta=Mejores respuestas. |
|
|
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 |
|