Save Image 2.3d

[SMcNeill]

Below is an overhauled version of the SaveImage library which should do several things for us over the old version 2.1:

1) It should fix the CRC error which we were generating in the past, in the IEND file segment, allowing the PNG image files to be loaded and used in any external program which we want to use it with.

2) It should now completely remove any need for the zlib DLL files which it required in the past, and, as such, should allow for PNG file exports in both Linux and Mac systems now.

3) It should be considerably smaller of a library than what the previous versions were.

A few minor changes of note:

I removed the PNGImport routine from the library, as nobody ever uses it since _LOADIMAGE works just fine with PNG files for us.   Also, the Deflate and Inflate routines were removed from the library, as QB64 now supports those keywords naively from version 1.4 upward.  The zlib DLL files were removed, as well as the String Compress Demo.

All-in-all, this should now be a much leaner library with a lot fewer files and requirements bundled with it and into it.


From my testing, it seems to work as expected on my PC, in a Windows 10 environment.  As I don't have a Mac or Linux, (or older versions of Windows anymore), I'll leave those systems for others to test and report back on for us.

Kick it around, test it out, and let me know how it performs for you guys.  :)


And a quick link to past versions of this topic, for those who might be interested: https://www.qb64.org/forum/index.php?topic=1605.0

(If nobody reports any issues with anything, the librarian might want to update the link and information in the sample area to reflect the latest changes, in about a week or so.)


EDIT: Nov-30-2021:

Version 2.3c has now been replaced with version 2.3d, which addresses the glitch from recursive function calls introduced when QB64 upgraded to version 2.0.  If you have a version older than 2.3d, you *will* need to upgrade if you're using QB64 v2.0 or higher.  For older versions of QB64, the updated v 2.3d works just fine as well, so there's no reason NOT to update, but it's an optional improvement for you guys, in case bandwidth or some such is an issue for you.  2.3d is only *required* if you're using QB64 v2.0 or newer; otherwise there's no real improvement or functionality change in the two versions from 2.3c and 2.3d except for the function call.

[_vince]

Congratulations on the new release and fixing the CRC issues, this is very useful, Steve.

If you or someone can attach a sample PNG image then I can test it with a myriad of apps like I have in the past.

[Petr]

Hi Steve.

1) thank you very much for this perfect library!
2) Which function inside SaveImage performs (apparently) dithering, or another form of conversion to 256 colors?

3) I used the previous version to reduce the size of photos in the directory in bulk (at work, there is limited space for attachments) and on that occasion I came across a bug with the GIF format. I
    made reducing the files size easily - by adjusting the aspect ratio.

In the new version, I tried to make the same error with the GIF format, and unfortunately I succeeded. Could you please see what is causing this? Here is a program that will reliably invoke it from me:

Code: QB64: [Select]

1. '$include:'saveimage.bi'
2. img = _SCREENIMAGE
3. Result = SaveImage("test.gif", img, 0, 0, _WIDTH(img), _HEIGHT(img)) 'save the new one again
4. '$include:'saveimage.bm'
5.  

Program wrote some bug, BUT gif file is created correctly. :)

[SMcNeill]

@Petr: Your dimensions are too big, so it tosses you an error.  (An internal error catcher should find and report the issue for you, but apparently it's not working for the GIF format.  I'll check into that.)

Try it as this:

Code: [Select]

'$include:'saveimage.bi'
img = _SCREENIMAGE
Result = SaveImage("test.gif", img, 0, 0, _WIDTH(img) - 1, _HEIGHT(img) - 1) 'save the new one again
'$include:'saveimage.bm'
Remember, _WIDTH and _HEIGHT gives you the *total* number of pixels across and down...  On a screen which is 1280x720, your dimenstions would be 0 to 1279 wide and 0 to 719 high, for example.  By passing the routine a size of 0 to width and 0 to height, you're going beyond the edge of your screen, and that's generating the error for you.  ;)

[Petr]

Yeah! So the bug is on my side! Thank you, Steve. Just - the same assignment for JPG, PNG or BMP works correctly, I'll add a test to that library for GIF,  when I forget to remove a pixel on each axis again in future...

Thank you :)

[RhoSigma]

Thank you very much Steve for the update, so far I found no issues on my side (Windows7 Home).

@Petr
Your question 2.) about dithering to 256 colors, it's FUNCTION RemapImageFS&(), which is originated from my GuiTools Framework and used (with permission) in Steve's library. It does Floyd-Steinberg dithering of any given image using the current 256 color palette of the designated 8-bit destination image (or screen).

