Author Topic: Save Image 2.3d  (Read 15073 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Save Image 2.3d
« on: June 11, 2020, 08:39:57 am »
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.
* SaveImage v2.3d.7z (Filesize: 29.95 KB, Downloads: 129)
« Last Edit: November 30, 2021, 04:36:59 pm by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Save Image 2.3 (Needs Testing)
« Reply #1 on: June 11, 2020, 09:56:00 am »
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.

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Save Image 2.3 (Needs Testing)
« Reply #2 on: June 11, 2020, 10:47:35 am »
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. Result = SaveImage("test.gif", img, 0, 0, _WIDTH(img), _HEIGHT(img)) 'save the new one again
  3. '$include:'saveimage.bm'
  4.  

Program wrote some bug, BUT gif file is created correctly. :)
« Last Edit: June 11, 2020, 10:55:15 am by Petr »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Save Image 2.3 (Needs Testing)
« Reply #3 on: June 11, 2020, 10:54:26 am »
@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.  ;)

https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Save Image 2.3 (Needs Testing)
« Reply #4 on: June 11, 2020, 10:59:26 am »
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 :)

Offline RhoSigma

  • QB64 Developer
  • Forum Resident
  • Posts: 565
    • View Profile
Re: Save Image 2.3 (Needs Testing)
« Reply #5 on: June 11, 2020, 12:58:22 pm »
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).
My Projects:   https://qb64forum.alephc.xyz/index.php?topic=809
GuiTools - A graphic UI framework (can do multiple UI forms/windows in one program)
Libraries - ImageProcess, StringBuffers (virt. files), MD5/SHA2-Hash, LZW etc.
Bonus - Blankers, QB64/Notepad++ setup pack

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Save Image 2.3 (Needs Testing)
« Reply #6 on: June 11, 2020, 01:32:17 pm »
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.

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Save Image 2.3 (Needs Testing)
« Reply #7 on: June 11, 2020, 02:17:59 pm »
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.  
  3. SCREEN _NEWIMAGE(1024, 768, 32)
  4. CLS , Black 'without this, contains PNG file transparent background
  5. CIRCLE (512, 384), 250, Yellow
  6.  
  7. 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
  8.  
  9.  
  10. 'also you can write it as:
  11. circle2 = _NEWIMAGE(1024, 768, 32)
  12. CurrentScreen = _DEST
  13. _DEST circle2
  14. CLS , Black
  15. CIRCLE (512, 384), 250, White
  16. _DEST CurrentScreen
  17. 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.
  18. '$include:'saveimage.bm'
  19.  

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.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Save Image 2.3 (Needs Testing)
« Reply #8 on: June 11, 2020, 06:58:03 pm »
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 t AS _UNSIGNED LONG, color256 AS _UNSIGNED LONG
  9.     DIM index256 AS _UNSIGNED LONG
  10.     TYPE Pal_type
  11.         c AS _UNSIGNED LONG 'color index
  12.         n AS LONG 'number of times it appears
  13.     END TYPE
  14.     DIM Pal(255) AS _UNSIGNED LONG
  15.     I256 = _NEWIMAGE(_WIDTH(image&), _HEIGHT(image&), 256)
  16.     DIM m(1) AS _MEM: m(0) = _MEMIMAGE(image&): m(1) = _MEMIMAGE(I256)
  17.     DO 'get the palette and number of colors used
  18.         _MEMGET m(0), m(0).OFFSET + o, t 'Get the colors from the original screen
  19.         FOR i = 0 TO colors 'check to see if they're in the existing palette we're making
  20.             IF Pal(i) = t THEN EXIT FOR
  21.         NEXT
  22.         IF i > colors THEN
  23.             Pal(colors) = t
  24.             colors = colors + 1 'increment the index for the new color found
  25.             IF colors > 255 THEN 'no need to check any further; it's not a normal QB64 256 color image
  26.                 Image32To256 = RemapImageFS(image&, I256)
  27.                 _FREEIMAGE I256
  28.                 _MEMFREE m()
  29.                 EXIT FUNCTION 'and we're done, with 100% image compatability saved
  30.             END IF
  31.         END IF
  32.         o = o + 4
  33.     LOOP UNTIL o >= m(0).SIZE
  34.  
  35.     '  we might be working with a standard qb64 256 color screen
  36.     '  check for that first
  37.     colors = colors - 1 'back up one, as we found our limit and aren't needing to set another
  38.     FOR i = 0 TO colors 'comparing palette against QB64 256 color palette
  39.         t = Pal(i)
  40.         index256 = _RGBA(_RED(t), _GREEN(t), _BLUE(t), _ALPHA(t), I256)
  41.         color256 = _RGBA32(_RED(index256, I256), _GREEN(index256, I256), _BLUE(index256, I256), _ALPHA(index256, I256))
  42.         IF t <> color256 THEN NSCU = -1: EXIT FOR
  43.     NEXT
  44.     IF NSCU THEN 'it's not a standard QB64 256 color palette, but it's still less than 256 total colors.
  45.         IF ConvertToStandard256Palette THEN
  46.             TI256 = RemapImageFS(image&, I256)
  47.             _MEMFREE m(1) 'free the old memory
  48.             _FREEIMAGE I256 'and the old image
  49.             I256 = TI256 'replace with the new image
  50.             m(1) = _MEMIMAGE(I256) 'and point the mem block to the new image
  51.         ELSE
  52.             FOR i = 0 TO colors: _PALETTECOLOR i, Pal(i), I256: NEXT 'set the palette
  53.         END IF
  54.     END IF
  55.     'If we didn't change the palette above, we should work 100% with qb64's internal 256 color palette
  56.     o = 0
  57.     DO 'Get the colors, put them to a 256 color screen, as is
  58.         _MEMGET m(0), m(0).OFFSET + o + 3, a
  59.         _MEMGET m(0), m(0).OFFSET + o + 2, r
  60.         _MEMGET m(0), m(0).OFFSET + o + 1, g
  61.         _MEMGET m(0), m(0).OFFSET + o + 0, b
  62.         _MEMPUT m(1), m(1).OFFSET + o \ 4, _RGBA(r, g, b, a, I256) AS _UNSIGNED _BYTE
  63.         o = o + 4
  64.     LOOP UNTIL o >= m(0).SIZE
  65.     _MEMFREE m()
  66.     Image32To256 = I256
  67.  

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.  ;)
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Save Image 2.3 (Needs Testing)
« Reply #9 on: June 11, 2020, 07:04:17 pm »
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.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

