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:

• VLO Test Framework v2.0.0 build 347.rar (with data)

• Enlaces de interés:

Copy one image to another.
Stretching image.