[SierraKen]

This is way cool! Thanks Steve! I never tried the first ones you did. I ran your first .jpg test and it runs good. Then I made my own .bmp picture and set it to InitialImage$ = "BMPTest.bmp" and that came out perfect as well! This means we can make drawing apps that save to .png. Off hand I know how to save to .bmp with the example code on the wiki page and then I could run it through this to save as .png. But I wonder, is there a way to skip the bmp code and just save it directly as .png when using SCREEN _NEWIMAGE(800,600,32) ? I'm guessing there is somehow.

[Petr]

Thank for reply, RhoSigma! It is sooo fast!

SierraKen:
You can now save your screen directly as PNG image:

Code: QB64: [Select]

1. '$include:'saveimage.bi'
2. $COLOR:32
3.  
4. SCREEN _NEWIMAGE(1024, 768, 32)
5. CLS , Black 'without this, contains PNG file transparent background
6. CIRCLE (512, 384), 250, Yellow
7.  
8. Result = SaveImage("circle.png", 0, 0, 0, _WIDTH(img), _HEIGHT(img)) 'first zero is your screen, second zero is X start, 3th zero is y start
9.  
10.  
11. 'also you can write it as:
12. circle2 = _NEWIMAGE(1024, 768, 32)
13. CurrentScreen = _DEST
14. _DEST circle2
15. CLS , Black
16. CIRCLE (512, 384), 250, White
17. _DEST CurrentScreen
18. Result = SaveImage("circle2.png", circle2, 0, 0, _WIDTH(img), _HEIGHT(img)) 'now you see none WHITE circle. Circle is created in unseen screen and then saved.
19. '$include:'saveimage.bm'
20.  

Just be careful, after the file is created, it is not overwritten by the new version with the same name again. You must first delete the original image, for example directly from QB64 with the KILL command.

[SMcNeill]

Thank you very much Steve for the update, so far I found no issues on my side (Windows7 Home).

@Petr
Your question 2.) about dithering to 256 colors, it's FUNCTION RemapImageFS&(), which is originated from my GuiTools Framework and used (with permission) in Steve's library. It does Floyd-Steinberg dithering of any given image using the current 256 color palette of the designated 8-bit destination image (or screen).

Note, SaveImage offers you a few options which Rho's Function doesn't have, all by itself.  As per the notes inside the demo:

Code: [Select]

'CONST ConvertToStandard256Palette = 0
'                             Set the value to 0 (FALSE) to preserve the color information perfectly, using its default palette.
'                             If the CONST is set (TRUE), then we convert our colors to as close of a match as possible, while
'                             preserving the standard QB64 256-color palette.
'                             Commented here, simply to help folks know that it exists for use when converting a 32 bit image
'                             down to 256 colors, such as what the GIF routine has to do for us (GIFs are limited to 256 color images)
SaveImage comes prepackaged with a nice toggle CONST, which is rather quite ingenius, if I say so myself.  ;)

When CONST ConvertToStandard256Palette = False, SaveImage tries its best to save your image palette as close to perfect as it can.  This ends up producing a non-standard QB64 palette, where each number is remapped to whatever suits the image itself the best, to try and preserve the brightest and most vibrant image which is as true to the original, as possible.

When CONST ConvertToStandard256Palette = True, SaveImage dithers the original image so that it has to work with the original QB64 256 color palette, as it normally exists for us.  This option is real useful if we want to use an image and then print on the screen, using our standard color palette.

With ConvertToStandard256Palette False, Color 40 might be a shade of some oddish purple, to help the picture look as close to the original as possible.  When ConvertToStandard256Palette is False, COLOR 40 is going to be RED -- the same color which it always is for us, when we _LOADIMAGE (x, y, 256) a 256 color screen.

Note, all this is done and takes place in our helper FUNCTION here:

Code: QB64: [Select]

