Wednesday, 22 April 2009

Añadir texto a una imagen mediante un TPaintBox y guardar el resultado en Bmp o Jpeg con Delphi 2009

Hoy me he encontrado con un pequeño problema que me ha comentado un compañero sobre coger una imagen y escribirle un texto encima automáticamente, y luego volver a guardar el resultado. La solución que propongo es bastante sencilla, y nos la podemos implementar nosotros mismos sin tener que recorrer a aplicaciones de terceros mediante unos componentes muy sencillos en Delphi 2009. La razón de hacerlo automáticamente es porque luego puede ser que la imagen provenga de una cámara y queremos guardar la fecha en que se creo dicha imagen, pero incrustandola encima de la imagen.

Un ejemplo de imagen seria el siguiente:

Lo que hago es cargar la imagen en un TPicture, y luego cargo la parte gráfica de este dentro de un TPaintBox. Mediante su canvas, puedo modificar la visualización de la imagen, y añadir texto y otras imágenes modificando sus propiedades.

Luego simplemente hago un barrido de la imagen para meterlo dentro de un TBitmap, y en el caso que quiera guardarlo en Jpeg, tengo una pequeña función que me permite hacer la conversión de Bmp a Jpeg con un pequeño fichero temporal que luego elimino. La aplicación es bastante "xorra", pero sirve para lo que quería.

Aquí os dejo parte del código, que seguro que a alguien le será de utilidad:




procedure TForm2.LoadImage();
var
c: TPicture;
s: string;
begin
c := TPicture.Create;
s := DateTimeToStr(now);
C.LoadFromFile(sfile);
PaintBox1.Canvas.Draw(0, 0, C.Graphic);
PaintBox1.Canvas.Font.Size := 20;
PaintBox1.Canvas.Font.color := clWhite;
PaintBox1.Canvas.Brush.color := clBlack;
PaintBox1.Canvas.TextOut(0, c.Height - 35, 'This image is a Box Test');
PaintBox1.Canvas.TextOut(0, c.Height - 65, s);
end;

procedure TForm2.Button2Click(Sender: TObject);
var
Bitmap: TBitmap;
Source: TRect;
Dest: TRect;
sPath: string;
i: integer;
begin
SaveDialog1.Execute(self.Handle);
for i := 0 to SaveDialog1.Files.Count - 1 do
begin
sPath := SaveDialog1.Files.Strings[i];
end;
if sPath <> '' then
begin
LoadImage();
Bitmap := TBitmap.Create;
try
with Bitmap do
begin
Width := PaintBox1.Width;
Height := PaintBox1.Height;
Dest := Rect(0, 0, Width, Height);
end;
with PaintBox1 do
Source := Rect(0, 0, Width, Height);
Bitmap.Canvas.CopyRect(Dest, PaintBox1.Canvas, Source);
Bitmap.SaveToFile(sPath);
finally
Bitmap.Free;
end;
end;
end;

function TForm2.BMPtoJPG(var BMPpic, JPGpic: string): boolean;
var
Bitmap: TBitmap;
JpegImg: TJpegImage;
begin
Result := False;
Bitmap := TBitmap.Create;
try
Bitmap.LoadFromFile(BMPpic);
JpegImg := TJpegImage.Create;
try
JpegImg.Assign(Bitmap);
JpegImg.SaveToFile(JPGpic);
Result := True;
finally
JpegImg.Free
end;
finally
Bitmap.Free
end;
end;





Además os dejo también la aplicación que he generado: ThundaxWriteImage.exe

0 comments:

Post a Comment