Delphi - как обрезать растровое изображение «на месте»?

Если у меня есть TBitmap, и я хочу получить обрезанное изображение из этого растрового изображения, могу ли я выполнить операцию обрезки «на месте»? например если у меня есть растровое изображение размером 800x600, как я могу уменьшить (обрезать) его так, чтобы он содержал изображение 600x400 в центре, то есть полученный TBitmap равен 600x400 и состоит из прямоугольника, ограниченного (100, 100) и (700 , 500) в исходном изображении?Delphi - как обрезать растровое изображение «на месте»?

Нужно ли мне проходить через другое растровое изображение или выполнить эту операцию в исходном растровом изображении?

источник

2012-02-07 rossmcm

Вы можете использовать функцию BitBlt

попробуйте этот код.

procedure CropBitmap(InBitmap, OutBitMap : TBitmap; X, Y, W, H :Integer); 
begin 
    OutBitMap.PixelFormat := InBitmap.PixelFormat; 
    OutBitMap.Width := W; 
    OutBitMap.Height := H; 
    BitBlt(OutBitMap.Canvas.Handle, 0, 0, W, H, InBitmap.Canvas.Handle, X, Y, SRCCOPY); 
end;

и вы можете использовать таким образом

Var 
    Bmp : TBitmap; 
begin 
    Bmp:=TBitmap.Create; 
    try 
    CropBitmap(Image1.Picture.Bitmap, Bmp, 10,0, 150, 150); 
    //do something with the cropped image 
    //Bmp.SaveToFile('Foo.bmp'); 
    finally 
    Bmp.Free; 
    end; 
end;

Если вы хотите использовать один и тот же растровое изображение, попробуйте эту версию функции

procedure CropBitmap(InBitmap : TBitmap; X, Y, W, H :Integer); 
begin 
    BitBlt(InBitmap.Canvas.Handle, 0, 0, W, H, InBitmap.Canvas.Handle, X, Y, SRCCOPY); 
    InBitmap.Width :=W; 
    InBitmap.Height:=H; 
end;

И использовать таким образом

Var 
Bmp : TBitmap; 
begin 
    Bmp:=Image1.Picture.Bitmap; 
    CropBitmap(Bmp, 10,0, 150, 150); 
    //do somehting with the Bmp 
    Image1.Picture.Assign(Bmp); 
end;

источник

2012-02-07 20:52:52 RRUZ

Благодарим за это. Есть ли простой способ выполнить это без необходимости использования второго растрового изображения? Точно так же, как процедура 'Move' в Delphi обрабатывает перекрывающиеся исходники и адресаты, существует ли двумерный эквивалент? – rossmcm

Вы можете использовать Move с свойством ScanLine TBitmap, но вам придется вычислять размер байтов пикселей в зависимости от BitsPerPixel –

, чтобы проверить второй вариант, который использует только одно растровое изображение. – RRUZ

Я знаю, что у вас есть уже принятый ответ, но поскольку я написал свою версию (которая использует оболочку VCL вместо GDI-вызова), я отправлю ее здесь, а не просто отброшу.

procedure TForm1.FormClick(Sender: TObject); 
var 
    Source, Dest: TRect; 
begin 
    Source := Image1.Picture.Bitmap.Canvas.ClipRect; 
    { desired rectangle obtained by collapsing the original one by 2*2 times } 
    InflateRect(Source, -(Image1.Picture.Bitmap.Width div 4), -(Image1.Picture.Bitmap.Height div 4)); 
    Dest := Source; 
    OffsetRect(Dest, -Dest.Left, -Dest.Top); 
    { NB: raster data is preserved during the operation, so there is not need to have 2 bitmaps } 
    Image1.Picture.Bitmap.Canvas.CopyRect(Dest, Image1.Picture.Bitmap.Canvas, Source); 
    { and finally "truncate" the canvas } 
    Image1.Picture.Bitmap.Width := Dest.Right; 
    Image1.Picture.Bitmap.Height := Dest.Bottom; 
end;

источник

2012-02-07 22:00:04 OnTheFly

Delphi - как обрезать растровое изображение «на месте»?

ответ

Смежные вопросы