8 bit graphics (continued from Off-Topic because of attachments)

[Richard]

The three files below

PAINTcolor32.bit  is a 2D color spectrum
PAINTcolor256     is a MS PAINT converted above file to 256 colors
MAGICKcolor256  is using MAGICK to convert PAINTcolor32bit to a 256 color file

Would anyone care to share screenshots from their computers so that I can confirm COMPLETE compatibility between various computer hardware/software. Sometimes in various programming environments on my HP laptop - the last two files are really messed up (color-wise).


  [ You are not allowed to view this attachment ]       [ You are not allowed to view this attachment ]       [ You are not allowed to view this attachment ]  

[Richard Frost]

I'm running XP on a 64 bit laptop.

My 32 bit Windows version of QB64 v1.3 will not display that 3rd file on a 32 bit  screen.  The file will 
load, but an "Invalid handle" error is generated with the _PUTIMAGE.   After converting it to  JPEG it's 
fine.  The colors  always look the same  to me - in Windows Viewer, MS Paint, or QB64.   

There is a weird splotch like a fractal tree at lower right in the Magick image.  Is that the problem?

Maybe I didn't understand the question. 

[SMcNeill]

If you've ever used my SaveImage library, it can take a lot of the hassle out of using 256 color images inside QB64.

For example, you can take a 32-bit image and dither it down to a 256 color image, much like you've done above with external programs.  The results which you get will go from your 32-bit color image above, to the following:

  [ You are not allowed to view this attachment ]  

And the code for this simple conversion is here, along with the routine to save the 256-color image as a BMP file on your drive:

Code: QB64: [Select]