1. FUNCTION Image32To256 (image&)
2.     'This routine can benefit/be altered if the user sets a CONST or DIM SHARED variable name ConvertToStandard256Palette, as so:
3.     '     CONST ConvertToStandard256Palette = -1
4.     '           Set the value to 0 (FALSE) to preseve the color information perfectly, using its default palette.
5.     '           If the CONST is set (TRUE), then we convert our colors to as close of a match as possible, while
6.     '           preserving the standard QB64 256-color palette.
7.     DIM o AS _OFFSET
8.     DIM a AS _UNSIGNED _BYTE, r AS _UNSIGNED _BYTE
9.     DIM g AS _UNSIGNED _BYTE, b AS _UNSIGNED _BYTE
10.     DIM t AS _UNSIGNED LONG, color256 AS _UNSIGNED LONG
11.     DIM index256 AS _UNSIGNED LONG
12.     TYPE Pal_type
13.         c AS _UNSIGNED LONG 'color index
14.         n AS LONG 'number of times it appears
15.     END TYPE
16.     DIM Pal(255) AS _UNSIGNED LONG
17.     I256 = _NEWIMAGE(_WIDTH(image&), _HEIGHT(image&), 256)
18.     DIM m(1) AS _MEM: m(0) = _MEMIMAGE(image&): m(1) = _MEMIMAGE(I256)
19.     DO 'get the palette and number of colors used
20.         _MEMGET m(0), m(0).OFFSET + o, t 'Get the colors from the original screen
21.         FOR i = 0 TO colors 'check to see if they're in the existing palette we're making
22.             IF Pal(i) = t THEN EXIT FOR
23.         NEXT
24.         IF i > colors THEN
25.             Pal(colors) = t
26.             colors = colors + 1 'increment the index for the new color found
27.             IF colors > 255 THEN 'no need to check any further; it's not a normal QB64 256 color image
28.                 Image32To256 = RemapImageFS(image&, I256)
29.                 _FREEIMAGE I256
30.                 _MEMFREE m()
31.                 EXIT FUNCTION 'and we're done, with 100% image compatability saved
32.             END IF
33.         END IF
34.         o = o + 4
35.     LOOP UNTIL o >= m(0).SIZE
36.  
37.     '  we might be working with a standard qb64 256 color screen
38.     '  check for that first
39.     colors = colors - 1 'back up one, as we found our limit and aren't needing to set another
40.     FOR i = 0 TO colors 'comparing palette against QB64 256 color palette
41.         t = Pal(i)
42.         index256 = _RGBA(_RED(t), _GREEN(t), _BLUE(t), _ALPHA(t), I256)
43.         color256 = _RGBA32(_RED(index256, I256), _GREEN(index256, I256), _BLUE(index256, I256), _ALPHA(index256, I256))
44.         IF t <> color256 THEN NSCU = -1: EXIT FOR
45.     NEXT
46.     IF NSCU THEN 'it's not a standard QB64 256 color palette, but it's still less than 256 total colors.
47.         IF ConvertToStandard256Palette THEN
48.             TI256 = RemapImageFS(image&, I256)
49.             _MEMFREE m(1) 'free the old memory
50.             _FREEIMAGE I256 'and the old image
51.             I256 = TI256 'replace with the new image
52.             m(1) = _MEMIMAGE(I256) 'and point the mem block to the new image
53.         ELSE
54.             FOR i = 0 TO colors: _PALETTECOLOR i, Pal(i), I256: NEXT 'set the palette
55.         END IF
56.     END IF
57.     'If we didn't change the palette above, we should work 100% with qb64's internal 256 color palette
58.     o = 0
59.     DO 'Get the colors, put them to a 256 color screen, as is
60.         _MEMGET m(0), m(0).OFFSET + o + 3, a
61.         _MEMGET m(0), m(0).OFFSET + o + 2, r
62.         _MEMGET m(0), m(0).OFFSET + o + 1, g
63.         _MEMGET m(0), m(0).OFFSET + o + 0, b
64.         _MEMPUT m(1), m(1).OFFSET + o \ 4, _RGBA(r, g, b, a, I256) AS _UNSIGNED _BYTE
65.         o = o + 4
66.     LOOP UNTIL o >= m(0).SIZE
67.     _MEMFREE m()
68.     Image32To256 = I256
69. END FUNCTION
70.  

Rather than just calling Rho's dithering routine directly, instead SaveImage calls FUNCTION Image32To256 (image&), which does some serious decision making for us.

First, it determines if an image contains less than 256 colors to begin with.  If so, there's no need to dither anything -- we have fewer colors than our possible palette limit already.

Then it determines if those 256 colors align to the standard QB64 palette values.  If so, there's no need to shuffle the palette and make it hard to reference.  It'll use the standard values that we'd normally see for a QB64 screen.

And then, only if it's necessary, it listens to what we told it wanted with ConvertToStandard256Palette = True/False, so it can dither down to either the best, or easiest, image to work with, as I described above).

