Stretching an image

Muchas aplicaciones disponen de una pequeña previsualización de sus documentos, de ésta manera echando un vistazo a su preview o thumbnail nos podemos hacer una idea de que documento o proyecto hay dentro de ese fichero. El problema me vino a la mente cuando trabajando en mi proyecto (VLO) me di cuenta de que había hecho más de 20 proyectos y ya ni me acordaba que había en cada uno de ellos, y claro la única solución es abrir cada uno de los documentos hasta encontrar el proyecto que querías abrir.

La solución que propongo aún está muy verde pero es una solución que de momento va bien y que permite obtener la imagen del documento que se está editando sobre el canvas, recortar la parte útil y redimensionarla para que luego podamos mostrarla en el preview de la carga de proyectos.

Para daros una idea, éste es el resultado de aplicar un algoritmo de Stretching sobre un bitmap:

El código fuente aplicado para el Stretching es el siguiente:


procedure TBoxManager.Save(Project: String);
function ResizeBmp(bitmp: TBitmap; wid, hei: Integer): Boolean;
var
TmpBmp: TBitmap;
ARect: TRect;
begin
Result := false;
try
TmpBmp := TBitmap.Create;
try
TmpBmp.width := wid;
TmpBmp.height := hei;
ARect := Rect(0, 0, wid, hei);
TmpBmp.Canvas.StretchDraw(ARect, bitmp);
bitmp.Assign(TmpBmp);
finally
TmpBmp.Free;
end;
Result := true;
except
Result := false;
end;
end;

var
i: Integer;
p1, p2: TPoint;
image2: TImage;
begin
p1 := Point(9999, 9999);
p2 := Point(0, 0);
for i := 0 to Boxlist.Count - 1 do
begin
if Boxlist[i].Vertex1.X < p1.X then
p1.X := Boxlist[i].Vertex1.X;
if Boxlist[i].Vertex1.Y < p1.Y then
p1.Y := Boxlist[i].Vertex1.Y;
if Boxlist[i].Vertex2.X > p2.X then
p2.X := Boxlist[i].Vertex2.X;
if Boxlist[i].Vertex2.Y > p2.Y then
p2.Y := Boxlist[i].Vertex2.Y;
end;

if (p1.X <> 9999) and (p1.Y <> 9999) and (p2.X <> 0) and (p2.Y <> 0) then
begin
image2 := TImage.Create(Self);
image2.Canvas.CopyRect(Rect(0, 0, image2.width, image2.height), FCanvas, Rect(p1.X, p1.Y, p2.X, p2.Y));
ResizeBmp(image2.Picture.Bitmap, 150, 120);
image2.Picture.SaveToFile(Project + '\preview.bmp');
FreeAndNil(image2);
end;
end;


Y para la carga de la imagen:


procedure TfrmLoad.ListBox1Click(Sender: TObject);
var
loadImage: string;
begin
loadImage := ExtractFilePath(ParamStr(0)) + 'files\';
loadImage := loadImage + ListBox1.Items[ListBox1.ItemIndex];
loadImage := loadImage + '.tbm';
if FileExists(loadImage + '\preview.bmp') then
begin
drawRectangle(clwhite, clwhite);
Image1.Picture.LoadFromFile(loadImage + '\preview.bmp')
end
else
begin
drawRectangle(clwhite, clwhite);
end;
end;


como podéis ver, no tiene ningún misterio. Ahora lo que hay que conseguir es poder conseguir una mayor calidad en el thumbnail evitando éste pixelado que queda.

Podéis descargar la última versión de la plataforma para comprobar los resultados:
  • Enlaces de interés:
Copy one image to another.
Stretching image.

Comments

Popular Posts