Cambiar el tamaño del lienzo alrededor de un mapa de bits?

Question

tomar la imagen a continuación voy a utilizar para los siguientes ejemplos:

Las dimensiones unchaged Actualmente 96 x 71

digamos que quería cambiar el tamaño del lienzo para 115 x 80 - la imagen resultante debe entonces sea:

Finalmente si cambia el tamaño a un tamaño más pequeño que el lienzo original, por ejemplo 45 x 45 la salida podría parecer así:

Esto es lo que he probado hasta ahora:

procedure ResizeBitmapCanvas(Bitmap: TBitmap; H, W: Integer); 
var 
    Bmp: TBitmap; 
    Source, Dest: TRect; 
begin 
    Bmp := TBitmap.Create; 
    try 
    Source := Rect(0, 0, Bitmap.Width, Bitmap.Height); 
    Dest := Source; 
    Dest.Offset(Bitmap.Width div 2, Bitmap.Height div 2); 
    Bitmap.SetSize(W, H); 
    Bmp.Assign(Bitmap); 
    Bmp.Canvas.FillRect(Source); 
    Bmp.Canvas.CopyRect(Dest, Bitmap.Canvas, Source); 
    Bitmap.Assign(Bmp); 
    finally 
    Bmp.Free; 
    end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
    ResizeBitmapCanvas(Image1.Picture.Bitmap, 110, 110); 
end; 

Si prueba lo anterior en un mapa de bits cargado en un TImage, el mapa de bits real no se centra, sin embargo, el lienzo cambia de tamaño.

Las propiedades he puesto por la imagen son:

Image1.AutoSize := True; 
Image1.Center := True; 
Image1.Stretch := False; 

creo que podría ser la línea Dest.Offset(Bitmap.Width div 2, Bitmap.Height div 2); que necesita mirar, para calcular la posición central correcta?

El código ha sido adaptado/modificado ligeramente de una pregunta reciente respondida por David Heffernan.

¿Cómo cambio el tamaño del lienzo que rodea un mapa de bits, pero sin estirar el mapa de bits?

Answer 1

creo que esto es lo que busca:

procedure ResizeBitmapCanvas(Bitmap: TBitmap; H, W: Integer; BackColor: TColor); 
var 
    Bmp: TBitmap; 
    Source, Dest: TRect; 
    Xshift, Yshift: Integer; 
begin 
    Xshift := (Bitmap.Width-W) div 2; 
    Yshift := (Bitmap.Height-H) div 2; 

    Source.Left := Max(0, Xshift); 
    Source.Top := Max(0, Yshift); 
    Source.Width := Min(W, Bitmap.Width); 
    Source.Height := Min(H, Bitmap.Height); 

    Dest.Left := Max(0, -Xshift); 
    Dest.Top := Max(0, -Yshift); 
    Dest.Width := Source.Width; 
    Dest.Height := Source.Height; 

    Bmp := TBitmap.Create; 
    try 
    Bmp.SetSize(W, H); 
    Bmp.Canvas.Brush.Style := bsSolid; 
    Bmp.Canvas.Brush.Color := BackColor; 
    Bmp.Canvas.FillRect(Rect(0, 0, W, H)); 
    Bmp.Canvas.CopyRect(Dest, Bitmap.Canvas, Source); 
    Bitmap.Assign(Bmp); 
    finally 
    Bmp.Free; 
    end; 
end; 

No puedo recordar si XE permite fijar Width y Height para un TRect. Si no, cambie el código a

Source.Right := Source.Left + Min(W, Bitmap.Width); 

y así sucesivamente.