Lograr coordenadas de imagen.

[[Lepe]]

Aquí tienes la solución.

Saludos

[Besto]

Gracias, voy a probarlo.

[Natucha]

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.