PDA

View Full Version : image resizing, optimize

tux
23-09-2003, 04:10 PM
hi, i found this code liying around:

procedure ResizeBitmap(imgo, imgd: TBitmap; nw, nh: Integer);
var
xini, xfi, yini, yfi, saltx, salty: single;
x, y, px, py, tpix: integer;
PixelColor: TColor;
r, g, b: longint;

function MyRound(const X: Double): Integer;
begin
Result := Trunc(x);
if Frac(x) >= 0.5 then
if x >= 0 then Result := Result + 1
else
Result := Result - 1;
//Result := Trunc(X + (-2 * Ord(X < 0) + 1) * 0.5);
end;

begin
// Set target size

imgd.Width := nw;
imgd.Height := nh;

// Calcs width & height of every area of pixels of the source bitmap

saltx := imgo.Width / nw;
salty := imgo.Height / nh;

yfi := 0;
for y := 0 to nh - 1 do
begin
// Set the initial and final Y coordinate of a pixel area

yini := yfi;
yfi := yini + salty;
if yfi >= imgo.Height then yfi := imgo.Height - 1;

xfi := 0;
for x := 0 to nw - 1 do
begin
// Set the inital and final X coordinate of a pixel area

xini := xfi;
xfi := xini + saltx;
if xfi >= imgo.Width then xfi := imgo.Width - 1;

// This loop calcs del average result color of a pixel area
// of the imaginary grid

r := 0;
g := 0;
b := 0;
tpix := 0;

for py := MyRound(yini) to MyRound(yfi) do
begin
for px := MyRound(xini) to MyRound(xfi) do
begin
Inc(tpix);
PixelColor := ColorToRGB(imgo.Canvas.Pixels[px, py]);
r := r + GetRValue(PixelColor);
g := g + GetGValue(PixelColor);
b := b + GetBValue(PixelColor);
end;
end;

// Draws the result pixel

imgd.Canvas.Pixels[x, y] :=
rgb(MyRound(r / tpix),
MyRound(g / tpix),
MyRound(b / tpix)
);
end;
end;
end;

and its kinda reall slow, so does anyone know how to do scanline instead of direct pixle?

Harry Hunt
23-09-2003, 10:33 PM
Scanline is no big deal really. All you need to remember is that when using scanlines, the pixel format is important.

Here's an example:

const
MaxPixelCount = 65536; // Change this if necessary

type
TRGBArray = array&#91;0..MaxPixelCount - 1&#93; of TRGBTriple;
pRGBArray = ^TRGBArray;

var
I, J&#58; Integer;
Row&#58; pRGBArray;
begin
Bitmap &#58;= TBitmap.Create;
Bitmap.Width &#58;= 400;
Bitmap.Height &#58;= 300;
Bitmap.PixelFormat &#58;= pf24Bit; // 1 Byte per color
for J &#58;= 0 to Bitmap.Height - 1 do
begin
Row &#58;= Bitmap.ScanLine&#91;J&#93;;
for I &#58;= 0 to Bitmap.Width - 1 do
begin
Row&#91;I&#93;.rgbtRed &#58;= Random&#40;256&#41;;
Row&#91;I&#93;.rgbtGreen &#58;= Random&#40;256&#41;;
Row&#91;I&#93;.rgbtBlue &#58;= Random&#40;256&#41;;
end;
end;
end;

This example should generate some random color noise but I think it illustrates quite well how to access individual pixels using scanlines. Make sure that the color values you assign to rgbtRed, Green and Blue are between 0 and 255. You will get some really funky results if your values are either too large or too small.

Alimonster
24-09-2003, 09:57 PM
I could rewrite it to use Scanline tomorrow if you want (not tonight unfortunately - been a hectic week).

EDIT: as a thought, Anders Melander (cool Delphi dude who wrote a gif component, maybe called TGifImage) has a zip somewhere out there that deals with this - it's called resample.zip or something like that. Sorry about being hazy on the details but his site has been down for a while, unfortunately (his life got too busy to maintain it IIRC from news://borland.public.graphics). It's meant to be quite good if you {\$DEFINE USE_SCANLINE} or something like that. Umm, maybe this vague info will be helpful, though it may involve more than a little hunting around :?