You can use Rho's routine directly for dithering, if you want, but I'd recommend to use the FUNCTION Image32To256 for its helper functionality, if you want to create images for use inside QB64 itself.  ;)

[SMcNeill]

This is way cool! Thanks Steve! I never tried the first ones you did. I ran your first .jpg test and it runs good. Then I made my own .bmp picture and set it to InitialImage$ = "BMPTest.bmp" and that came out perfect as well! This means we can make drawing apps that save to .png. Off hand I know how to save to .bmp with the example code on the wiki page and then I could run it through this to save as .png. But I wonder, is there a way to skip the bmp code and just save it directly as .png when using SCREEN _NEWIMAGE(800,600,32) ? I'm guessing there is somehow.

As Petr said, SaveImage allows you to directly export PNG images, without having to worry about whether they're BMP or not.   As long as the image is on your screen -- EVEN IF IT'S A TEXT SCREEN 0 -- you can save that image in whichever of the 4 supported formats you desire:  BMP, GIF, JPG, or PNG.

Just change the line here, in Petr's demo for you:

Result = SaveImage("circle.png", 0, 0, 0, _WIDTH(img), _HEIGHT(img))

If you want a BMP file, change the "circle.png" to "circle.bmp".  Same, if you want "circle.jpg" or "circle.gif".  As long as you supply one of the four extensions which are valid, the routine will then save the file to your disk in that designated format for you.

[FellippeHeitor]

If you want a BMP file, change the "circle.png" to "circle.bmp".  Same, if you want "circle.jpg" or "circle.gif".  As long as you supply one of the four extensions which are valid, the routine will then save the file to your disk in that designated format for you.

That's clever. Great job there, Steve.

[SierraKen]

Thanks Petr and Steve! I also tried it with JPG like you said and it works great with the first example. I've never used libraries before I think so I had to make sure both of them are in there.

[Petr]

Steve, your solution for storing images with 256 or fewer colors is the perfect thing. I appreciate working with the palette, it is perfect that if the image is created with the basic palette QB64, it will not change. That's perfect. There is one more option that could be done. But it is not necessary. BMP can also be saved in 16 colors if the image uses this number of colors, or in 2 colors. Coding for these bitmaps is simple. For 16 colors, each pixel is written in 4 bits. The color palette contains 16 palette information, or 2 palette information. For 2 colors, each bit contains 1 pixel color information. The current version of SaveImage creates 24-bit bitmaps, or 8-bit bitmaps, for  although this is sometimes not necessary due to the number of colors. BMP has the advantage that the edges of the color transitions are not destroyed by compression.

I found an old program for this in the depths of my hard drive :)

Code: QB64: [Select]

