FTP | CCD | Buscar | Trucos | Trabajo | Foros |
|
Registrarse | FAQ | Miembros | Calendario | Guía de estilo | Temas de Hoy |
|
Herramientas | Buscar en Tema | Desplegado |
#1
|
|||
|
|||
Lograr coordenadas de imagen.
Hola, voy a ver si puedo explicarme bien.
Tengo un control TImgEdit al que cargo una imagen (generalmente es .tif) y cuando tengo cargada la imagen selecciono un rectangulo. Lo que necesito saber es la distancia desde el lado izquierdo del control hasta la imagen y saberlo en milimetros. Con el evento SelectionRectDrawn del TImgEdit consigo saber esa distancia, supuestamente en pixeles. Para saber la distancia en milimetros realizo la siguiente operación: Busco la resolución de la imagen (200 ppp) 1 pulgada = 25,4 mm Distancia en milimetros = (Distancia en pixeles x 25,4) / 200 Bueno el problema que tengo es que los milimetros que me da no son reales, lo mido y me sale bastante más. No sé si estoy tomando algún dato mal. He probado con la imagen con el tamaño real y con la imagen a tamaño reducido. El problema es el mismo. Gracias |
#2
|
|||
|
|||
Hola Besto,
no he intentado nada de esto, pero como muestras la imagen por pantalla, puede que debas utilizar la resolucion del monitor (Tscreen.PixelsPerInch). Espero que te sea de ayuda. Oscar Noe
__________________
No dejes camino viejo por sendero nuevo |
#3
|
|||
|
|||
Gracias,
la verdad es que estoy hecha un lio y no sé si alguien me podrá ayudar como me has comentado he mirado la resolución del monitor que es de 96ppp. Por otro lado tengo la imagen que esta a 200ppp. Tengo un control que se le pido la anchura (width ) me da 761 (supuestamente en pixeles) y cuando en ese control introduzco una imagen y le pido la anchura de la imagen me da 1471 (también supuestamente pixeles), el caso es que yo necesito obtener los datos de un trozo de la imagen que lo puedo seleccionar. y cuando le pido los datos de la selección que es lo que tengo que pasar a milimetros me da unos números que no ya que son ni como trasformarlos. Por favor, si alguien sabe como soluccionarlo se lo agradecería mucho. Gracias por leer todo ese rollo. |
#5
|
|||
|
|||
Gracias, voy a probarlo.
|
#6
|
|||
|
|||
S.o.s!!
queridisimos amigos y aficionados a Delphi; necesito una solucion urgente. LLevo mas de 3 semanas trabajando en esto:..
Manejo imagenes de tipo TIFF; necesito seleccionar una parte de esta y SIN guardarla en ningun archivo mandarla a imprimir. Les muestro lo que tengo hasta ahora:... Puedo dibujar el rectangulo, al parecer copia bien de la imagen... pero imprimir imprime en blanco unit manejo_imagenes; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, jpeg, ExtCtrls, ImgList, ildoctb, IlDocImg, ILantb, ilddoctb, ILSaveImageThread, QuickRpt, QRCtrls, Grids, ImageLibThumbnails, ILDocImageThumbNails, ildbmitb, TMultiP, ilmitb, Gauges, StdCtrls, TeeProcs, TeEngine, Chart,Printers; type Tform_img = class(TForm) ImageList1: TImageList; Panel1: TPanel; paleta: TIlDocImageToolbar; imagen2: ILDocumentImage; Print: TPrintDialog; marca2: TLabel; marca3: TLabel; marca6: TLabel; marca5: TLabel; marca4: TLabel; AnnotationsToolbar1: TAnnotationsToolbar; procedure FormActivate(Sender: TObject); procedure imagen2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure imagen2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure imagen2MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure imagen2DblClick(Sender: TObject); procedure Marcar(Bitmap: ILDocumentImage; Texto: String); procedure marca2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure imagen2Click(Sender: TObject); private { Private declarations } RectVisible: boolean; // ¿El rectángulo está visible? Drawing: boolean; // ¿Estamos dibujando el rectángulo? p1, p2: TPoint; // Esquina del rectángulo de selección procedure DrawRectangle; // procedure mnuCropClick(Sender: TObject); public { Public declarations } end; var form_img: Tform_img; implementation {$R *.dfm} procedure Tform_img.FormActivate(Sender: TObject); var rect:TRect; Marca: TBitmap; i,j: Integer; texto:string; begin imagen2.ReadTifFile('C:\Fuentes\ActasEscaneadas\D\2000\12345\00000002.TIF', 0, 0); texto:='TOP SECRET'; marca2.Canvas.Lock; marca2.Transparent:=true; marca2.BringToFront; marca2.Canvas.Brush.Color:= clBlack; Marca2.Canvas.Font.Color:= clWhite; marca3.Canvas.Lock; marca3.Transparent:=true; marca3.BringToFront; marca3.Canvas.Brush.Color:= clBlack; Marca3.Canvas.Font.Color:= clWhite; marca4.Canvas.Lock; marca4.Transparent:=true; marca4.BringToFront; marca4.Canvas.Brush.Color:= clBlack; Marca4.Canvas.Font.Color:= clWhite; marca5.Canvas.Lock; marca5.Transparent:=true; marca5.BringToFront; marca5.Canvas.Brush.Color:= clBlack; Marca5.Canvas.Font.Color:= clWhite; end; procedure Tform_img.imagen2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if RectVisible then DrawRectangle; p1.x := X; p1.y := Y; p2.x := X; p2.y := Y; DrawRectangle; Drawing := True; RectVisible := True; end; procedure Tform_img.imagen2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if Drawing then begin DrawRectangle; p2.x := X; p2.y := Y; DrawRectangle; end; end; procedure Tform_img.imagen2MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Drawing := False; end; procedure TForm_img.DrawRectangle; var p: array [0..4] of TPoint; begin p[0] := p1; p[1].x := p2.x; p[1].y := p1.y; p[2] := p2; p[3].x := p1.x; p[3].y := p2.y; p[4] := p1; Imagen2.Canvas.Polyline(p); end; procedure Tform_img.imagen2DblClick(Sender: TObject); var m: longint; bitmap: TBitmap; SrcRect, DstRect: TRect; imagenaux:ILDocumentImage; //recorta la imagen begin if not RectVisible then exit; //if (p1.x = p2.x) and (p1.y = p2.y) then exit; // Remueve el rectángulo de selección DrawRectangle; RectVisible := False; Drawing := False; // Aseguramos que p1 sea la esquina superior izquierda // y que p2 se la esquina inferior derecha if p2.x < p1.x then begin m := p1.x; p1.x := p2.x; p2.x := m; end; if p2.y < p1.y then begin m := p1.y; p1.y := p2.y; p2.y := m; end; with Imagen2.MBitmap do begin // Controlamos que las coordenadas estén dentro de la imagen //if (p1.x >= Width) then exit; //if (p1.y >= Height) then exit; //Ajustamos las coordenadas si es necesario // if (p2.x >= Width) then p2.x := Width - 1; // if (p2.y >= Width) then p2.y := Height - 1; end; // Rectángulo de origen SrcRect.TopLeft := p1; SrcRect.BottomRight := p2; // Rectángulo destino DstRect.Left := 0; DstRect.Right := p2.x - p1.x + 1; DstRect.Top := 0; DstRect.Bottom := p2.y - p1.y + 1; // Creamos un bitmap temporal bitmap := nil; try bitmap := TBitmap.Create; bitmap.Width := DstRect.Right; bitmap.Height := DstRect.Bottom; // Copiamos la parte seleccionada de la imagen bitmap.Canvas.CopyRect(DstRect, Imagen2.Canvas, SrcRect); // Copiamos la parte a la imagen auxiliar //imagen2.MBitmap.Assign(bitmap); with Printer do begin begindoc; //como mando una imagen a imprimir? canvas.StretchDraw(SrcRect,imagen2.MBitmap); enddoc; end; with Imagen2.Canvas.Pen do begin Style := psDot; Mode := pmXor; end; finally imagenaux.Free; bitmap.Free; end; end; procedure tform_img.Marcar(Bitmap: ILDocumentImage; Texto: String); var Marca: TBitmap; i,j: Integer; begin Marca:= TBitmap.Create; try Marca.Canvas.Brush.Color:= clBlack; Marca.Canvas.Font.Name:= 'Arial'; // Ajusta el tamaño de la fuente si es necesario Marca.Canvas.Font.Size:= 72; Marca.Canvas.Font.Color:= clGray; Marca.Canvas.Font.Style:= [fsBold, fsItalic]; Marca.Width:= Marca.Canvas.TextWidth(Texto); Marca.Height:= Marca.Canvas.TextHeight(Texto); Marca.Canvas.TextOut(0,0,Texto); i:= (Bitmap.Width - Marca.Width) div 2; j:= (Bitmap.Height - Marca.Height) div 2; Bitblt(Bitmap.Canvas.Handle,i,j,Marca.Width,Marca.Height, Marca.Canvas.Handle, 0, 0, SRCINVERT); finally //Marca.Free; end; end; procedure Tform_img.marca2MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin marca2.FocusControl.ScrollBy(x,y); end; procedure Tform_img.imagen2Click(Sender: TObject); begin //nose que va end; end. |
|
|
Temas Similares | ||||
Tema | Autor | Foro | Respuestas | Último mensaje |
Como Lograr el Efecto PopUp Menu del Messenger???? | AGAG4 | Varios | 10 | 02-01-2008 18:49:10 |
Coordenadas TWebBrowser | Delar | Varios | 2 | 03-11-2006 21:26:23 |
pasar coordenadas gps a coordenadas builder | iaav1 | C++ Builder | 3 | 03-07-2006 19:59:02 |
Como lograr el último ID insertado? | anavarro | Firebird e Interbase | 2 | 25-11-2004 16:22:42 |
como puedo lograr el total | alcides | SQL | 12 | 01-07-2004 17:52:13 |
|