Resize the canvas around a bitmap? - delphi

Question

Take the below image I will use for the following examples:
The dimensions unchaged are currently 96 x 71
Lets say I wanted to resize the canvas to 115 x 80 - the resulting image should then be:
Finally if I resized it to a smaller size than the original canvas was, eg 45 x 45 the output would appear like so:
This is what I have tried so far:
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;
If you try the above on a bitmap loaded into a TImage the actual bitmap does not center, the canvas does change size however.
The properties I have set for the Image are:
Image1.AutoSize := True;
Image1.Center := True;
Image1.Stretch := False;
I think it could be the line Dest.Offset(Bitmap.Width div 2, Bitmap.Height div 2); which needs looking at, to calculate the correct center position?
The code has been adapted/modified slightly from a recent question David Heffernan answered.
How do I resize the canvas that surrounds a bitmap, but without stretching the bitmap?

Answer 1

I think this is what you are looking for:
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;
I can't remember if XE supports setting Width and Height for a TRect. If not then change the code to
Source.Right := Source.Left + Min(W, Bitmap.Width);
and so on.