1. ima = _SCREENIMAGE
2.  
3.  
4. imb = _NEWIMAGE(256, 256, 256)
5. _DEST imb
6.  
7. _PALETTECOLOR 1, _RGB32(255, 255, 0), imb
8. _PALETTECOLOR 0, _RGB32(0, 0, 0), imb
9. LINE (10, 10)-(230, 170), 0, BF
10. CIRCLE (120, 90), 50, 1
11. LINE (60, 60)-(10, 45), 1, B
12. PRINT "Test TEXT"
13. _DEST 0
14.  
15. SCREEN imb
16.  
17. 'nepada pri pokusu ulozit 1 bit screen pro X nedelitelne 32, ale je tam v ose X dole carka a nevim jak se ji zbavit.
18. Save_BMP imb, "test1clr.bmp", 3
19. Save_BMP imb, "test16clr.bmp", 2
20. Save_BMP imb, "test256clr.bmp", 1
21.  
22. 'Save_BMP options:
23. '0 = 32 bit image
24. '1 = 8 bit image
25. '2 = 4 bit image
26. '3 = 1 bit image
27.  
28.  
29.  
30.  
31.  
32.  
33.  
34.  
35. SUB Save_BMP (src AS LONG, file AS STRING, typ AS _UNSIGNED _BYTE) 'typ: 0 = 32 bit, 1 = 256 colors, 2 = 16 colors, 3 = 2 colors   PRO KONVERZI NEJPRVE DITHERINGEM UDELEJ 256 clr zdroj a ten uloz. NELZE ulozit primo 32 bit do 8 bit!
36.     'moje save formule
37.     IF typ = 0 AND _PIXELSIZE(src) < 4 THEN BEEP: BEEP: BEEP: PRINT "Fatal ERROR. Can not save 8 bit source as 32 bit image!": SLEEP 2: END
38.     IF _PIXELSIZE(src&) = 4 AND typ > 0 THEN BEEP: BEEP: PRINT "Use DITHERING subprogram first for converting 32 bit image to 8 / 4 / 1 bit!": SLEEP 2: END
39.  
40.  
41.  
42.  
43.  
44.     TYPE BMP_H
45.         ID AS STRING * 2 'BM                                  a
46.         Size AS LONG 'total file size
47.         Reserved0 AS INTEGER '0                               a
48.         Reserved1 AS INTEGER '0                               a
49.         Data_Start AS LONG ' startovni oblast dat obrazu. U 32 bitu to je hned po hlave, u ostatnich az po 54 + oblast palety - protoze tahle hlava ma 14, nasleduje druha hlava, ktera ma 40 bytu
50.     END TYPE '               image data start area. in 32 bit image it is after head, in others it is after byte 54 + palette area. Because this head is 14 bytes long, is next in file next header, 40 bytes long.
51.  
52.     TYPE BMP_I
53.         Hlava_velikost AS LONG '40                            a      Head size
54.         width AS LONG
55.         height AS LONG
56.         planes AS INTEGER '1                                  a
57.         BPP AS INTEGER '1/4/8/24/32                                  bites per pixel
58.         Compress AS LONG '0/1/2                               a
59.         Image_Size AS LONG '                                  a
60.         Xpels AS LONG '0                                      a
61.         Ypels AS LONG '0                                      a
62.         Total_Colors AS LONG 'muze byt 0    (0, 256, 16, 2)
63.         Important_Colors AS LONG '0                           a
64.     END TYPE
65.  
66.     DIM H AS BMP_H
67.     DIM I AS BMP_I
68.  
69.     DIM v AS _UNSIGNED LONG, v2 AS _UNSIGNED _BYTE
70.  
71.     SELECT CASE typ
72.  
73.         CASE 0: DIM IM(_WIDTH(src) * _HEIGHT(src) - 1) AS _UNSIGNED LONG
74.             I.BPP = 32: I.Total_Colors = 0: Depth = 4: K = 4 '                        32  bit
75.  
76.  
77.         CASE 1: DIM IM2(_WIDTH(src) * _HEIGHT(src) - 1) AS _UNSIGNED _BYTE
78.             I.BPP = 8: I.Total_Colors = 0: Depth = 1: K = 1 '                         256 clrs
79.  
80.  
81.  
82.         CASE 2: DIM IM3(INT(_WIDTH(src) * _HEIGHT(src) - 1) / 2) AS _UNSIGNED _BYTE
83.             I.BPP = 4: I.Total_Colors = 0: Depth = 1: K = .5 '                         16  clrs
84.  
85.         CASE 3:
86.             I.BPP = 1: I.Total_Colors = 0: Depth = 1: K = 1 / 8 '                         2   clrs
87.             index = 1
88.             sire = _WIDTH(src&)
89.             DELTA = sire
90.             o = 0
91.             'OSA X MUSI BYT DELITELNA 32, JINAK DOJDE K CHYBAM.    X axis MUST be dividible by 32!
92.             IF sire MOD 32 THEN
93.                 INPUT "Compatibility warning: You try save 1 bit image, which width is not dividible by 32. This can do problems in some viewers. Autoconvert? (Y/N) "; conv$
94.                 IF UCASE$(conv$) = "N" THEN END
95.  
96.                 _DEST src&
97.                 pal1~& = _PALETTECOLOR(0)
98.                 pal2~& = _PALETTECOLOR(1)
99.                 _DEST 0
100.  
101.                 DO WHILE sire MOD 32 <> 0
102.                     sire = sire + 1
103.                 LOOP
104.                 '                PRINT sire: SLEEP 'ok
105.                 virt& = _NEWIMAGE(sire, _HEIGHT(src&), 256)
106.                 _PUTIMAGE (0, 0)-(sire, _HEIGHT(src&)), src&, virt&
107.                 _FREEIMAGE src&
108.                 src& = _COPYIMAGE(virt&)
109.                 _PALETTECOLOR 0, pal1~&, src&
110.                 _PALETTECOLOR 1, pal2~&, src&
111.                 _FREEIMAGE virt&
112.             END IF
113.             DELTA = DELTA - sire
114.             DIM IM4((_WIDTH(src) * _HEIGHT(src) - 1) / 8) AS _UNSIGNED _BYTE
115.  
116.     END SELECT
117.  
118.     H.Size = (_WIDTH(src) * _HEIGHT(src) * K) + 54: I.height = _HEIGHT(src): I.width = _WIDTH(src)
119.     H.ID = "BM": H.Reserved0 = 0: H.Reserved1 = 0: I.Hlava_velikost = 40: I.planes = 1: I.Compress = 0: I.Image_Size = 0: I.Xpels = 0: I.Ypels = 0: I.Important_Colors = 0
120.     DIM M AS _MEM, N AS _MEM
121.     M = _MEMIMAGE(src&)
122.  
123.  
124.     N = _MEMNEW(I.width * I.height * Depth) 'oblast pameti, kde se bude otacet Y    Memory area for Y rotating.
125.     index = 0
126.     IF typ >= 2 THEN o = 1
127.     FOR y = (_HEIGHT(src&)) - 1 TO 0 STEP -1
128.         FOR x = 0 TO (_WIDTH(src&) - 1)
129.  
130.             SELECT CASE typ
131.                 CASE 0
132.                     _MEMGET M, M.OFFSET + o, v
133.                     _MEMPUT N, N.OFFSET + in(x, y, src&), v
134.                     o = o + 4
135.                 CASE 1
136.                     _MEMGET M, M.OFFSET + o, v2
137.                     _MEMPUT N, N.OFFSET + in(x, y, src&), v2
138.                     o = o + 1
139.                 CASE 2
140.                     _MEMGET M, M.OFFSET + in(x, y, src&), v2
141.                     IF o MOD 2 <> 0 THEN
142.                         left = v2 AND 15
143.  
144.                     ELSE
145.                         right = v2 AND 15
146.                         IM3(index) = 16 * left + right: index = index + 1: left = 0: right = 0
147.                     END IF
148.                     o = o + 1
149.                 CASE 3
150.                     ' IF y >= _HEIGHT(src) - 2 THEN GOTO n
151.                     _MEMGET M, M.OFFSET + in(x, y, src&), v2
152.                     IF v2 > 0 THEN vl~%% = 1 ELSE vl~%% = 0
153.                     IF o = 7 THEN P1 = vl~%%
154.                     IF o = 6 THEN P2 = vl~%%
155.                     IF o = 5 THEN P3 = vl~%%
156.                     IF o = 4 THEN P4 = vl~%%
157.                     IF o = 3 THEN P5 = vl~%%
158.                     IF o = 2 THEN P6 = vl~%%
159.                     IF o = 1 THEN P7 = vl~%%
160.                     IF o = 0 THEN P8 = vl~%%
161.  
162.                     IF x MOD 8 = 0 THEN
163.  
164.                         IM4(index) = ((P8 * 128) + (P7 * 64) + (P6 * 32) + (P5 * 16) + (P4 * 8) + (P3 * 4) + (P2 * 2) + P1)
165.                         P1 = 0: P2 = 0: P3 = 0: P4 = 0: P5 = 0: P6 = 0: P7 = 0: P8 = 0
166.                         o = -1
167.                         index = index + 1
168.                     END IF
169.                     o = o + 1
170.                     O2 = O2 + 1
171.                     n:
172.             END SELECT
173.     NEXT x, y
174.  
175.     SELECT CASE typ
176.         CASE 0
177.             '           _MEMFREE M
178.             _MEMGET N, N.OFFSET, IM()
179.             _MEMFREE N
180.         CASE 1
181.             '            _MEMFREE M
182.             _MEMGET N, N.OFFSET, IM2()
183.             _MEMFREE N
184.         CASE 2, 3
185.             '           _MEMFREE M
186.             _MEMFREE N
187.     END SELECT
188.  
189.     ch = FREEFILE
190.     OPEN file FOR OUTPUT AS #ch: CLOSE #ch: OPEN file FOR BINARY AS #ch
191.     PUT #ch, , H
192.     PUT #ch, , I
193.     SELECT CASE typ
194.         CASE 0: PUT #ch, , IM()
195.         CASE 1:
196.             FOR Palete = 0 TO 255
197.                 v = _PALETTECOLOR(Palete, src&)
198.                 PUT #ch, , v
199.             NEXT
200.             PUT #ch, , IM2()
201.  
202.         CASE 2:
203.             FOR Palete = 0 TO 15
204.                 v = _PALETTECOLOR(Palete, src&)
205.                 PUT #ch, , v
206.             NEXT
207.             PUT #ch, , IM3()
208.  
209.  
210.         CASE 3:
211.             FOR Palete = 0 TO 1
212.                 v = _PALETTECOLOR(Palete, src&)
213.                 PUT #ch, , v
214.             NEXT
215.             PUT #ch, , IM4()
216.     END SELECT
217.     _MEMFREE M
218.     _DELAY .5
219. END SUB
220.  
221. FUNCTION in& (x AS INTEGER, y AS INTEGER, src&)
222.     in& = _PIXELSIZE(src&) * (y * _WIDTH(src&) + x)
223. END FUNCTION
224.  