FellippeHeitor

  • Guest
Re: Save Image 2.3 (Needs Testing)
« Reply #10 on: June 11, 2020, 07:05:31 pm »
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.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Save Image 2.3 (Needs Testing)
« Reply #11 on: June 11, 2020, 11:53:38 pm »
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.

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Save Image 2.3 (Needs Testing)
« Reply #12 on: June 12, 2020, 04:32:10 pm »
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.  
  2.  
  3. imb = _NEWIMAGE(256, 256, 256)
  4. _DEST imb
  5.  
  6. _PALETTECOLOR 1, _RGB32(255, 255, 0), imb
  7. _PALETTECOLOR 0, _RGB32(0, 0, 0), imb
  8. LINE (10, 10)-(230, 170), 0, BF
  9. CIRCLE (120, 90), 50, 1
  10. LINE (60, 60)-(10, 45), 1, B
  11. PRINT "Test TEXT"
  12.  
  13. SCREEN imb
  14.  
  15. '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.
  16. Save_BMP imb, "test1clr.bmp", 3
  17. Save_BMP imb, "test16clr.bmp", 2
  18. Save_BMP imb, "test256clr.bmp", 1
  19.  
  20. 'Save_BMP options:
  21. '0 = 32 bit image
  22. '1 = 8 bit image
  23. '2 = 4 bit image
  24. '3 = 1 bit image
  25.  
  26.  
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33. 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!
  34.     'moje save formule
  35.     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
  36.     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
  37.  
  38.  
  39.  
  40.  
  41.  
  42.     TYPE BMP_H
  43.         ID AS STRING * 2 'BM                                  a
  44.         Size AS LONG 'total file size
  45.         Reserved0 AS INTEGER '0                               a
  46.         Reserved1 AS INTEGER '0                               a
  47.         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
  48.     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.
  49.  
  50.     TYPE BMP_I
  51.         Hlava_velikost AS LONG '40                            a      Head size
  52.         width AS LONG
  53.         height AS LONG
  54.         planes AS INTEGER '1                                  a
  55.         BPP AS INTEGER '1/4/8/24/32                                  bites per pixel
  56.         Compress AS LONG '0/1/2                               a
  57.         Image_Size AS LONG '                                  a
  58.         Xpels AS LONG '0                                      a
  59.         Ypels AS LONG '0                                      a
  60.         Total_Colors AS LONG 'muze byt 0    (0, 256, 16, 2)
  61.         Important_Colors AS LONG '0                           a
  62.     END TYPE
  63.  
  64.     DIM H AS BMP_H
  65.     DIM I AS BMP_I
  66.  
  67.  
  68.     SELECT CASE typ
  69.  
  70.         CASE 0: DIM IM(_WIDTH(src) * _HEIGHT(src) - 1) AS _UNSIGNED LONG
  71.             I.BPP = 32: I.Total_Colors = 0: Depth = 4: K = 4 '                        32  bit
  72.  
  73.  
  74.         CASE 1: DIM IM2(_WIDTH(src) * _HEIGHT(src) - 1) AS _UNSIGNED _BYTE
  75.             I.BPP = 8: I.Total_Colors = 0: Depth = 1: K = 1 '                         256 clrs
  76.  
  77.  
  78.  
  79.         CASE 2: DIM IM3(INT(_WIDTH(src) * _HEIGHT(src) - 1) / 2) AS _UNSIGNED _BYTE
  80.             I.BPP = 4: I.Total_Colors = 0: Depth = 1: K = .5 '                         16  clrs
  81.  
  82.         CASE 3:
  83.             I.BPP = 1: I.Total_Colors = 0: Depth = 1: K = 1 / 8 '                         2   clrs
  84.             index = 1
  85.             sire = _WIDTH(src&)
  86.             DELTA = sire
  87.             o = 0
  88.             'OSA X MUSI BYT DELITELNA 32, JINAK DOJDE K CHYBAM.    X axis MUST be dividible by 32!
  89.             IF sire MOD 32 THEN
  90.                 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$
  91.                 IF UCASE$(conv$) = "N" THEN END
  92.  
  93.                 _DEST src&
  94.                 pal1~& = _PALETTECOLOR(0)
  95.                 pal2~& = _PALETTECOLOR(1)
  96.                 _DEST 0
  97.  
  98.                 DO WHILE sire MOD 32 <> 0
  99.                     sire = sire + 1
  100.                 LOOP
  101.                 '                PRINT sire: SLEEP 'ok
  102.                 virt& = _NEWIMAGE(sire, _HEIGHT(src&), 256)
  103.                 _PUTIMAGE (0, 0)-(sire, _HEIGHT(src&)), src&, virt&
  104.                 _FREEIMAGE src&
  105.                 src& = _COPYIMAGE(virt&)
  106.                 _PALETTECOLOR 0, pal1~&, src&
  107.                 _PALETTECOLOR 1, pal2~&, src&
  108.                 _FREEIMAGE virt&
  109.             END IF
  110.             DELTA = DELTA - sire
  111.             DIM IM4((_WIDTH(src) * _HEIGHT(src) - 1) / 8) AS _UNSIGNED _BYTE
  112.  
  113.     END SELECT
  114.  
  115.     H.Size = (_WIDTH(src) * _HEIGHT(src) * K) + 54: I.height = _HEIGHT(src): I.width = _WIDTH(src)
  116.     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
  117.     DIM M AS _MEM, N AS _MEM
  118.     M = _MEMIMAGE(src&)
  119.  
  120.  
  121.     N = _MEMNEW(I.width * I.height * Depth) 'oblast pameti, kde se bude otacet Y    Memory area for Y rotating.
  122.     index = 0
  123.     IF typ >= 2 THEN o = 1
  124.     FOR y = (_HEIGHT(src&)) - 1 TO 0 STEP -1
  125.         FOR x = 0 TO (_WIDTH(src&) - 1)
  126.  
  127.             SELECT CASE typ
  128.                 CASE 0
  129.                     _MEMGET M, M.OFFSET + o, v
  130.                     _MEMPUT N, N.OFFSET + in(x, y, src&), v
  131.                     o = o + 4
  132.                 CASE 1
  133.                     _MEMGET M, M.OFFSET + o, v2
  134.                     _MEMPUT N, N.OFFSET + in(x, y, src&), v2
  135.                     o = o + 1
  136.                 CASE 2
  137.                     _MEMGET M, M.OFFSET + in(x, y, src&), v2
  138.                     IF o MOD 2 <> 0 THEN
  139.                         left = v2 AND 15
  140.  
  141.                     ELSE
  142.                         right = v2 AND 15
  143.                         IM3(index) = 16 * left + right: index = index + 1: left = 0: right = 0
  144.                     END IF
  145.                     o = o + 1
  146.                 CASE 3
  147.                     ' IF y >= _HEIGHT(src) - 2 THEN GOTO n
  148.                     _MEMGET M, M.OFFSET + in(x, y, src&), v2
  149.                     IF v2 > 0 THEN vl~%% = 1 ELSE vl~%% = 0
  150.                     IF o = 7 THEN P1 = vl~%%
  151.                     IF o = 6 THEN P2 = vl~%%
  152.                     IF o = 5 THEN P3 = vl~%%
  153.                     IF o = 4 THEN P4 = vl~%%
  154.                     IF o = 3 THEN P5 = vl~%%
  155.                     IF o = 2 THEN P6 = vl~%%
  156.                     IF o = 1 THEN P7 = vl~%%
  157.                     IF o = 0 THEN P8 = vl~%%
  158.  
  159.                     IF x MOD 8 = 0 THEN
  160.  
  161.                         IM4(index) = ((P8 * 128) + (P7 * 64) + (P6 * 32) + (P5 * 16) + (P4 * 8) + (P3 * 4) + (P2 * 2) + P1)
  162.                         P1 = 0: P2 = 0: P3 = 0: P4 = 0: P5 = 0: P6 = 0: P7 = 0: P8 = 0
  163.                         o = -1
  164.                         index = index + 1
  165.                     END IF
  166.                     o = o + 1
  167.                     O2 = O2 + 1
  168.                     n:
  169.             END SELECT
  170.     NEXT x, y
  171.  
  172.     SELECT CASE typ
  173.         CASE 0
  174.             '           _MEMFREE M
  175.             _MEMGET N, N.OFFSET, IM()
  176.             _MEMFREE N
  177.         CASE 1
  178.             '            _MEMFREE M
  179.             _MEMGET N, N.OFFSET, IM2()
  180.             _MEMFREE N
  181.         CASE 2, 3
  182.             '           _MEMFREE M
  183.             _MEMFREE N
  184.     END SELECT
  185.  
  186.     ch = FREEFILE
  187.     OPEN file FOR OUTPUT AS #ch: CLOSE #ch: OPEN file FOR BINARY AS #ch
  188.     PUT #ch, , H
  189.     PUT #ch, , I
  190.     SELECT CASE typ
  191.         CASE 0: PUT #ch, , IM()
  192.         CASE 1:
  193.             FOR Palete = 0 TO 255
  194.                 v = _PALETTECOLOR(Palete, src&)
  195.                 PUT #ch, , v
  196.             NEXT
  197.             PUT #ch, , IM2()
  198.  
  199.         CASE 2:
  200.             FOR Palete = 0 TO 15
  201.                 v = _PALETTECOLOR(Palete, src&)
  202.                 PUT #ch, , v
  203.             NEXT
  204.             PUT #ch, , IM3()
  205.  
  206.  
  207.         CASE 3:
  208.             FOR Palete = 0 TO 1
  209.                 v = _PALETTECOLOR(Palete, src&)
  210.                 PUT #ch, , v
  211.             NEXT
  212.             PUT #ch, , IM4()
  213.     END SELECT
  214.     _MEMFREE M
  215.     _DELAY .5
  216.  
  217. FUNCTION in& (x AS INTEGER, y AS INTEGER, src&)
  218.     in& = _PIXELSIZE(src&) * (y * _WIDTH(src&) + x)
  219.  


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. CIRCLE (512, 384), 250, 1
  6. Result = SaveImage("circle.bmp", img, 0, 0, _WIDTH(img) - 1, _HEIGHT(img) - 1)
  7. '$include:'saveimage.bm'
  8.  

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.  
  94.     IF BMP.BPP = 8 THEN 'Store the Palette for 256 color mode
  95.  
  96.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  97.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  98.             b$ = CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  99.             _MEMPUT n, o, b$
  100.             o = o + 4
  101.         NEXT
  102.         y = y2% + 1
  103.         w& = _WIDTH(image&)
  104.         x = x2% - x1% + 1
  105.         DO
  106.             y = y - 1
  107.             _MEMGET m, m.OFFSET + (w& * y + x1%), temp
  108.             _MEMPUT n, o, temp
  109.             o = o + x
  110.             _MEMPUT n, o, ZeroPAD$
  111.             o = o + zp&
  112.         LOOP UNTIL y = y1%
  113.     ELSE
  114.         y = y2% + 1
  115.         w& = _WIDTH(image&)
  116.         DO
  117.             y = y - 1: x = x1% - 1
  118.             DO
  119.                 x = x + 1
  120.                 _MEMGET m, m.OFFSET + (w& * y + x) * 4, temp
  121.                 _MEMPUT n, o, temp
  122.                 o = o + 3
  123.             LOOP UNTIL x = x2%
  124.             _MEMPUT n, o, ZeroPAD$
  125.             o = o + zp&
  126.         LOOP UNTIL y = y1%
  127.     END IF
  128. rem    _MEMFREE m
  129.  
  130.     OPEN filename$ FOR BINARY AS #F
  131.     t1$ = SPACE$(BMP.Size)
  132.     _MEMGET n, n.OFFSET, t1$
  133.     PUT #F, , t1$
  134. rem    _MEMFREE n
  135.     CLOSE #F
  136.     _SOURCE s&
  137.  
« Last Edit: June 12, 2020, 05:06:37 pm by Petr »

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Save Image 2.3a (Needs Testing)
« Reply #13 on: June 13, 2020, 01:37:05 am »
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:
Quote
            cv& = _PALETTECOLOR(c&, image) ' color attribute to read.

What it should've read is:
Quote
            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.
« Last Edit: June 13, 2020, 01:38:56 am by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Save Image 2.3a (Needs Testing)
« Reply #14 on: June 13, 2020, 09:04:44 am »
Hi Steve, again me (the damager)

Try this code using latest 2.3a library:

Code: QB64: [Select]
  1. '$include:'saveimage.bi'
  2. Result = SaveImage("test.gif", 0, 0, 0, _WIDTH - 1, _HEIGHT - 1)
  3. '$include:'saveimage.bm'
  4.