Load Image 256

[Petr]

Hi again.

This function is designed for you to load any image into 8-bit format. I used Ashish's conversion feature, which he published a long time ago, to convert. Here I did not try to speed it up, but to make it work so that any 32-bit image could actually be used as an 8-bit image.

  The whole issue of 8-bit images faces one major drawback. If you do anything on an 8-bit screen, you have to compare the color palettes of all the images used so that they are the same and there is no color swapping. Thus, to make sure that, for example, the yellow color in one 8-bit frame does not have a palette number of, for example, 50, but in another frame else number. This needs to be considered when using 8-bit images.

Code: (Select All)

'LOADIMAGE256 experimental ver. 2.0

'1] Load image as 32 bit image
'2] find how much colors image contains. If 256 and less, continue. If more than 256, use Ashish's Dithering program, convert source image to 256 colors and call function LOADIMAGE256 again
'3] create 8 bit image and color palette
'4] THE PROGRAM DOES NOT RESPECT THE DEFAULT Qb64 COLOR PALETTE, Each image has its own!



Screen _NewImage(1700, 800, 256)
img8 = LOADIMAGE256("be.png")
_CopyPalette img8, _Dest
_PutImage (0, 0), img8




Function LOADIMAGE256 (img$)
    DefLng A-Z
    CompressIntensity = 5
    image = _LoadImage(img$, 32)
    ReStart: 'if image contains more than 256 colors, is function restarted after Floyd Steinberg Dithering is done by Ashish's function.
    ReDim m As _MEM, clr8(255) As _Unsigned Long, Clr32 As _Unsigned Long, test As Long, s As Long
    For s = 0 To 255
        clr8(s) = 99999
    Next s
    m = _MemImage(image)
    Do Until p& = m.SIZE
        _MemGet m, m.OFFSET + p&, Clr32~&
        test = 0
        'this block prevent for writing the same color more than 1x to palette array
        Do Until test > 255
            If clr8(test) = Clr32~& Then GoTo NextColor
            If clr8(test) = 99999 Then Exit Do
            test = test + 1
        Loop
        'if is empty place in palette, save this color as next palette color
        If test > 255 Then

            Print "Image contains more than 256 colors, can not be directly copyed as 8 bit image. Using ASHISH's source for dithering... Compress intensity: "; CompressIntensity

            img2 = FloydSteinbergDithering(image, CompressIntensity)
            CompressIntensity = CompressIntensity - 1
            _FreeImage image
            image = img2
            GoTo ReStart

        End If
        clr8(test) = Clr32
        'color is saved as palette for 8 bit image
        NextColor: p& = p& + 4
    Loop
    image8 = _NewImage(_Width(image), _Height(image), 256)
    'set palette
    Dim N As _MEM, C As _Unsigned _Byte
    N = _MemImage(image8)
    For palett = 0 To 255
        _PaletteColor palett, clr8(palett), image8
    Next
    'create 8 bit mask (set colors 0 to 255 to 8 bit image)
    For C = 255 To 0 Step -1
        clr~& = clr8(C)
        R& = 0
        R8& = 0
        Do Until R& = m.SIZE
            _MemGet m, m.OFFSET + R&, Clr32
            If Clr32 = clr~& Then _MemPut N, N.OFFSET + R8&, C
            R& = R& + 4
            R8& = R8& + 1
        Loop
    Next C
    LOADIMAGE256 = _CopyImage(image8, 256)
    _MemFree m
    _MemFree N
    _FreeImage image
    _FreeImage image8
End Function


Function FloydSteinbergDithering& (img&, factor As Integer) 'This is not my source, its coded By Ashish
    preDest = _Dest
    preSource = _Source
    Img32 = _CopyImage(img&)
    _Dest Img32
    _Source img&
    For y = 0 To _Height(img&) - 1
        For x = 0 To _Width(img&) - 1
            col~& = Point(x, y)
            oldR = _Red(col~&)
            oldG = _Green(col~&)
            oldB = _Blue(col~&)

            newR = _Round(factor * (oldR / 255)) * (255 / factor)
            newG = _Round(factor * (oldG / 255)) * (255 / factor)
            newB = _Round(factor * (oldB / 255)) * (255 / factor)

            errR = oldR - newR
            errG = oldG - newG
            errB = oldB - newB

            col2~& = Point(x + 1, y)
            r = _Red(col2~&) + errR * 7 / 16
            g = _Green(col2~&) + errG * 7 / 16
            b = _Blue(col2~&) + errB * 7 / 16
            PSet (x + 1, y), _RGB(r, g, b)

            col2~& = Point(x - 1, y + 1)
            r = _Red(col2~&) + errR * 3 / 16
            g = _Green(col2~&) + errG * 3 / 16
            b = _Blue(col2~&) + errB * 3 / 16
            PSet (x - 1, y + 1), _RGB(r, g, b)

            col2~& = Point(x, y + 1)
            r = _Red(col2~&) + errR * 5 / 16
            g = _Green(col2~&) + errG * 5 / 16
            b = _Blue(col2~&) + errB * 5 / 16
            PSet (x, y + 1), _RGB(r, g, b)

            col2~& = Point(x + 1, y + 1)
            r = _Red(col2~&) + errR * 1 / 16
            g = _Green(col2~&) + errG * 1 / 16
            b = _Blue(col2~&) + errB * 1 / 16
            PSet (x + 1, y + 1), _RGB(r, g, b)

            PSet (x, y), _RGB(newR, newG, newB)
    Next x, y
    _Dest preDest
    _Source preSource
    FloydSteinbergDithering& = Img32
End Function

[Dav]

Cool.  Very helpful.  Works well for me here.  Thanks!

- Dav