1. image1 = _LOADIMAGE("PAINTcolor32bit.bmp", 32) 'load the 32-bit image
2. image2 = Image32To256(image1) 'convert it to a 256 color image
3.  
4. SaveBMP "ConvertedTo256WithQB64.bmp", image2, 0, 0, _WIDTH(image2) - 1, _HEIGHT(image2) - 1 'and save it to the drive
5. 'and we're done!
6.  
7.  
8.  
9.  
10. FUNCTION Image32To256 (image&)
11.     'This routine can benefit/be altered if the user sets a CONST or DIM SHARED variable name ConvertToStandard256Palette, as so:
12.     '     CONST ConvertToStandard256Palette = -1
13.     '           Set the value to 0 (FALSE) to preseve the color information perfectly, using its default palette.
14.     '           If the CONST is set (TRUE), then we convert our colors to as close of a match as possible, while
15.     '           preserving the standard QB64 256-color palette.
16.     DIM o AS _OFFSET
17.     DIM a AS _UNSIGNED _BYTE, r AS _UNSIGNED _BYTE
18.     DIM g AS _UNSIGNED _BYTE, b AS _UNSIGNED _BYTE
19.     DIM t AS _UNSIGNED LONG, color256 AS _UNSIGNED LONG
20.     DIM index256 AS _UNSIGNED LONG
21.     TYPE Pal_type
22.         c AS _UNSIGNED LONG 'color index
23.         n AS LONG 'number of times it appears
24.     END TYPE
25.     DIM Pal(255) AS _UNSIGNED LONG
26.     I256 = _NEWIMAGE(_WIDTH(image&), _HEIGHT(image&), 256)
27.     DIM m(1) AS _MEM: m(0) = _MEMIMAGE(image&): m(1) = _MEMIMAGE(I256)
28.     DO 'get the palette and number of colors used
29.         _MEMGET m(0), m(0).OFFSET + o, t 'Get the colors from the original screen
30.         FOR i = 0 TO colors 'check to see if they're in the existing palette we're making
31.             IF Pal(i) = t THEN EXIT FOR
32.         NEXT
33.         IF i > colors THEN
34.             Pal(colors) = t
35.             colors = colors + 1 'increment the index for the new color found
36.             IF colors > 255 THEN 'no need to check any further; it's not a normal QB64 256 color image
37.                 Image32To256 = RemapImageFS(image&, I256)
38.                 _FREEIMAGE I256
39.                 _MEMFREE m()
40.                 EXIT FUNCTION 'and we're done, with 100% image compatability saved
41.             END IF
42.         END IF
43.         o = o + 4
44.     LOOP UNTIL o >= m(0).SIZE
45.  
46.     '  we might be working with a standard qb64 256 color screen
47.     '  check for that first
48.     colors = colors - 1 'back up one, as we found our limit and aren't needing to set another
49.     FOR i = 0 TO colors 'comparing palette against QB64 256 color palette
50.         t = Pal(i)
51.         index256 = _RGBA(_RED32(t), _GREEN32(t), _BLUE32(t), _ALPHA32(t), I256)
52.         color256 = _RGBA32(_RED(index256, I256), _GREEN(index256, I256), _BLUE(index256, I256), _ALPHA(index256, I256))
53.         IF t <> color256 THEN NSCU = -1: EXIT FOR
54.     NEXT
55.     IF NSCU THEN 'it's not a standard QB64 256 color palette, but it's still less than 256 total colors.
56.         IF ConvertToStandard256Palette THEN
57.             TI256 = RemapImageFS(image&, I256)
58.             _MEMFREE m(1) 'free the old memory
59.             _FREEIMAGE I256 'and the old image
60.             I256 = TI256 'replace with the new image
61.             m(1) = _MEMIMAGE(I256) 'and point the mem block to the new image
62.         ELSE
63.             FOR i = 0 TO colors: _PALETTECOLOR i, Pal(i), I256: NEXT 'set the palette
64.         END IF
65.     END IF
66.     'If we didn't change the palette above, we should work 100% with qb64's internal 256 color palette
67.     o = 0
68.     DO 'Get the colors, put them to a 256 color screen, as is
69.         _MEMGET m(0), m(0).OFFSET + o + 3, a
70.         _MEMGET m(0), m(0).OFFSET + o + 2, r
71.         _MEMGET m(0), m(0).OFFSET + o + 1, g
72.         _MEMGET m(0), m(0).OFFSET + o + 0, b
73.         _MEMPUT m(1), m(1).OFFSET + o \ 4, _RGBA(r, g, b, a, I256) AS _UNSIGNED _BYTE
74.         o = o + 4
75.     LOOP UNTIL o >= m(0).SIZE
76.     _MEMFREE m()
77.     Image32To256 = I256
78. END FUNCTION
79.  
80. FUNCTION RemapImageFS& (ohan&, dhan&) 'Routine written by RhoSigma and used (with permission) for SaveImage Library
81.     '// +---------------+---------------------------------------------------+
82.     '// | ###### ###### |     .--. .         .-.                            |
83.     '// | ##  ## ##   # |     |   )|        (   ) o                         |
84.     '// | ##  ##  ##    |     |--' |--. .-.  `-.  .  .-...--.--. .-.        |
85.     '// | ######   ##   |     |  \ |  |(   )(   ) | (   ||  |  |(   )       |
86.     '// | ##      ##    |     '   `'  `-`-'  `-'-' `-`-`|'  '  `-`-'`-      |
87.     '// | ##     ##   # |                            ._.'                   |
88.     '// | ##     ###### | Sources & Documents placed under the MIT License. |
89.     '// +-------------------------------------------------------------------+
90.     '// | Done by RhoSigma, R.Heyder, provided AS IS, use at your own risk. |
91.     '// | Find me in the QB64 Forum or mail to support[member=111]RhoSigma[/member]-cw.net for  |
92.     '// | any questions or suggestions. Thanx for your interest in my work. |
93.     '// +-------------------------------------------------------------------+
94.  
95.     RemapImageFS& = -1 'so far return invalid handle
96.     shan& = ohan& 'avoid side effect on given argument
97.     IF shan& < -1 OR shan& = 0 THEN '0 represents the visible screen
98.         '--- check/adjust source image & get new 8-bit image ---
99.         swid% = _WIDTH(shan&): shei% = _HEIGHT(shan&)
100.         IF _PIXELSIZE(shan&) <> 4 THEN
101.             than& = _NEWIMAGE(swid%, shei%, 32)
102.             IF than& >= -1 THEN EXIT FUNCTION
103.             _PUTIMAGE , shan&, than&
104.             shan& = than&
105.         ELSE
106.             than& = -1 'avoid freeing below
107.         END IF
108.         nhan& = _NEWIMAGE(swid%, shei%, 256)
109.         '--- Floyd-Steinberg error distribution arrays ---
110.         rhan& = _NEWIMAGE(swid%, 2, 32) 'these are missused as LONG arrays,
111.         ghan& = _NEWIMAGE(swid%, 2, 32) 'with CHECKING:OFF this is much faster
112.         bhan& = _NEWIMAGE(swid%, 2, 32) 'than real QB64 arrays
113.         '--- curr/next row offsets (for distribution array access) ---
114.         cro% = 0: nro% = swid% * 4 'will be swapped after each pixel row
115.         '--- the matrix values are extended by 16384 to avoid slow floating ---
116.         '--- point ops and to allow for integer storage in the above arrays ---
117.         '--- also it's a power of 2, which may be optimized into a bitshift ---
118.         seven% = 7168 '(7 / 16) * 16384 'X+1,Y+0 error fraction
119.         three% = 3072 '(3 / 16) * 16384 'X-1,Y+1 error fraction
120.         five% = 5120 '(5 / 16) * 16384 'X+0,Y+1 error fraction
121.         one% = 1025 '(1 / 16) * 16384 'X+1,Y+1 error fraction
122.         '--- if all is good, then start remapping ---
123.         $CHECKING:OFF
124.         IF nhan& < -1 AND rhan& < -1 AND ghan& < -1 AND bhan& < -1 THEN
125.             _COPYPALETTE dhan&, nhan& 'dest palette to new image
126.             '--- for speed we do direct memory access ---
127.             DIM sbuf AS _MEM: sbuf = _MEMIMAGE(shan&): soff%& = sbuf.OFFSET
128.             DIM nbuf AS _MEM: nbuf = _MEMIMAGE(nhan&): noff%& = nbuf.OFFSET
129.             DIM rbuf AS _MEM: rbuf = _MEMIMAGE(rhan&): roff%& = rbuf.OFFSET
130.             DIM gbuf AS _MEM: gbuf = _MEMIMAGE(ghan&): goff%& = gbuf.OFFSET
131.             DIM bbuf AS _MEM: bbuf = _MEMIMAGE(bhan&): boff%& = bbuf.OFFSET
132.             '--- iterate through pixels ---
133.             FOR y% = 0 TO shei% - 1
134.                 FOR x% = 0 TO swid% - 1
135.                     '--- curr/prev/next pixel offsets ---
136.                     cpo% = x% * 4: ppo% = cpo% - 4: npo% = cpo% + 4
137.                     '--- get pixel ARGB value from source ---
138.                     srgb~& = _MEMGET(sbuf, soff%&, _UNSIGNED LONG)
139.                     '--- add distributed error, shrink by 16384, clear error ---
140.                     '--- current pixel X+0, Y+0 (= cro% (current row offset)) ---
141.                     poff% = cro% + cpo% 'pre-calc full pixel offset
142.                     sr% = ((srgb~& AND &HFF0000~&) \ 65536) + (_MEMGET(rbuf, roff%& + poff%, LONG) \ 16384) 'red
143.                     sg% = ((srgb~& AND &HFF00~&) \ 256) + (_MEMGET(gbuf, goff%& + poff%, LONG) \ 16384) 'green
144.                     sb% = (srgb~& AND &HFF~&) + (_MEMGET(bbuf, boff%& + poff%, LONG) \ 16384) 'blue
145.                     _MEMPUT rbuf, roff%& + poff%, 0 AS LONG 'clearing each single pixel error using _MEMPUT
146.                     _MEMPUT gbuf, goff%& + poff%, 0 AS LONG 'turns out even faster than clearing the entire
147.                     _MEMPUT bbuf, boff%& + poff%, 0 AS LONG 'pixel row using _MEMFILL at the end of the loop
148.                     '--- find nearest color ---
149.                     crgb~& = _RGBA32(sr%, sg%, sb%, 0) 'used for fast value clipping + channel merge
150.                     npen% = _RGB(sr%, sg%, sb%, nhan&)
151.                     '--- put colormapped pixel to dest ---
152.                     _MEMPUT nbuf, noff%&, npen% AS _UNSIGNED _BYTE
153.                     '------------------------------------------
154.                     '--- Floyd-Steinberg error distribution ---
155.                     '------------------------------------------
156.                     '--- You may comment this block out, to see the
157.                     '--- result without applied FS matrix.
158.                     '-----
159.                     '--- get dest palette RGB value, calc error to clipped source ---
160.                     nrgb~& = _PALETTECOLOR(npen%, nhan&)
161.                     er% = ((crgb~& AND &HFF0000~&) - (nrgb~& AND &HFF0000~&)) \ 65536
162.                     eg% = ((crgb~& AND &HFF00~&) - (nrgb~& AND &HFF00~&)) \ 256
163.                     eb% = (crgb~& AND &HFF~&) - (nrgb~& AND &HFF~&)
164.                     '--- distribute error according to FS matrix ---
165.                     IF x% > 0 THEN
166.                         '--- X-1, Y+1 (= nro% (next row offset)) ---
167.                         poff% = nro% + ppo% 'pre-calc full pixel offset
168.                         _MEMPUT rbuf, roff%& + poff%, _MEMGET(rbuf, roff%& + poff%, LONG) + (er% * three%) AS LONG 'red
169.                         _MEMPUT gbuf, goff%& + poff%, _MEMGET(gbuf, goff%& + poff%, LONG) + (eg% * three%) AS LONG 'green
170.                         _MEMPUT bbuf, boff%& + poff%, _MEMGET(bbuf, boff%& + poff%, LONG) + (eb% * three%) AS LONG 'blue
171.                     END IF
172.                     '--- X+0, Y+1 (= nro% (next row offset)) ---
173.                     poff% = nro% + cpo% 'pre-calc full pixel offset
174.                     _MEMPUT rbuf, roff%& + poff%, _MEMGET(rbuf, roff%& + poff%, LONG) + (er% * five%) AS LONG 'red
175.                     _MEMPUT gbuf, goff%& + poff%, _MEMGET(gbuf, goff%& + poff%, LONG) + (eg% * five%) AS LONG 'green
176.                     _MEMPUT bbuf, boff%& + poff%, _MEMGET(bbuf, boff%& + poff%, LONG) + (eb% * five%) AS LONG 'blue
177.                     IF x% < (swid% - 1) THEN
178.                         '--- X+1, Y+0 (= cro% (current row offset)) ---
179.                         poff% = cro% + npo% 'pre-calc full pixel offset
180.                         _MEMPUT rbuf, roff%& + poff%, _MEMGET(rbuf, roff%& + poff%, LONG) + (er% * seven%) AS LONG 'red
181.                         _MEMPUT gbuf, goff%& + poff%, _MEMGET(gbuf, goff%& + poff%, LONG) + (eg% * seven%) AS LONG 'green
182.                         _MEMPUT bbuf, boff%& + poff%, _MEMGET(bbuf, boff%& + poff%, LONG) + (eb% * seven%) AS LONG 'blue
183.                         '--- X+1, Y+1 (= nro% (next row offset)) ---
184.                         poff% = nro% + npo% 'pre-calc full pixel offset
185.                         _MEMPUT rbuf, roff%& + poff%, _MEMGET(rbuf, roff%& + poff%, LONG) + (er% * one%) AS LONG 'red
186.                         _MEMPUT gbuf, goff%& + poff%, _MEMGET(gbuf, goff%& + poff%, LONG) + (eg% * one%) AS LONG 'green
187.                         _MEMPUT bbuf, boff%& + poff%, _MEMGET(bbuf, boff%& + poff%, LONG) + (eb% * one%) AS LONG 'blue
188.                     END IF
189.                     '------------------------------------------
190.                     '--- End of FS ----------------------------
191.                     '------------------------------------------
192.                     noff%& = noff%& + 1 'next dest pixel
193.                     soff%& = soff%& + 4 'next source pixel
194.                 NEXT x%
195.                 tmp% = cro%: cro% = nro%: nro% = tmp% 'exchange distribution array row offsets
196.             NEXT y%
197.             '--- memory cleanup ---
198.             _MEMFREE bbuf
199.             _MEMFREE gbuf
200.             _MEMFREE rbuf
201.             _MEMFREE nbuf
202.             _MEMFREE sbuf
203.             '--- set result ---
204.             RemapImageFS& = nhan&
205.             nhan& = -1 'avoid freeing below
206.         END IF
207.         $CHECKING:ON
208.         '--- remapping done or error, cleanup remains ---
209.         IF bhan& < -1 THEN _FREEIMAGE bhan&
210.         IF ghan& < -1 THEN _FREEIMAGE ghan&
211.         IF rhan& < -1 THEN _FREEIMAGE rhan&
212.         IF nhan& < -1 THEN _FREEIMAGE nhan&
213.         IF than& < -1 THEN _FREEIMAGE than&
214.     END IF
215. END FUNCTION
216.  
217. SUB SaveBMP (filename$, image&, x1%, y1%, x2%, y2%)
218.     'Super special STEVE-Approved BMP Export routine for use with any QB64 graphic mode.
219.     IF x2% = _WIDTH(image&) THEN x2% = x2% - 1
220.     IF y2% = _HEIGHT(image&) THEN y2% = y2% - 1
221.  
222.     IF _PIXELSIZE(image&) = 0 THEN
223.         IF SaveTextAs256Color THEN
224.             tempimage& = TextScreenToImage256&(image&)
225.         ELSE
226.             tempimage& = TextScreenToImage32&(image&)
227.         END IF
228.         F = _FONT(image&)
229.         FW = _FONTWIDTH(F): FH = _FONTHEIGHT(F)
230.         SaveBMP filename$, tempimage&, x1% * FW, y1% * FH, x2% * FW, y2% * FH
231.         _FREEIMAGE tempimage&
232.         EXIT FUNCTION
233.     END IF
234.  
235.     TYPE BMPFormat
236.         ID AS STRING * 2
237.         Size AS LONG
238.         Blank AS LONG
239.         Offset AS LONG
240.         Hsize AS LONG
241.         PWidth AS LONG
242.         PDepth AS LONG
243.         Planes AS INTEGER
244.         BPP AS INTEGER
245.         Compression AS LONG
246.         ImageBytes AS LONG
247.         Xres AS LONG
248.         Yres AS LONG
249.         NumColors AS LONG
250.         SigColors AS LONG
251.     END TYPE
252.  
253.  
254.     DIM BMP AS BMPFormat
255.     DIM x AS LONG, y AS LONG
256.     DIM temp AS STRING ', t AS STRING * 1
257.  
258.     DIM n AS _MEM, o AS _OFFSET, m AS _MEM
259.     m = _MEMIMAGE(image&)
260.  
261.     IF x1% > x2% THEN SWAP x1%, x2%
262.     IF y1% > y2% THEN SWAP y1%, y2%
263.     IF x2% = _WIDTH(imagehandle%) THEN x2% = _WIDTH(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen
264.     IF y2% = _HEIGHT(imagehandle%) THEN y2% = _HEIGHT(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen
265.  
266.     s& = _SOURCE
267.     _SOURCE image&
268.  
269.     BMP.PWidth = (x2% - x1%) + 1
270.     BMP.PDepth = (y2% - y1%) + 1
271.     BMP.ID = "BM"
272.     BMP.Blank = 0
273.     BMP.Hsize = 40
274.     BMP.Planes = 1
275.     BMP.Compression = 0
276.     BMP.Xres = 0
277.     BMP.Yres = 0
278.  
279.     BMP.SigColors = 0
280.  
281.     SELECT CASE _PIXELSIZE(image&)
282.         CASE 1
283.             temp = SPACE$(x2% - x1% + 1)
284.             OffsetBITS& = 54 + 1024 'add palette in 256 color modes
285.             BMP.BPP = 8
286.             IF BMP.PWidth MOD 4 THEN ZeroPAD$ = SPACE$(4 - (BMP.PWidth MOD 4))
287.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
288.             BMP.ImageBytes = ImageSize&
289.             BMP.NumColors = 256
290.             BMP.Size = ImageSize& + OffsetBITS&
291.             BMP.Offset = OffsetBITS&
292.         CASE 4
293.             temp = SPACE$(3)
294.             OffsetBITS& = 54 'no palette in 24/32 bit
295.             BMP.BPP = 24
296.             IF ((BMP.PWidth * 3) MOD 4) THEN ZeroPAD$ = SPACE$(4 - ((BMP.PWidth * 3) MOD 4))
297.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
298.             BMP.ImageBytes = ImageSize&
299.             BMP.NumColors = 0
300.             BMP.Size = ImageSize& * 3 + OffsetBITS&
301.             BMP.Offset = OffsetBITS&
302.     END SELECT
303.  
304.     n = _MEMNEW(BMP.Size)
305.     _MEMPUT n, n.OFFSET, BMP
306.     o = n.OFFSET + 54
307.     zp& = LEN(ZeroPAD$)
308.     $CHECKING:OFF
309.  
310.     IF BMP.BPP = 8 THEN 'Store the Palette for 256 color mode
311.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
312.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
313.             b$ = CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
314.             _MEMPUT n, o, b$
315.             o = o + 4
316.         NEXT
317.         y = y2% + 1
318.         w& = _WIDTH(image&)
319.         x = x2% - x1% + 1
320.         DO
321.             y = y - 1
322.             _MEMGET m, m.OFFSET + (w& * y + x1%), temp
323.             _MEMPUT n, o, temp
324.             o = o + x
325.             _MEMPUT n, o, ZeroPAD$
326.             o = o + zp&
327.         LOOP UNTIL y = y1%
328.     ELSE
329.         y = y2% + 1
330.         w& = _WIDTH(image&)
331.         DO
332.             y = y - 1: x = x1% - 1
333.             DO
334.                 x = x + 1
335.                 _MEMGET m, m.OFFSET + (w& * y + x) * 4, temp
336.                 _MEMPUT n, o, temp
337.                 o = o + 3
338.             LOOP UNTIL x = x2%
339.             _MEMPUT n, o, ZeroPAD$
340.             o = o + zp&
341.         LOOP UNTIL y = y1%
342.     END IF
343.     $CHECKING:ON
344.     F = FREEFILE
345.     OPEN filename$ FOR BINARY AS #F
346.     t1$ = SPACE$(BMP.Size)
347.     _MEMGET n, n.OFFSET, t1$
348.     PUT #F, , t1$
349.     CLOSE #F
350.     _SOURCE s&
351.     _MEMFREE m
352.     _MEMFREE n
353. END SUB
354.  

[SMcNeill]

And here's a demo of how to load & convert a 256-color image with the same routines for use with your own programs.

Let's start with a 256 color image:
  [ You are not allowed to view this attachment ]  

And let's write a simple QB64 demo program to show how to work with that image:

Code: QB64: [Select]

1. image1 = _LOADIMAGE("parrot.png", 32) 'load the 256 color image as a 32-bit image
2. image2 = Image32To256(image1) 'convert it to a 256 color image
3.  
4. SCREEN image1 'show the image as a 32-bit image
5. PRINT "32-BIT"
6. SLEEP
7. SCREEN image2 'show the image as a 256-color image
8. PRINT "256 COLOR"
9.  
10. 'As you can see, we have successfully reproduced our 256-color image
11.  
12.  
13.  
14. SLEEP 'now convert it to a 256 color image, using QB64's standard color palette
15. DIM SHARED ConvertToStandard256Palette AS LONG 'The shared variable (or CONST) to say "Let's use QB64's standard palette!"
16. ConvertToStandard256Palette = -1 'Set this to TRUE (or -1)
17. image3 = Image32To256(image1) 'and convert
18. SCREEN image3 'and you can see how we look a little bit different than we did before
19. PRINT "256-QB64 COLOR"
20.  
21.  
22.  
23. FUNCTION Image32To256 (image&)
24.     'This routine can benefit/be altered if the user sets a CONST or DIM SHARED variable name ConvertToStandard256Palette, as so:
25.     '     CONST ConvertToStandard256Palette = -1
26.     '           Set the value to 0 (FALSE) to preseve the color information perfectly, using its default palette.
27.     '           If the CONST is set (TRUE), then we convert our colors to as close of a match as possible, while
28.     '           preserving the standard QB64 256-color palette.
29.     DIM o AS _OFFSET
30.     DIM a AS _UNSIGNED _BYTE, r AS _UNSIGNED _BYTE
31.     DIM g AS _UNSIGNED _BYTE, b AS _UNSIGNED _BYTE
32.     DIM t AS _UNSIGNED LONG, color256 AS _UNSIGNED LONG
33.     DIM index256 AS _UNSIGNED LONG
34.     TYPE Pal_type
35.         c AS _UNSIGNED LONG 'color index
36.         n AS LONG 'number of times it appears
37.     END TYPE
38.     DIM Pal(255) AS _UNSIGNED LONG
39.     I256 = _NEWIMAGE(_WIDTH(image&), _HEIGHT(image&), 256)
40.     DIM m(1) AS _MEM: m(0) = _MEMIMAGE(image&): m(1) = _MEMIMAGE(I256)
41.     DO 'get the palette and number of colors used
42.         _MEMGET m(0), m(0).OFFSET + o, t 'Get the colors from the original screen
43.         FOR i = 0 TO colors 'check to see if they're in the existing palette we're making
44.             IF Pal(i) = t THEN EXIT FOR
45.         NEXT
46.         IF i > colors THEN
47.             Pal(colors) = t
48.             colors = colors + 1 'increment the index for the new color found
49.             IF colors > 256 THEN 'no need to check any further; it's not a normal QB64 256 color image
50.                 Image32To256 = RemapImageFS(image&, I256)
51.                 _FREEIMAGE I256
52.                 _MEMFREE m()
53.                 EXIT FUNCTION 'and we're done, with 100% image compatability saved
54.             END IF
55.         END IF
56.         o = o + 4
57.     LOOP UNTIL o >= m(0).SIZE
58.  
59.     '  we might be working with a standard qb64 256 color screen
60.     '  check for that first
61.     colors = colors - 1 'back up one, as we found our limit and aren't needing to set another
62.     FOR i = 0 TO colors 'comparing palette against QB64 256 color palette
63.         t = Pal(i)
64.         index256 = _RGBA(_RED32(t), _GREEN32(t), _BLUE32(t), _ALPHA32(t), I256)
65.         color256 = _RGBA32(_RED(index256, I256), _GREEN(index256, I256), _BLUE(index256, I256), _ALPHA(index256, I256))
66.         IF t <> color256 THEN NSCU = -1: EXIT FOR
67.     NEXT
68.     IF NSCU THEN 'it's not a standard QB64 256 color palette, but it's still less than 256 total colors.
69.         IF ConvertToStandard256Palette THEN
70.             TI256 = RemapImageFS(image&, I256)
71.             _MEMFREE m(1) 'free the old memory
72.             _FREEIMAGE I256 'and the old image
73.             I256 = TI256 'replace with the new image
74.             m(1) = _MEMIMAGE(I256) 'and point the mem block to the new image
75.         ELSE
76.             FOR i = 0 TO colors: _PALETTECOLOR i, Pal(i), I256: NEXT 'set the palette
77.         END IF
78.     END IF
79.     'If we didn't change the palette above, we should work 100% with qb64's internal 256 color palette
80.     o = 0
81.     DO 'Get the colors, put them to a 256 color screen, as is
82.         _MEMGET m(0), m(0).OFFSET + o + 3, a
83.         _MEMGET m(0), m(0).OFFSET + o + 2, r
84.         _MEMGET m(0), m(0).OFFSET + o + 1, g
85.         _MEMGET m(0), m(0).OFFSET + o + 0, b
86.         _MEMPUT m(1), m(1).OFFSET + o \ 4, _RGBA(r, g, b, a, I256) AS _UNSIGNED _BYTE
87.         o = o + 4
88.     LOOP UNTIL o >= m(0).SIZE
89.     _MEMFREE m()
90.     Image32To256 = I256
91. END FUNCTION
92.  
93. FUNCTION RemapImageFS& (ohan&, dhan&) 'Routine written by RhoSigma and used (with permission) for SaveImage Library
94.     '// +---------------+---------------------------------------------------+
95.     '// | ###### ###### |     .--. .         .-.                            |
96.     '// | ##  ## ##   # |     |   )|        (   ) o                         |
97.     '// | ##  ##  ##    |     |--' |--. .-.  `-.  .  .-...--.--. .-.        |
98.     '// | ######   ##   |     |  \ |  |(   )(   ) | (   ||  |  |(   )       |
99.     '// | ##      ##    |     '   `'  `-`-'  `-'-' `-`-`|'  '  `-`-'`-      |
100.     '// | ##     ##   # |                            ._.'                   |
101.     '// | ##     ###### | Sources & Documents placed under the MIT License. |
102.     '// +-------------------------------------------------------------------+
103.     '// | Done by RhoSigma, R.Heyder, provided AS IS, use at your own risk. |
104.     '// | Find me in the QB64 Forum or mail to support[member=111]RhoSigma[/member]-cw.net for  |
105.     '// | any questions or suggestions. Thanx for your interest in my work. |
106.     '// +-------------------------------------------------------------------+
107.  
108.     RemapImageFS& = -1 'so far return invalid handle
109.     shan& = ohan& 'avoid side effect on given argument
110.     IF shan& < -1 OR shan& = 0 THEN '0 represents the visible screen
111.         '--- check/adjust source image & get new 8-bit image ---
112.         swid% = _WIDTH(shan&): shei% = _HEIGHT(shan&)
113.         IF _PIXELSIZE(shan&) <> 4 THEN
114.             than& = _NEWIMAGE(swid%, shei%, 32)
115.             IF than& >= -1 THEN EXIT FUNCTION
116.             _PUTIMAGE , shan&, than&
117.             shan& = than&
118.         ELSE
119.             than& = -1 'avoid freeing below
120.         END IF
121.         nhan& = _NEWIMAGE(swid%, shei%, 256)
122.         '--- Floyd-Steinberg error distribution arrays ---
123.         rhan& = _NEWIMAGE(swid%, 2, 32) 'these are missused as LONG arrays,
124.         ghan& = _NEWIMAGE(swid%, 2, 32) 'with CHECKING:OFF this is much faster
125.         bhan& = _NEWIMAGE(swid%, 2, 32) 'than real QB64 arrays
126.         '--- curr/next row offsets (for distribution array access) ---
127.         cro% = 0: nro% = swid% * 4 'will be swapped after each pixel row
128.         '--- the matrix values are extended by 16384 to avoid slow floating ---
129.         '--- point ops and to allow for integer storage in the above arrays ---
130.         '--- also it's a power of 2, which may be optimized into a bitshift ---
131.         seven% = 7168 '(7 / 16) * 16384 'X+1,Y+0 error fraction
132.         three% = 3072 '(3 / 16) * 16384 'X-1,Y+1 error fraction
133.         five% = 5120 '(5 / 16) * 16384 'X+0,Y+1 error fraction
134.         one% = 1025 '(1 / 16) * 16384 'X+1,Y+1 error fraction
135.         '--- if all is good, then start remapping ---
136.         $CHECKING:OFF
137.         IF nhan& < -1 AND rhan& < -1 AND ghan& < -1 AND bhan& < -1 THEN
138.             _COPYPALETTE dhan&, nhan& 'dest palette to new image
139.             '--- for speed we do direct memory access ---
140.             DIM sbuf AS _MEM: sbuf = _MEMIMAGE(shan&): soff%& = sbuf.OFFSET
141.             DIM nbuf AS _MEM: nbuf = _MEMIMAGE(nhan&): noff%& = nbuf.OFFSET
142.             DIM rbuf AS _MEM: rbuf = _MEMIMAGE(rhan&): roff%& = rbuf.OFFSET
143.             DIM gbuf AS _MEM: gbuf = _MEMIMAGE(ghan&): goff%& = gbuf.OFFSET
144.             DIM bbuf AS _MEM: bbuf = _MEMIMAGE(bhan&): boff%& = bbuf.OFFSET
145.             '--- iterate through pixels ---
146.             FOR y% = 0 TO shei% - 1
147.                 FOR x% = 0 TO swid% - 1
148.                     '--- curr/prev/next pixel offsets ---
149.                     cpo% = x% * 4: ppo% = cpo% - 4: npo% = cpo% + 4
150.                     '--- get pixel ARGB value from source ---
151.                     srgb~& = _MEMGET(sbuf, soff%&, _UNSIGNED LONG)
152.                     '--- add distributed error, shrink by 16384, clear error ---
153.                     '--- current pixel X+0, Y+0 (= cro% (current row offset)) ---
154.                     poff% = cro% + cpo% 'pre-calc full pixel offset
155.                     sr% = ((srgb~& AND &HFF0000~&) \ 65536) + (_MEMGET(rbuf, roff%& + poff%, LONG) \ 16384) 'red
156.                     sg% = ((srgb~& AND &HFF00~&) \ 256) + (_MEMGET(gbuf, goff%& + poff%, LONG) \ 16384) 'green
157.                     sb% = (srgb~& AND &HFF~&) + (_MEMGET(bbuf, boff%& + poff%, LONG) \ 16384) 'blue
158.                     _MEMPUT rbuf, roff%& + poff%, 0 AS LONG 'clearing each single pixel error using _MEMPUT
159.                     _MEMPUT gbuf, goff%& + poff%, 0 AS LONG 'turns out even faster than clearing the entire
160.                     _MEMPUT bbuf, boff%& + poff%, 0 AS LONG 'pixel row using _MEMFILL at the end of the loop
161.                     '--- find nearest color ---
162.                     crgb~& = _RGBA32(sr%, sg%, sb%, 0) 'used for fast value clipping + channel merge
163.                     npen% = _RGB(sr%, sg%, sb%, nhan&)
164.                     '--- put colormapped pixel to dest ---
165.                     _MEMPUT nbuf, noff%&, npen% AS _UNSIGNED _BYTE
166.                     '------------------------------------------
167.                     '--- Floyd-Steinberg error distribution ---
168.                     '------------------------------------------
169.                     '--- You may comment this block out, to see the
170.                     '--- result without applied FS matrix.
171.                     '-----
172.                     '--- get dest palette RGB value, calc error to clipped source ---
173.                     nrgb~& = _PALETTECOLOR(npen%, nhan&)
174.                     er% = ((crgb~& AND &HFF0000~&) - (nrgb~& AND &HFF0000~&)) \ 65536
175.                     eg% = ((crgb~& AND &HFF00~&) - (nrgb~& AND &HFF00~&)) \ 256
176.                     eb% = (crgb~& AND &HFF~&) - (nrgb~& AND &HFF~&)
177.                     '--- distribute error according to FS matrix ---
178.                     IF x% > 0 THEN
179.                         '--- X-1, Y+1 (= nro% (next row offset)) ---
180.                         poff% = nro% + ppo% 'pre-calc full pixel offset
181.                         _MEMPUT rbuf, roff%& + poff%, _MEMGET(rbuf, roff%& + poff%, LONG) + (er% * three%) AS LONG 'red
182.                         _MEMPUT gbuf, goff%& + poff%, _MEMGET(gbuf, goff%& + poff%, LONG) + (eg% * three%) AS LONG 'green
183.                         _MEMPUT bbuf, boff%& + poff%, _MEMGET(bbuf, boff%& + poff%, LONG) + (eb% * three%) AS LONG 'blue
184.                     END IF
185.                     '--- X+0, Y+1 (= nro% (next row offset)) ---
186.                     poff% = nro% + cpo% 'pre-calc full pixel offset
187.                     _MEMPUT rbuf, roff%& + poff%, _MEMGET(rbuf, roff%& + poff%, LONG) + (er% * five%) AS LONG 'red
188.                     _MEMPUT gbuf, goff%& + poff%, _MEMGET(gbuf, goff%& + poff%, LONG) + (eg% * five%) AS LONG 'green
189.                     _MEMPUT bbuf, boff%& + poff%, _MEMGET(bbuf, boff%& + poff%, LONG) + (eb% * five%) AS LONG 'blue
190.                     IF x% < (swid% - 1) THEN
191.                         '--- X+1, Y+0 (= cro% (current row offset)) ---
192.                         poff% = cro% + npo% 'pre-calc full pixel offset
193.                         _MEMPUT rbuf, roff%& + poff%, _MEMGET(rbuf, roff%& + poff%, LONG) + (er% * seven%) AS LONG 'red
194.                         _MEMPUT gbuf, goff%& + poff%, _MEMGET(gbuf, goff%& + poff%, LONG) + (eg% * seven%) AS LONG 'green
195.                         _MEMPUT bbuf, boff%& + poff%, _MEMGET(bbuf, boff%& + poff%, LONG) + (eb% * seven%) AS LONG 'blue
196.                         '--- X+1, Y+1 (= nro% (next row offset)) ---
197.                         poff% = nro% + npo% 'pre-calc full pixel offset
198.                         _MEMPUT rbuf, roff%& + poff%, _MEMGET(rbuf, roff%& + poff%, LONG) + (er% * one%) AS LONG 'red
199.                         _MEMPUT gbuf, goff%& + poff%, _MEMGET(gbuf, goff%& + poff%, LONG) + (eg% * one%) AS LONG 'green
200.                         _MEMPUT bbuf, boff%& + poff%, _MEMGET(bbuf, boff%& + poff%, LONG) + (eb% * one%) AS LONG 'blue
201.                     END IF
202.                     '------------------------------------------
203.                     '--- End of FS ----------------------------
204.                     '------------------------------------------
205.                     noff%& = noff%& + 1 'next dest pixel
206.                     soff%& = soff%& + 4 'next source pixel
207.                 NEXT x%
208.                 tmp% = cro%: cro% = nro%: nro% = tmp% 'exchange distribution array row offsets
209.             NEXT y%
210.             '--- memory cleanup ---
211.             _MEMFREE bbuf
212.             _MEMFREE gbuf
213.             _MEMFREE rbuf
214.             _MEMFREE nbuf
215.             _MEMFREE sbuf
216.             '--- set result ---
217.             RemapImageFS& = nhan&
218.             nhan& = -1 'avoid freeing below
219.         END IF
220.         $CHECKING:ON
221.         '--- remapping done or error, cleanup remains ---
222.         IF bhan& < -1 THEN _FREEIMAGE bhan&
223.         IF ghan& < -1 THEN _FREEIMAGE ghan&
224.         IF rhan& < -1 THEN _FREEIMAGE rhan&
225.         IF nhan& < -1 THEN _FREEIMAGE nhan&
226.         IF than& < -1 THEN _FREEIMAGE than&
227.     END IF
228. END FUNCTION
229.  
230. SUB SaveBMP (filename$, image&, x1%, y1%, x2%, y2%)
231.     'Super special STEVE-Approved BMP Export routine for use with any QB64 graphic mode.
232.     IF x2% = _WIDTH(image&) THEN x2% = x2% - 1
233.     IF y2% = _HEIGHT(image&) THEN y2% = y2% - 1
234.  
235.     IF _PIXELSIZE(image&) = 0 THEN
236.         IF SaveTextAs256Color THEN
237.             tempimage& = TextScreenToImage256&(image&)
238.         ELSE
239.             tempimage& = TextScreenToImage32&(image&)
240.         END IF
241.         F = _FONT(image&)
242.         FW = _FONTWIDTH(F): FH = _FONTHEIGHT(F)
243.         SaveBMP filename$, tempimage&, x1% * FW, y1% * FH, x2% * FW, y2% * FH
244.         _FREEIMAGE tempimage&
245.         EXIT FUNCTION
246.     END IF
247.  
248.     TYPE BMPFormat
249.         ID AS STRING * 2
250.         Size AS LONG
251.         Blank AS LONG
252.         Offset AS LONG
253.         Hsize AS LONG
254.         PWidth AS LONG
255.         PDepth AS LONG
256.         Planes AS INTEGER
257.         BPP AS INTEGER
258.         Compression AS LONG
259.         ImageBytes AS LONG
260.         Xres AS LONG
261.         Yres AS LONG
262.         NumColors AS LONG
263.         SigColors AS LONG
264.     END TYPE
265.  
266.  
267.     DIM BMP AS BMPFormat
268.     DIM x AS LONG, y AS LONG
269.     DIM temp AS STRING ', t AS STRING * 1
270.  
271.     DIM n AS _MEM, o AS _OFFSET, m AS _MEM
272.     m = _MEMIMAGE(image&)
273.  
274.     IF x1% > x2% THEN SWAP x1%, x2%
275.     IF y1% > y2% THEN SWAP y1%, y2%
276.     IF x2% = _WIDTH(imagehandle%) THEN x2% = _WIDTH(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen
277.     IF y2% = _HEIGHT(imagehandle%) THEN y2% = _HEIGHT(imagehandle%) - 1 'troubleshoot in case user does a common mistake for 0-width instead of 0 - (width-1) for fullscreen
278.  
279.     s& = _SOURCE
280.     _SOURCE image&
281.  
282.     BMP.PWidth = (x2% - x1%) + 1
283.     BMP.PDepth = (y2% - y1%) + 1
284.     BMP.ID = "BM"
285.     BMP.Blank = 0
286.     BMP.Hsize = 40
287.     BMP.Planes = 1
288.     BMP.Compression = 0
289.     BMP.Xres = 0
290.     BMP.Yres = 0
291.  
292.     BMP.SigColors = 0
293.  
294.     SELECT CASE _PIXELSIZE(image&)
295.         CASE 1
296.             temp = SPACE$(x2% - x1% + 1)
297.             OffsetBITS& = 54 + 1024 'add palette in 256 color modes
298.             BMP.BPP = 8
299.             IF BMP.PWidth MOD 4 THEN ZeroPAD$ = SPACE$(4 - (BMP.PWidth MOD 4))
300.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
301.             BMP.ImageBytes = ImageSize&
302.             BMP.NumColors = 256
303.             BMP.Size = ImageSize& + OffsetBITS&
304.             BMP.Offset = OffsetBITS&
305.         CASE 4
306.             temp = SPACE$(3)
307.             OffsetBITS& = 54 'no palette in 24/32 bit
308.             BMP.BPP = 24
309.             IF ((BMP.PWidth * 3) MOD 4) THEN ZeroPAD$ = SPACE$(4 - ((BMP.PWidth * 3) MOD 4))
310.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
311.             BMP.ImageBytes = ImageSize&
312.             BMP.NumColors = 0
313.             BMP.Size = ImageSize& * 3 + OffsetBITS&
314.             BMP.Offset = OffsetBITS&
315.     END SELECT
316.  
317.     n = _MEMNEW(BMP.Size)
318.     _MEMPUT n, n.OFFSET, BMP
319.     o = n.OFFSET + 54
320.     zp& = LEN(ZeroPAD$)
321.     $CHECKING:OFF
322.  
323.     IF BMP.BPP = 8 THEN 'Store the Palette for 256 color mode
324.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
325.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
326.             b$ = CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
327.             _MEMPUT n, o, b$
328.             o = o + 4
329.         NEXT
330.         y = y2% + 1
331.         w& = _WIDTH(image&)
332.         x = x2% - x1% + 1
333.         DO
334.             y = y - 1
335.             _MEMGET m, m.OFFSET + (w& * y + x1%), temp
336.             _MEMPUT n, o, temp
337.             o = o + x
338.             _MEMPUT n, o, ZeroPAD$
339.             o = o + zp&
340.         LOOP UNTIL y = y1%
341.     ELSE
342.         y = y2% + 1
343.         w& = _WIDTH(image&)
344.         DO
345.             y = y - 1: x = x1% - 1
346.             DO
347.                 x = x + 1
348.                 _MEMGET m, m.OFFSET + (w& * y + x) * 4, temp
349.                 _MEMPUT n, o, temp
350.                 o = o + 3
351.             LOOP UNTIL x = x2%
352.             _MEMPUT n, o, ZeroPAD$
353.             o = o + zp&
354.         LOOP UNTIL y = y1%
355.     END IF
356.     $CHECKING:ON
357.     F = FREEFILE
358.     OPEN filename$ FOR BINARY AS #F
359.     t1$ = SPACE$(BMP.Size)
360.     _MEMGET n, n.OFFSET, t1$
361.     PUT #F, , t1$
362.     CLOSE #F
363.     _SOURCE s&
364.     _MEMFREE m
365.     _MEMFREE n
366. END SUB
367.  

Now note, this makes 3 different images for you, and all of them are a little bit different.

image1 is the parrot loaded into QB64 in 32-bit color mode.  WHY _LOADIMAGE only works with 32-bit images, I don't know.  256 color support simply hasn't ever been added properly for it, for whatever reason.  Since we don't have a native way to load 256 color images, we instead load our 256-color image as a 32-bit image.

image2 is that 32-bit image converted back down to its original 256 colors, preserving the original 256 colors perfectly.  As you can tell from the demo, there's absolutely no difference in it and the 32-bit version we loaded.

image3 is that 32-bit image converted down to 256 colors, but using the standard QB64 256-color palette.  Some things are forced to change slightly, but with this, all your text colors and such are going to be the same values as what you're used to working with.  (COLOR 40 is bright red, for example.)


And that's basically how you'd load and convert a 256-color image into QB64, for use.  :)

[SMcNeill]

in various programming environments on my HP laptop - the last two files are really messed up (color-wise).

As for this point, I'd say that's to be expected.  Not every monitor/computer is calibrated the same.  Most graphics drivers have options so the user can tweak things to their personal liking.  My main PC and my laptop have two very different displays when it comes to shades of colors sometimes.  I tend to watch movies with my laptop, so I want a wide range of dynamic colors, with full shades of black.  On my PC, I tend to play a lot of various games, and I tend to keep the contrast, brightness, and gamma turned up quite a few notches higher than normal, so I can find "hidden" items/areas in the maps easier.  Where one screen might have a color which looks vibrantly golden, on the other, it's more of an ochre-orange.

[Richard]

@ Steve

Thanks for program.

Your program (exactly as per the code box) works with the parrot.

BUT

when I change the first line now to read

image1 = _LOADIMAGE("j:\PAINTcolor256.png", 32)

where my image is stored on the J:\  usb stick (MS PAINT was used to create 256color.bmp and then MS PAINT was used to convert 256color.bmp to 256color.png) - is the result as attached below what you would expect?


  [ You are not allowed to view this attachment ]  


Also if

image1 = _LOADIMAGE("j:\PAINTcolor32bit.png)

I get ERROR MESSAGE

Unhandled Error #9
Line 44 (in main module) Subscript out of range

Line 44 =   IF Pal(i) =t THEN EXIT FOR

So I gather that I cannot use the code for a 32.bit image???

[SMcNeill]

I don’t have a clue how MS Paint converts between BMP and PNG formats.  Both are lossless image formats, so you shouldn’t be seeing any loss/alteration of image values, so I have no clue what’s going on there.

As for the error message, add a ,32 to the end of your loadimage and it should go away.

image1 = _LOADIMAGE(“j:\PAINTcolor32bit.png”, 32)

I’d imagine that’ll eliminate your issue.  (The , 32 tells QB64 that the end image loaded is going to be a 32-bit one, and not whatever your current screen mode is.)

[Petr]

Try my program (copied from offtopic thread about 8 bit graphics). Program will draw the parrot for you on a 256 color screen without any damage. So. If you want to make a game with pictures in 256 colors, here is a tool to upload a picture with 256 colors to the screen with 256 colors. However, the condition would be that all images that you use in the same program must have the same color palette (in case they are to be displayed at the same time). OR you can use different images with 256 colors and different palettes, but in that case you have to display it separately, or at the same time in graphics mode 32 (and then you don't need this program).

Code: QB64: [Select]

1. 'LOADIMAGE256 experimental
2.  
3. '1] Load image as 32 bit image
4. '2] find how much colors image contains. If 256 and less, continue. If more than 256, return -1 as error message. (can be solved with  RhoSigma's ditherring which is a part of SaveImage)
5. '3] create 8 bit image and color palette
6.  
7. '4] BIG ASK IS: If is this image inserted to 8 bit screen, copy image palette to this screen? OR try to do the same palette for both images?
8.  
9.  
10. SCREEN _NEWIMAGE(800, 600, 256)
11. img8 = LOADIMAGE256("parrot.png")
12. _COPYPALETTE img8, _DEST
13. _PUTIMAGE (0, 0), img8
14.  
15.  
16.  
17.  
18. FUNCTION LOADIMAGE256 (img$)
19.     DEFLNG A-Z
20.     image = _LOADIMAGE(img$, 32)
21.  
22.     DIM m AS _MEM, clr8(255) AS _UNSIGNED LONG, Clr32 AS _UNSIGNED LONG, test AS LONG, s AS LONG
23.  
24.     FOR s = 0 TO 255
25.         clr8(s) = 99999
26.     NEXT s
27.  
28.     m = _MEMIMAGE(image)
29.     DO UNTIL p& = m.SIZE
30.         _MEMGET m, m.OFFSET + p&, Clr32~&
31.  
32.         test = 0
33.         'this block prevent for writing the same color more than 1x to palette array
34.         DO UNTIL test = 255
35.             IF clr8(test) = Clr32~& THEN GOTO NextColor
36.             IF clr8(test) = 99999 THEN EXIT DO
37.             test = test + 1
38.         LOOP
39.  
40.         'if is empty place in palette, save this color as next palette color
41.         IF test > 255 THEN PRINT "Image contains more than 256 colors, can not be directly copyed as 8 bit image": END
42.         clr8(test) = Clr32
43.  
44.         'color is saved as palette for 8 bit image
45.         NextColor: p& = p& + 4
46.     LOOP
47.  
48.     image8 = _NEWIMAGE(_WIDTH(image), _HEIGHT(image), 256)
49.  
50.     'set palette
51.     DIM N AS _MEM, C AS _UNSIGNED _BYTE
52.     N = _MEMIMAGE(image8)
53.     FOR palett = 0 TO 255
54.         _PALETTECOLOR palett, clr8(palett), image8
55.     NEXT
56.  
57.  
58.     'create 8 bit mask (set colors 0 to 255 to 8 bit image)
59.     FOR C = 255 TO 0 STEP -1
60.         clr~& = clr8(C)
61.         R& = 0
62.         R8& = 0
63.         DO UNTIL R& = m.SIZE
64.             _MEMGET m, m.OFFSET + R&, Clr32
65.             IF Clr32 = clr~& THEN _MEMPUT N, N.OFFSET + R8&, C
66.             R& = R& + 4
67.             R8& = R8& + 1
68.         LOOP
69.     NEXT C
70.  
71.     LOADIMAGE256 = _COPYIMAGE(image8, 256)
72.     _MEMFREE m
73.     _MEMFREE N
74.     _FREEIMAGE image
75.     _FREEIMAGE image8
76. END FUNCTION
77.  
78.  

  [ You are not allowed to view this attachment ]  

[Richard]

Just edited to include conversion of Steve's temp.png by SpriggySprings (this conversion use here has not yet been OK and so may be removed by me at anytime

@ Steve thankyou for your replies

Sorry that this reply is going to be a bit long

Results now of my testing your program

As suggested by you, I added the   ,32    at the end of _LOADIMAGE and with my program which is actually 3 copies of your program to show original size of your parrot, a 4x scale up of parrot, and my image being tested (your parrot.png, your temp.png, PAINTcolor256.png, PAINTcolor32bit.png and 16777216colors.png this last file that I downloaded from the internet was used in MS PAINT to create the previous two PAINT....png files). All 5 .png files are included at the end as attachments to make it easier for others to have access to if they wish. A slight modification to your program is that all three of your outputs are simultaneously display on the one screen.

NOTE   file names have been altered to include bit depth information for each file  eg (depth 8) for the parrot

Outputs:-

[depth 8]Parrot.png,32.png
  [ You are not allowed to view this attachment ]  



[depth 24]16777216colors.png,32.png
  [ You are not allowed to view this attachment ]  



[depth 32]PAINTcolor32bit.png,32.png
  [ You are not allowed to view this attachment ]  



[depth 32]PAINTcolor256.png,32.png
  [ You are not allowed to view this attachment ]  



[depth 32]temp.png,32.png
  [ You are not allowed to view this attachment ]  




At the bottom left should idealy be 3 images (as per Steve's program - the Parrot test is trivial since we know it already works). If fewer than 3 images occur it is because of the ERROR

Unhandled error #9
Line ... (in main module)
Subscript out of range

The Line in question is

If Pal(i) = t then EXIT FOR

Refer the code fragment just below to see where this is.

A program line was included to print out i every time this line was called  - the LAST VALUE OF i was always 256 (and then the Error Window popped up)


 
Code fragment from Steve's program above   

Code: QB64: [Select]

1.     DO 'get the palette and number of colors used
2.         _MEMGET m(0), m(0).OFFSET + o, t 'Get the colors from the original screen
3.         FOR i = 0 TO colors 'check to see if they're in the existing palette we're making
4.             IF Pal(i) = t THEN EXIT FOR
5.         NEXT
6.         IF i > colors THEN
7.             Pal(colors) = t
8.             colors = colors + 1 'increment the index for the new color found
9.             IF colors > 256 THEN 'no need to check any further; it's not a normal QB64 256 color image
10.                 Image32To256 = RemapImageFS(image&, I256)
11.                 _FREEIMAGE I256
12.                 _MEMFREE m()
13.                 EXIT FUNCTION 'and we're done, with 100% image compatability saved
14.  

@ Petr

Thankyou for your replies

I ran your program as is (with only very minor changes) and the outputs are as follows:-


Petr 800x600x256 (depth 8) parrot.png.PNG
  [ You are not allowed to view this attachment ]  



Petr 800x600x256 (depth 24) 16777216colors.png.png
  [ You are not allowed to view this attachment ]  



Petr 800x600x256 (depth 32) PAINTcolor32bit.png.png
 [ You are not allowed to view this attachment ]  





Petr 800x600x256 (depth 32) PAINTcolor256,png.png
  [ You are not allowed to view this attachment ]  



Petr 800x600x256 (depth 32) Steve's temp.png.png
  [ You are not allowed to view this attachment ]  

 

Petr 800x600x32 (depth 8) Parrot.png.png
  [ You are not allowed to view this attachment ]

 

Petr 800x600x32 (depth 24) 16777216colors.png.png
  [ You are not allowed to view this attachment ]  



Petr 800x600x32 (depth 32) PAINTcolor32bit.png.PNG
  [ You are not allowed to view this attachment ]  



Petr 800x600x32 (depth 32) PAINTcolor256.png.png
  [ You are not allowed to view this attachment ]  



Petr 800x600x32 (depth 32) Steve's temp.png.png
  [ You are not allowed to view this attachment ]  





Error Message

Unhandled Error #5
Line: 19 (in main module)
Illegal function call

The line in question is

_COPYPALETTE img8, _DEST


NOTE   eg   Petr 800x600x256  represents SCREEN _NEWIMAGE(800, 600,256)    img8 is my test file (5 altogether)


I suppose there is nothing really else I could add to this thread - sorry for the long length.

[Petr]

Of course. It's hard to copy a palette to a 32-bit screen. This program is for 8-bit screens, not others.