As I tested in which BMP formats your library stores files, I got an error - Illegal function call.  See:

Code: QB64: [Select]

1. '$include:'saveimage.bi'
2. SCREEN _NEWIMAGE(1024, 768, 32) 'if is this row commented, error not occur
3. img = _NEWIMAGE(500, 800, 256) 'if is here used 32 bit image, error not occur
4. _DEST img
5. CLS
6. CIRCLE (512, 384), 250, 1
7. _DEST 0
8. Result = SaveImage("circle.bmp", img, 0, 0, _WIDTH(img) - 1, _HEIGHT(img) - 1)
9. END
10. '$include:'saveimage.bm'
11.  

I found and repair bug in your SAVEBMP:

Code: QB64: [Select]

1. SUB SaveBMP (filename$, image&, x1%, y1%, x2%, y2%)
2.     'Super special STEVE-Approved BMP Export routine for use with any QB64 graphic mode.
3.     IF x2% = _WIDTH(image&) THEN x2% = x2% - 1
4.     IF y2% = _HEIGHT(image&) THEN y2% = y2% - 1
5.  
6.     IF _PIXELSIZE(image&) = 0 THEN
7.         IF SaveTextAs256Color THEN
8.             tempimage& = TextScreenToImage256&(image&)
9.         ELSE
10.             tempimage& = TextScreenToImage32&(image&)
11.         END IF
12.         F = _FONT(image&)
13.         FW = _FONTWIDTH(F): FH = _FONTHEIGHT(F)
14.         SaveBMP filename$, tempimage&, x1% * FW, y1% * FH, x2% * FW, y2% * FH
15.         _FREEIMAGE tempimage&
16.         EXIT FUNCTION
17.     END IF
18.  
19.     TYPE BMPFormat
20.         ID AS STRING * 2
21.         Size AS LONG
22.         Blank AS LONG
23.         Offset AS LONG
24.         Hsize AS LONG
25.         PWidth AS LONG
26.         PDepth AS LONG
27.         Planes AS INTEGER
28.         BPP AS INTEGER
29.         Compression AS LONG
30.         ImageBytes AS LONG
31.         Xres AS LONG
32.         Yres AS LONG
33.         NumColors AS LONG
34.         SigColors AS LONG
35.     END TYPE
36.  
37.  
38.     DIM BMP AS BMPFormat
39.     DIM x AS LONG, y AS LONG
40.     DIM temp AS STRING, t AS STRING * 1
41.  
42.     DIM n AS _MEM, o AS _OFFSET, m AS _MEM
43.     m = _MEMIMAGE(image&)
44.  
45.     IF x1% > x2% THEN SWAP x1%, x2%
46.     IF y1% > y2% THEN SWAP y1%, y2%
47.     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
48.     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
49.  
50.     s& = _SOURCE
51.     _SOURCE image&
52.  
53.     BMP.PWidth = (x2% - x1%) + 1
54.     BMP.PDepth = (y2% - y1%) + 1
55.     BMP.ID = "BM"
56.     BMP.Blank = 0
57.     BMP.Hsize = 40
58.     BMP.Planes = 1
59.     BMP.Compression = 0
60.     BMP.Xres = 0
61.     BMP.Yres = 0
62.  
63.     BMP.SigColors = 0
64.  
65.     SELECT CASE _PIXELSIZE(image&)
66.         CASE 1
67.             temp = SPACE$(x2% - x1% + 1)
68.             OffsetBITS& = 54 + 1024 'add palette in 256 color modes
69.             BMP.BPP = 8
70.             IF BMP.PWidth MOD 4 THEN ZeroPAD$ = SPACE$(4 - (BMP.PWidth MOD 4))
71.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
72.             BMP.ImageBytes = ImageSize&
73.             BMP.NumColors = 256
74.             BMP.Size = ImageSize& + OffsetBITS&
75.             BMP.Offset = OffsetBITS&
76.         CASE 4
77.             temp = SPACE$(3)
78.             OffsetBITS& = 54 'no palette in 24/32 bit
79.             BMP.BPP = 24
80.             IF ((BMP.PWidth * 3) MOD 4) THEN ZeroPAD$ = SPACE$(4 - ((BMP.PWidth * 3) MOD 4))
81.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
82.             BMP.ImageBytes = ImageSize&
83.             BMP.NumColors = 0
84.             BMP.Size = ImageSize& * 3 + OffsetBITS&
85.             BMP.Offset = OffsetBITS&
86.     END SELECT
87.  
88.     F = FREEFILE
89.     n = _MEMNEW(BMP.Size)
90.     _MEMPUT n, n.OFFSET, BMP
91.     o = n.OFFSET + 54
92.     zp& = LEN(ZeroPAD$)
93.     $CHECKING:OFF
94.  
95.     IF BMP.BPP = 8 THEN 'Store the Palette for 256 color mode
96.  
97.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
98.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
99.             b$ = CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
100.             _MEMPUT n, o, b$
101.             o = o + 4
102.         NEXT
103.         y = y2% + 1
104.         w& = _WIDTH(image&)
105.         x = x2% - x1% + 1
106.         DO
107.             y = y - 1
108.             _MEMGET m, m.OFFSET + (w& * y + x1%), temp
109.             _MEMPUT n, o, temp
110.             o = o + x
111.             _MEMPUT n, o, ZeroPAD$
112.             o = o + zp&
113.         LOOP UNTIL y = y1%
114.     ELSE
115.         y = y2% + 1
116.         w& = _WIDTH(image&)
117.         DO
118.             y = y - 1: x = x1% - 1
119.             DO
120.                 x = x + 1
121.                 _MEMGET m, m.OFFSET + (w& * y + x) * 4, temp
122.                 _MEMPUT n, o, temp
123.                 o = o + 3
124.             LOOP UNTIL x = x2%
125.             _MEMPUT n, o, ZeroPAD$
126.             o = o + zp&
127.         LOOP UNTIL y = y1%
128.     END IF
129.     $CHECKING:ON
130. rem    _MEMFREE m
131.  
132.     OPEN filename$ FOR BINARY AS #F
133.     t1$ = SPACE$(BMP.Size)
134.     _MEMGET n, n.OFFSET, t1$
135.     PUT #F, , t1$
136. rem    _MEMFREE n
137.     CLOSE #F
138.     _SOURCE s&
139.  _MEMFREE n
140.   _MEMFREE m
141. END SUB
142.  

