Ridimensiona la tela attorno a una bitmap?

Question

prendere l'immagine di seguito userò per i seguenti esempi:

Le dimensioni unchaged sono attualmente 96 x 71

Diciamo che ho voluto ridimensionare la tela per 115 x 80 - l'immagine risultante dovrebbe quindi:

Infine se ridimensionato a una dimensione più piccola tela originale era, per esempio 45 x 45 l'uscita appare in questo modo:

Questo è quello che ho provato finora:

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; 

Se si prova quanto sopra su una bitmap caricata in una TImage la bitmap effettiva non si centra, tuttavia la tela cambia dimensione.

Le proprietà che ho impostato per l'Immagine sono:

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

penso che potrebbe essere la linea Dest.Offset(Bitmap.Width div 2, Bitmap.Height div 2); che ha bisogno di guardare, per calcolare la posizione centrale corretta?

Il codice è stato adattato/modificato leggermente da una domanda recente David Heffernan ha risposto.

Come ridimensionare la tela che circonda una bitmap, ma senza allungare la bitmap?

Answer 1

credo che questo è quello che stai cercando:

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; 

Non riesco a ricordare se XE supporta l'impostazione Width e Height per un TRect. In caso contrario, modificare il codice in

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

e così via.