Alimonster
29-09-2003, 09:00 AM
Aaah! Here's another example of me forgetting about things! Sigh. By "tomorrow", of course, I meant "quite a few days from the time of that post".

Whoops. It'll get rewritten soon-ish if you still want that, dUmAsS. In my defence, it's been a busy few days (and I have a promotion interview on Wednesday, so hopefully once that's done things will get quiet again).

tux
29-09-2003, 01:40 PM
hi, thanks man :)

no problems, ive been busy myself. and it involves a suprise car on my bday yay :shock: :D :D :D

tux
01-11-2003, 11:48 PM
um, i tryed myself but failed missrebly :) (scanline index out of range)

heres the code

procedure ResizeBitmapNew&#40;imgo, imgd&#58; TBitmap; nw, nh&#58; Integer&#41;;
const
MaxPixelCount = 65536; // Change this if necessary

type
TRGBArray = array&#91;0..MaxPixelCount - 1&#93; of TRGBTriple;
pRGBArray = ^TRGBArray;

var
Row&#58; pRGBArray;

var
xini, xfi, yini, yfi, saltx, salty&#58; single;
x, y, px, py, tpix&#58; integer;
PixelColor&#58; TColor;
r, g, b&#58; longint;

function MyRound&#40;const X&#58; Double&#41;&#58; Integer;
begin
Result &#58;= Trunc&#40;x&#41;;
if Frac&#40;x&#41; >= 0.5 then
if x >= 0 then Result &#58;= Result + 1
else
Result &#58;= Result - 1;
//Result &#58;= Trunc&#40;X + &#40;-2 * Ord&#40;X < 0&#41; + 1&#41; * 0.5&#41;;
end;

begin
// Set target size

imgd.Width &#58;= nw;
imgd.Height &#58;= nh;

// Calcs width & height of every area of pixels of the source bitmap

saltx &#58;= imgo.Width / nw;
salty &#58;= imgo.Height / nh;

yfi &#58;= 0;
for y &#58;= 0 to nh - 1 do
begin
Row &#58;= imgd.ScanLine&#91;y&#93;;

// Set the initial and final Y coordinate of a pixel area

yini &#58;= yfi;
yfi &#58;= yini + salty;
if yfi >= imgo.Height then yfi &#58;= imgo.Height - 1;

xfi &#58;= 0;
for x &#58;= 0 to nw - 1 do
begin
// Set the inital and final X coordinate of a pixel area

xini &#58;= xfi;
xfi &#58;= xini + saltx;
if xfi >= imgo.Width then xfi &#58;= imgo.Width - 1;

// This loop calcs del average result color of a pixel area
// of the imaginary grid

r &#58;= 0;
g &#58;= 0;
b &#58;= 0;
tpix &#58;= 0;

for py &#58;= MyRound&#40;yini&#41; to MyRound&#40;yfi&#41; do
begin
for px &#58;= MyRound&#40;xini&#41; to MyRound&#40;xfi&#41; do
begin
Inc&#40;tpix&#41;;
PixelColor &#58;= ColorToRGB&#40;imgo.Canvas.Pixels&#91;px, py&#93;&#41;;
r &#58;= r + GetRValue&#40;PixelColor&#41;;
g &#58;= g + GetGValue&#40;PixelColor&#41;;
b &#58;= b + GetBValue&#40;PixelColor&#41;;
end;
end;

// Draws the result pixel

Row&#91;x&#93;.rgbtRed &#58;= MyRound&#40;r / tpix&#41;;
Row&#91;x&#93;.rgbtGreen &#58;= MyRound&#40;g / tpix&#41;;
Row&#91;x&#93;.rgbtBlue &#58;= MyRound&#40;b / tpix&#41;;

&#123; imgd.Canvas.Pixels&#91;x, y&#93; &#58;=
rgb&#40;MyRound&#40;r / tpix&#41;,
MyRound&#40;g / tpix&#41;,
MyRound&#40;b / tpix&#41;
&#41;; &#125;
end;
end;
end;

as you can see im crap at image work :)

Harry Hunt
02-11-2003, 06:52 AM
You need to do Bitmap.PixelFormat := pf24Bit; with all your bitmaps...
Also, make sure that the values you assign to rgtbRed,... never get larger than 255 or smaller than 0 or you'll get really weird results.