[SMcNeill]

Updated image library with several small fixes.  (I told you guys v2.3 needed a little testing before going "official". :D)

First, change was made so that glitches due to using _WIDTH and _HEIGHT will be corrected automatically, rather than tossing an error as Petr pointed out earlier here: https://www.qb64.org/forum/index.php?topic=2701.msg119079#msg119079.

Second, the error handler which reports ERROR 12 for PNG files has been removed.  (ERROR 12 -- PNG save is impossible on non-Windows systems.  Can only use BMP, JPG, GIF.)  I'm surprised nobody reported this one and I somehow managed to stumble across it and find it.  SaveImage *should* work on Linux and Mac systems now -- that was the main purpose of the upgrade from the old version to this versions -- but who knows when someone with one of those systems can actually test things out for us and report back to us....

Third, the glitch in BMP exports of 256 color images was corrected.  The issue here, once again, was nothing more than a typo. (As reported by Petr here: https://www.qb64.org/forum/index.php?topic=2701.msg119143#msg119143 ) 

The original line read:

            cv& = _PALETTECOLOR(c&, image) ' color attribute to read.

What it should've read is:

            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.

As long as you had a DEFLNG A-Z at the top of your program (which is what I usually default to, making this a hard glitch for me to normally find), image would default to a long and would be the same variable as image&...  Without a DEFLNG (or _DEFINE ... AS LONG), image <> image&, and it's a glitch in the code.  This has been corrected and shouldn't be an issue in the future, regardless of default data type.


New version 2.3a is now available for download (as an attachment at the bottom of the first post in this topic), so you might want to grab it and discard the old version.  If any more bugs/glitches are found, I'll correct them as they come to my attention and update our versions as necessary.

[Petr]

Hi Steve, again me (the damager)

Try this code using latest 2.3a library:

Code: QB64: [Select]

1. '$include:'saveimage.bi'
2. PRINT TIME$
3. Result = SaveImage("test.gif", 0, 0, 0, _WIDTH - 1, _HEIGHT - 1)
4. '$include:'saveimage.bm'
5.