So I decided to write my own image scaler, and am pleased to have coded this without using anyone else's algorithms. :-) The program is too slow to be used in real-time, but, for example, it could be used in a game, before the level is loaded, to downsize a graphic, and then be rotated and displayed in real-time by Multiput. The end result will look better if the graphics are scaled with this program, especially if rotation is unnecessary, and Multiput can be avoided altogether. (But Multiput is still a great tool. :-))

This program uses pixel blending, so for example, if an image is scaled to 50%, each pixel in the downscaled image will have the average color of four pixels in the original image. The code can also upscale images, but it is not quite as good as Photoshop until I learn bi-cubic re-sampling. :-P

BTW, this is the first time I have used the FB namespace, the "->" syntax, and overloaded Subs. :-D

Code: Select all

`' Image Scaler! v1.0`

' (C) 2007 i-TECH and Kristopher Windsor

#include "fbgfx.bi"

#define float double

#define cfloat cdbl

Sub image_scaler Overload (Byval target As fb.image Ptr, Byval x As Integer = 0, Byval y As Integer = 0, Byval source As fb.image Ptr, Byval scale As float)

Dim As Integer dest_size_x, dest_size_y

Dim As Integer dest_loop_x, dest_loop_y

Dim As Integer srce_size_x, srce_size_y

Dim As Integer srce_loop_x, srce_loop_y

Dim As Integer srce_color

Dim As float red, green, blue

Dim As float x1, y1, x2, y2, overlap_factor, total_pixels

Dim As float overlap_1, overlap_2, overlap_3, overlap_4, overlap_5, overlap_6 'temp variables to see how much of a certain source pixel overlaps a destination pixel

srce_size_x = source -> Width

srce_size_y = source -> height

dest_size_x = srce_size_x * scale

dest_size_y = srce_size_y * scale

'loop for each destination pixel

For dest_loop_x = 0 To dest_size_x - 1

For dest_loop_y = 0 To dest_size_y - 1

'find the source pixels under this destination pixel

x1 = cfloat(dest_loop_x) / dest_size_x * srce_size_x - .5

x2 = cfloat(dest_loop_x + 1) / dest_size_x * srce_size_x - .5

y1 = cfloat(dest_loop_y) / dest_size_y * srce_size_y - .5

y2 = cfloat(dest_loop_y + 1) / dest_size_y * srce_size_y - .5

'loop through all of the source pixels under this destination pixel to get the average color

red = 0: green = 0: blue = 0: total_pixels = 0

For srce_loop_x = x1 To x2

For srce_loop_y = y1 To y2

'the following can be replaced with 'overlap_factor = 1,' but it will be slightly less accurate (especially in the last row and column)

'overlaps 1, 2: location of destination pixel; 3, 4: part of source pixel under destination pixel; 5, 6: location of source pixel

'x overlap factor

overlap_1 = cfloat(dest_loop_x) / dest_size_x

overlap_2 = cfloat(dest_loop_x + 1) / dest_size_x

overlap_3 = cfloat(srce_loop_x) / srce_size_x

overlap_4 = cfloat(srce_loop_x + 1) / srce_size_x

overlap_5 = overlap_3

overlap_6 = overlap_4

If overlap_3 < overlap_1 Or overlap_3 > overlap_2 Then overlap_3 = Iif(Abs(overlap_3 - overlap_1) < Abs(overlap_3 - overlap_2), overlap_1, overlap_2)

If overlap_4 < overlap_1 Or overlap_4 > overlap_2 Then overlap_4 = Iif(Abs(overlap_4 - overlap_1) < Abs(overlap_4 - overlap_2), overlap_1, overlap_2)

overlap_factor = Abs((overlap_3 - overlap_4) / (overlap_5 - overlap_6))

'y overlap factor

overlap_1 = cfloat(dest_loop_y) / dest_size_y

overlap_2 = cfloat(dest_loop_y + 1) / dest_size_y

overlap_3 = cfloat(srce_loop_y) / srce_size_y

overlap_4 = cfloat(srce_loop_y + 1) / srce_size_y

overlap_5 = overlap_3

overlap_6 = overlap_4

If overlap_3 < overlap_1 Or overlap_3 > overlap_2 Then overlap_3 = Iif(Abs(overlap_3 - overlap_1) < Abs(overlap_3 - overlap_2), overlap_1, overlap_2)

If overlap_4 < overlap_1 Or overlap_4 > overlap_2 Then overlap_4 = Iif(Abs(overlap_4 - overlap_1) < Abs(overlap_4 - overlap_2), overlap_1, overlap_2)

overlap_factor *= Abs((overlap_3 - overlap_4) / (overlap_5 - overlap_6))

'overlap_factor = 1

If overlap_factor > 1E-12 Then

total_pixels += overlap_factor 'if all of the source pixel is under the destination pixel, then a whole pixel is added

srce_color = Point(srce_loop_x, srce_loop_y, source)

red += ((srce_color And &H00FF0000) Shr 16) * overlap_factor

green += ((srce_color And &H0000FF00) Shr 8) * overlap_factor

blue += (srce_color And &H000000FF) * overlap_factor

End If

Next y

Next x

red /= total_pixels: green /= total_pixels: blue /= total_pixels

'draw

Pset target, (x + dest_loop_x, y + dest_loop_y), (256 Shl 24) Or (red Shl 16) Or (green Shl 8) Or blue

Next dest_loop_y

Next dest_loop_x

End Sub

Sub image_scaler Overload (Byval x As Integer = 0, Byval y As Integer = 0, Byval source As fb.image Ptr, Byval scale As float)

image_scaler 0, x, y, source, scale

End Sub

Dim As Integer x, y

Dim Shared As fb.image Ptr picture

Screenres 800, 600, 32

Setmouse 256, 256, 0

picture = imagecreate(256, 256, &HFF00FF00)

Circle picture, (100, 100), 50, &HFF000000

Circle picture, (150, 150), 5, &HFFFFFF00

Line picture, (100, 0) - (100, 100), &HFF00FFFF

Pset picture, (8, 8), &HFF000000

Do

If Getmouse(x, y) = 0 Then

Screenlock

Cls

image_scaler 0, 0, picture, x / 256

image_scaler x, y, picture, x / 512

Screenunlock

End If

Sleep 50

Loop Until Inkey = Chr(27)

System