Resize a TBitmap quickly (Views: 33)
Problem/Question/Abstract: I would like to resize this bitmap (720 x 416), but really rapidly ( I must do 25 images/second). Could you tell me how I can do that ? Answer: Solve 1: This routine using TBitmap.Scanline was able to do the job in 0.25 seconds, on my celeron 466: procedure Squash(bmpS, bmpD: TBitmap); var scanlS, scanlD: Pointer; widthS, widthD: integer; yS, sInc, yD: integer; begin {assume correct size for bitmaps and assume pixelformat of 24bpp for both. These could be precomputed but it wouldnt save much time} widthS := integer(bmpS.Scanline[1]) - integer(bmpS.Scanline[0]); widthD := integer(bmpD.Scanline[1]) - integer(bmpD.Scanline[0]); {how many scanlines to move down in source, per dest scanline} sInc := (bmpS.Height shl 16) div bmpD.Height; scanlS := bmpS.Scanline[0]; scanlD := bmpD.Scanline[0]; yS := 0; for yD := 0 to bmpD.Height - 1 do begin {copy scanline} Move(scanlS^, scanlD^, bmpD.Width * 3); {assumes pf24bit} inc(yS, sInc); {move down whole number of scanlines} inc(integer(scanlS), widthS * (yS shr 16)); {and update yS to reflect the move} dec(yS, yS and $FFFF0000); inc(integer(scanlD), widthD); end; end; Solve 2: Here's a procedure for fast resizing: it is for 24bit pixel format only. procedure fastSmoothResize(var dst: TBitmap; NuWidth, NuHeight: integer); var x, y, xP, yP, yP2, xP2: Integer; Read, Read2: PByteArray; t, z, z2, iz2: Integer; pc: PBytearray; w1, w2, w3, w4: Integer; Col1r, col1g, col1b, Col2r, col2g, col2b: byte; src: TBitmap; begin src := TBitmap.create; src.pixelformat := pf24bit; {src.width := dst.width; src.height := dst.height; src.canvas.draw(0, 0, dst);} src.assign(dst); src.freeimage; dst.width := nuwidth; dst.height := nuheight; xP2 := ((src.Width - 1) shl 15) div Dst.Width; yP2 := ((src.Height - 1) shl 15) div Dst.Height; yP := 0; for y := 0 to Dst.Height - 1 do begin xP := 0; Read := src.ScanLine[yP shr 15]; if yP shr 16 < src.Height - 1 then Read2 := src.ScanLine[yP shr 15 + 1] else Read2 := src.ScanLine[yP shr 15]; pc := Dst.scanline[y]; z2 := yP and $7FFF; iz2 := $8000 - z2; for x := 0 to Dst.Width - 1 do begin t := xP shr 15; Col1r := Read[t * 3]; Col1g := Read[t * 3 + 1]; Col1b := Read[t * 3 + 2]; Col2r := Read2[t * 3]; Col2g := Read2[t * 3 + 1]; Col2b := Read2[t * 3 + 2]; z := xP and $7FFF; w2 := (z * iz2) shr 15; w1 := iz2 - w2; w4 := (z * z2) shr 15; w3 := z2 - w4; pc[x * 3 + 2] := (Col1b * w1 + Read[(t + 1) * 3 + 2] * w2 + Col2b * w3 + Read2[(t + 1) * 3 + 2] * w4) shr 15; pc[x * 3 + 1] := (Col1g * w1 + Read[(t + 1) * 3 + 1] * w2 + Col2g * w3 + Read2[(t + 1) * 3 + 1] * w4) shr 15; pc[x * 3] := (Col1r * w1 + Read2[(t + 1) * 3] * w2 + Col2r * w3 + Read2[(t + 1) * 3] * w4) shr 15; Inc(xP, xP2); end; Inc(yP, yP2); end; src.free; end; Solve 3: See the example below, which is a nice thumbnail generator and is quite fast, too. The src image is the original bitmap you want to downscale, dest is the bitmap to write the thumbnail into. Note: They must be 24 bit! Only downscaling is supported and only proportional. procedure MakeThumbNail(src, dest: TBitmap); type PRGB24 = ^TRGB24; TRGB24 = packed record B: Byte; G: Byte; R: Byte; end; TLine24 = array[0..MaxInt div SizeOf(TRGB24) - 1] of TRGB24; PLine24 = ^TLine24; var xscale, yscale: double; destY, destX: Integer; x1, x2, y1, y2: Integer; ix, iy: Integer; new_red, new_green, new_blue: Integer; totalRed, totalGreen, totalBlue: double; ratio: double; p: trgb24; pt1: pRGB24; ptrD, ptrS: integer; s1, s3: PLine24; i, j, x, y, r, g, b: integer; begin s1 := dest.ScanLine[0]; ptrD := integer(dest.ScanLine[1]) - integer(s1); s3 := src.ScanLine[0]; ptrS := integer(src.ScanLine[1]) - integer(s3); xscale := dest.Width / src.Width; yscale := dest.Height / src.Height; for y := 0 to dest.Height - 1 do begin y1 := Trunc(y / yscale); y2 := Trunc((y + 1) / yscale) - 1; for x := 0 to dest.Width - 1 do begin x1 := Trunc(x / xscale); x2 := Trunc((x + 1) / xscale) - 1; totalRed := 0; totalGreen := 0; totalBlue := 0; for iy := y1 to y2 do for ix := x1 to x2 do begin p := pRGB24(PtrS * iy + (ix * 3) + Integer(s3))^; totalRed := totalRed + p.R; totalGreen := totalGreen + p.G; totalBlue := totalBlue + p.B; end; ratio := 1 / (x2 - x1 + 1) / (y2 - y1 + 1); pt1 := pRGB24(PtrD * y + (x * 3) + Integer(s1)); pt1.R := Round(totalRed * ratio); pt1.G := Round(totalGreen * ratio); pt1.B := Round(totalBlue * ratio); end; end; end; Solve 4: { ... } type TRGBArray = array[0..32767] of TRGBTriple; pRGBArray = ^TRGBArray; procedure TForm1.SmoothResize(abmp: TBitmap; NuWidth, NuHeight: Integer); var xscale, yscale: Single; sfrom_y, sfrom_x: Single; ifrom_y, ifrom_x: Integer; to_y, to_x: Integer; weight_x, weight_y: array[0..1] of Single; weight: Single; new_red, new_green: Integer; new_blue: Integer; total_red, total_green: Single; total_blue: Single; ix, iy: Integer; bTmp: TBitmap; sli, slo: pRGBArray; begin abmp.PixelFormat := pf24bit; bTmp := TBitmap.Create; bTmp.PixelFormat := pf24bit; bTmp.Width := NuWidth; bTmp.Height := NuHeight; xscale := bTmp.Width / (abmp.Width - 1); yscale := bTmp.Height / (abmp.Height - 1); for to_y := 0 to bTmp.Height - 1 do begin sfrom_y := to_y / yscale; ifrom_y := Trunc(sfrom_y); weight_y[1] := sfrom_y - ifrom_y; weight_y[0] := 1 - weight_y[1]; for to_x := 0 to bTmp.Width - 1 do begin sfrom_x := to_x / xscale; ifrom_x := Trunc(sfrom_x); weight_x[1] := sfrom_x - ifrom_x; weight_x[0] := 1 - weight_x[1]; total_red := 0.0; total_green := 0.0; total_blue := 0.0; for ix := 0 to 1 do begin for iy := 0 to 1 do begin sli := abmp.Scanline[ifrom_y + iy]; new_red := sli[ifrom_x + ix].rgbtRed; new_green := sli[ifrom_x + ix].rgbtGreen; new_blue := sli[ifrom_x + ix].rgbtBlue; weight := weight_x[ix] * weight_y[iy]; total_red := total_red + new_red * weight; total_green := total_green + new_green * weight; total_blue := total_blue + new_blue * weight; end; end; slo := bTmp.ScanLine[to_y]; slo[to_x].rgbtRed := Round(total_red); slo[to_x].rgbtGreen := Round(total_green); slo[to_x].rgbtBlue := Round(total_blue); end; end; abmp.Width := bTmp.Width; abmp.Height := bTmp.Height; abmp.Canvas.Draw(0, 0, bTmp); bTmp.Free; end; Solve 5: Try this routine. I've used it for resizing a large number of bitmaps, and it worked pretty well for me. This preserves the aspect ratio of the bitmap, too. function GetScaledCenteredBitmap(aFilename: string; maxWidth, maxHeight: integer): TBitmap; var bmp, sbmp: TBitmap; scaledWidth, scaledHeight: integer; begin scaledWidth := 0; scaledHeight := 0; bmp := TBitmap.Create; sbmp := TBitmap.Create; bmp.LoadFromFile(aFilename); if bmp.Width > bmp.Height then begin scaledHeight := trunc(maxWidth * bmp.Height / bmp.Width); scaledWidth := maxWidth; end else if bmp.Height > bmp.Width then begin scaledWidth := trunc(maxHeight * bmp.Width / bmp.Height); scaledHeight := maxHeight; end; sbmp.Width := maxWidth; sbmp.Height := maxHeight; sbmp.Canvas.Brush.Color := clBlack; sbmp.Canvas.FillRect(Bounds(0, 0, maxWidth, maxHeight)); sbmp.Canvas.StretchDraw(Bounds(maxWidth div 2 - scaledWidth div 2, maxHeight div 2 - scaledHeight div 2, scaledWidth, scaledHeight), bmp); result := sbmp; bmp.Free; end; Answer 6: This is a modification of Answer 4 and is about three times faster: procedure SmoothResize2(abmp: TBitmap; NuWidth, NuHeight: integer); var xscale, yscale: Single; sfrom_y, sfrom_x: Single; ifrom_y, ifrom_x: Integer; to_y, to_x: Integer; weight_x, weight_y: array[0..1] of Single; weight: Single; new_red, new_green: Integer; new_blue: Integer; total_red, total_green: Single; total_blue: Single; ix, iy: Integer; bTmp: TBitmap; sli, slo: pRGBArray; {pointers for scanline access} liPByte, loPByte, p: PByte; {offset increment} liSize, loSize: integer; begin abmp.PixelFormat := pf24bit; bTmp := TBitmap.Create; bTmp.PixelFormat := pf24bit; bTmp.Width := NuWidth; bTmp.Height := NuHeight; xscale := bTmp.Width / (abmp.Width - 1); yscale := bTmp.Height / (abmp.Height - 1); liPByte := abmp.Scanline[0]; liSize := integer(abmp.Scanline[1]) - integer(liPByte); loPByte := bTmp.Scanline[0]; loSize := integer(bTmp.Scanline[1]) - integer(loPByte); for to_y := 0 to bTmp.Height - 1 do begin sfrom_y := to_y / yscale; ifrom_y := Trunc(sfrom_y); weight_y[1] := sfrom_y - ifrom_y; weight_y[0] := 1 - weight_y[1]; for to_x := 0 to bTmp.Width - 1 do begin sfrom_x := to_x / xscale; ifrom_x := Trunc(sfrom_x); weight_x[1] := sfrom_x - ifrom_x; weight_x[0] := 1 - weight_x[1]; total_red := 0.0; total_green := 0.0; total_blue := 0.0; for ix := 0 to 1 do begin for iy := 0 to 1 do begin p := liPByte; Inc(p, liSize * (ifrom_y + iy)); sli := pRGBArray(p); new_red := sli[ifrom_x + ix].rgbtRed; new_green := sli[ifrom_x + ix].rgbtGreen; new_blue := sli[ifrom_x + ix].rgbtBlue; weight := weight_x[ix] * weight_y[iy]; total_red := total_red + new_red * weight; total_green := total_green + new_green * weight; total_blue := total_blue + new_blue * weight; end; end; p := loPByte; Inc(p, loSize * to_y); slo := pRGBArray(p); slo[to_x].rgbtRed := Round(total_red); slo[to_x].rgbtGreen := Round(total_green); slo[to_x].rgbtBlue := Round(total_blue); end; end; abmp.Width := bTmp.Width; abmp.Height := bTmp.Height; abmp.Canvas.Draw(0, 0, bTmp); bTmp.Free; end; |