ScaleHalf

This takes an image and scales it to one-fourth its original size (one half on each dimension); works best if the original dimensions are even, otherwise an extra row of pixels might be ignored. Only 32-bit colour supported, since it's much easier (I can just grab a whole uInteger at a time from the buffer, rather than trying to figure out the individual r, g, and b components byte-by-byte - and don't even think about 16-bit, too darned complicated. I'm not an assembly wizard, sorry!)

The example program loads two 800x600x32 images (named "img.bmp" and "test.bmp" - if you've tried my Special FX objects you can use the same images) and scales them down one or more times (it asks how many times you want it to repeat the procedure - anything higher than 9 is unnoticeable, though).

Code: Select All | Copy To Clipboard

#Include Once "fbgfx.bi"

Function scalehalf (origImg As FB.Image Ptr) As FB.Image Ptr

'If the image isn't 32-bit, forget it
If origImg->Bpp <> 4 Then Return 0

'Get width and height of original image
Dim As uInteger w = origImg->Width, h = origImg->Height

'If they're too small, exit
If w = 1 Then Return 0
If h = 1 Then Return 0

'Second image will be first divided by two; shifting is always faster than dividing, and it does the same thing
Dim As uInteger nw = w Shr 1, nh = h Shr 1

'Create the second image
Dim As FB.Image Ptr newimg = ImageCreate(nw, nh, 0, 32)

'Get pointers directly to the image data
Dim As uInteger Ptr origPixels = CPtr(uInteger Ptr, origImg + 1)
Dim As uInteger Ptr newPixels = CPtr(uInteger Ptr, newImg + 1)

'Pixel values of every four pixels
Dim As uInteger p1, p2, p3, p4

'Totals for Alpha/Green and Red/Blue (calculated simultaneously for higher speed)
Dim As uInteger agTotal, rbTotal

'Amount to add to the integer pointer each time - divide the pitch by four to get
'uIntegers per line (pitch = bytes per line, uInteger = 4 bytes - addo is Shr 1 instead because
'it needs to be Shl 1 later, this way we don't need to do it inside the loop (don't ask me why
'this is the case, I can't remember)
Dim As uInteger addo = (origImg->Pitch) Shr 1, addn = (newimg->Pitch) Shr 2

'For each row
For y As uInteger = 0 To (nh-1)
'For each column
For x As uInteger = 0 To (nw-1)
'Get the first two pixels - we multiply by 2 (that's what Shl 1 does) because the original image
'has two pixels in each dimension for every one the destination image has
p1 = origPixels[(x Shl 1)]
p2 = origPixels[(x Shl 1)+1]

'If the second two are outside of the image, just use the first two again
If y >= nh-1 Then
p3 = origPixels[(x Shl 1)]
p4 = origPixels[(x Shl 1)+1]
Else
p3 = origPixels[(x Shl 1)+(addo)]
p4 = origPixels[(x Shl 1)+(addo)+1]
End If

'We calculate red and blue together - since they're a byte apart each, they cannot possibly mix
'This is faster than the other way.
rbTotal = (p1 And &hff00ff) + (p2 And &hff00ff) + (p3 And &hff00ff) + (p4 And &hff00ff)
'Take the average
rbTotal Shr= 2
'And throw out the carry bits, keeping only the bits in their proper range
rbTotal And= &hff00ff

'Now calculate green and alpha together; this one we have to shift over 8 bits or else alpha might
'overflow through the top
agTotal = ((p1 And &hff00ff00) Shr 8) + ((p2 And &hff00ff00) Shr 8) + ((p3 And &hff00ff00) Shr 8) + ((p4 And &hff00ff00) Shr 8)
'Get average
agTotal Shr= 2
'Once again throw out the carry bits
agTotal And= &hff00ff
'And shift it back up 8 bits to where it was before
agTotal Shl= 8

'Add the two results together to get the new pixel value
newPixels[x] = rbTotal + agTotal
Next x

'Add the correct amount to each pointer
origPixels += addo
newPixels += addn
Next y
Return newimg
End Function

Sub scaleDraw (todraw As FB.Image Ptr, x As Integer = 0, y As Integer = 0, times As uInteger = 1)
Dim As FB.Image Ptr newimg = 0, img2 = 0

If times = 0 Then
Put (x, y), todraw
Exit Sub
EndIf

newimg = scalehalf(todraw)

If times > 1 Then
While times > 1
times -= 1
img2 = scalehalf(newimg)
If img2 = 0 Then Exit While
Swap newimg, img2
ImageDestroy(img2)
img2 = 0
Wend
End If

If newimg <> 0 Then Put (x, y), newimg, PSet

ImageDestroy(newimg)
If img2 <> 0 Then ImageDestroy(img2)
End Sub

Sub loadDraw (fname As String, x As Integer = 0, y As Integer = 0, times As uInteger = 1)
Dim As FB.Image Ptr myimg = ImageCreate(800, 600, 0, 32)
BLoad fname, myimg

scaleDraw(myimg, x, y, times)

ImageDestroy(myimg)
End Sub

Dim As Single t0
Dim As Single t1

Dim As uInteger ntimes

Print "How many times shall I scale the images down?"
Input ntimes

ScreenRes 800, 600, 32

t0 = timer

loadDraw("test.bmp", 0, 0, ntimes)
loadDraw("img.bmp", 400, 0, ntimes)

t1 = Timer

Draw String (0, 500), "Quarter-scaled two 800x600 images " + Str(ntimes) + " times in " + Str(t1-t0) + " seconds."

Sleep

End

Half of that's just the example program; if you want to scale your images in half you only need the sub scaleHalf() function which takes an image buffer pointer and returns an image buffer pointer (doesn't modify the original). The whole thing's well-commented, though likely if you don't have a good understanding of fbgfx none of it will make sense to you. Suffice to say that if you have an image buffer myimg and you want to make it a quarter of its total size, then draw it, you would do it like this:

Code: Select All | Copy To Clipboard

Dim As FB.Image Ptr newimg = scalehalf(myimg)

Put (0, 0), myimg

And that's all you need to know!

Enjoy, and I wouldn't mind getting some feedback, comments, errata, etc.