+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: Load Image 256 (/showthread.php?tid=464)
Load Image 256 - Petr - 05-22-2022
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 FunctionRE: Load Image 256 - Dav - 05-22-2022
Cool. Very helpful. Works well for me here. Thanks!
- Dav