Измените размер холста вокруг растрового изображения?

Question

Возьмите под изображением я буду использовать для следующих примеров:

Размеры unchaged в настоящее время 96 x 71

Позволяет сказать, что я хотел, чтобы изменить размер холста, чтобы 115 x 80 - результирующее изображение должно затем:

Наконец, если я изменить размер его меньшего размера, чем оригинал холст был, например, 45 x 45 выход будет выглядеть так:

Это то, что я пытался до сих пор:

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; 

Если вы попробуете приведенное выше на растровом изображении, загруженном в TImage, фактическое растровое изображение не центрируется, холст действительно меняет размер.

Свойства Я набор для изображения являются:

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

Я думаю, что это может быть линия Dest.Offset(Bitmap.Width div 2, Bitmap.Height div 2);, которая нуждается глядя, чтобы вычислить правильное положение центра?

Код был адаптирован/изменен немного из недавнего вопроса, на который ответил Дэвид Хеффернан.

Как изменить размер холста, окружающего растровое изображение, но не растягивая растровое изображение?

Answer 1

Я думаю, что это то, что вы ищете:

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; 

Я не могу вспомнить, если XE поддерживает настройки Width и Height для TRect. Если нет, то смените код на

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

и так далее.