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

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

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.

Aquí tienes la solución.

Saludos

Gracias, voy a probarlo.

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.