SaveBMPLibrary

[SMcNeill]

If you guys check around, you'll find that I have a nice SaveImage library (link here: http://qb64.freeforums.net/thread/55/save-image-library ), which can be used to let us save the screen as either a PNG or BMP format.

The issue with this library is that it:
1) Apparently doesn't work on Linux/Mac
2) It also has recently been a PITA for me to try and convince it to work in the 64-bit version of QB64.

So, with these issues in mind, I decided to back up and punt, and I rebuilt the SaveBMP portion to make it where it'd work on *any* OS for us.  Linux, Mac, Windows -- 32 and 64 bit -- none should have any issue with this library.

IF you're on Windows, using the 32-bit version of QB64, feel free to keep using SaveImage.  It does all this does, and then some.  This is just a replacement so folks who can't use the one, can still easily plug in a quick routine to save images from their program.

Code is below:

Code: QB64: [Select]

1. CONST SaveTextAs256Color = 0 'or -1 if you want to save screen 0 text screens in 256 colors
2. 'Note, you can also make the variable DIM SHARED, and then change its value as needed for your work.
3. '      Just change its value before you make the call to SaveBMP or SaveFullBMP.
4.  
5. CLS , 2
6.  
7. FOR i = 0 TO 15
8.     COLOR 15 - i
9.     PRINT "COLOR "; i
10. NEXT
11. SaveBMP "test.bmp", 0, 0, 0, _WIDTH, _HEIGHT
12.  
13.  
14.  
15.  
16.  
17.  
18. '**************************
19. ' Code beyond this point can go into a nice SaveBMPLibrary.BM
20. '**************************
21.  
22.  
23.  
24. SUB SaveFullBMP (filename$)
25.     SaveBMP filename$, 0, 0, 0, _WIDTH - 1, _HEIGHT - 1
26. END SUB
27.  
28. SUB SaveBMP (filename$, image&, x1%, y1%, x2%, y2%)
29.     'Super special STEVE-Approved BMP Export routine for use with any QB64 graphic mode.
30.     IF x1% < 0 OR y1% < 0 THEN ERROR 5: EXIT FUNCTION
31.     IF x2% > _WIDTH(image&) OR y2% > _HEIGHT(image&) THEN ERROR 5: EXIT FUNCTION
32.     IF x2% = _WIDTH(image&) THEN x2% = x2% - 1
33.     IF y2% = _HEIGHT(image&) THEN y2% = y2% - 1
34.  
35.     IF _PIXELSIZE(image&) = 0 THEN
36.         IF SaveTextAs256Color THEN
37.             tempimage& = TextScreenToImage256&(image&)
38.         ELSE
39.             tempimage& = TextScreenToImage32&(image&)
40.         END IF
41.         F = _FONT(image&)
42.         FW = _FONTWIDTH(F): FH = _FONTHEIGHT(F)
43.         SaveBMP filename$, tempimage&, x1% * FW, y1% * FH, x2% * FW, y2% * FH
44.         _FREEIMAGE tempimage&
45.         EXIT FUNCTION
46.     END IF
47.  
48.     TYPE BMPFormat
49.         ID AS STRING * 2
50.         Size AS LONG
51.         Blank AS LONG
52.         Offset AS LONG
53.         Hsize AS LONG
54.         PWidth AS LONG
55.         PDepth AS LONG
56.         Planes AS INTEGER
57.         BPP AS INTEGER
58.         Compression AS LONG
59.         ImageBytes AS LONG
60.         Xres AS LONG
61.         Yres AS LONG
62.         NumColors AS LONG
63.         SigColors AS LONG
64.     END TYPE
65.  
66.  
67.     DIM BMP AS BMPFormat
68.     DIM x AS LONG, y AS LONG
69.     DIM temp AS STRING, t AS STRING * 1
70.  
71.     DIM n AS _MEM, o AS _OFFSET, m AS _MEM
72.     m = _MEMIMAGE(image&)
73.  
74.     IF x1% > x2% THEN SWAP x1%, x2%
75.     IF y1% > y2% THEN SWAP y1%, y2%
76.     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
77.     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
78.  
79.     s& = _SOURCE
80.     _SOURCE image&
81.  
82.     BMP.PWidth = (x2% - x1%) + 1
83.     BMP.PDepth = (y2% - y1%) + 1
84.     BMP.ID = "BM"
85.     BMP.Blank = 0
86.     BMP.Hsize = 40
87.     BMP.Planes = 1
88.     BMP.Compression = 0
89.     BMP.Xres = 0
90.     BMP.Yres = 0
91.  
92.     BMP.SigColors = 0
93.  
94.     SELECT CASE _PIXELSIZE(image&)
95.         CASE 1
96.             temp = SPACE$(x2% - x1% + 1)
97.             OffsetBITS& = 54 + 1024 'add palette in 256 color modes
98.             BMP.BPP = 8
99.             IF BMP.PWidth MOD 4 THEN ZeroPAD$ = SPACE$(4 - (BMP.PWidth MOD 4))
100.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
101.             BMP.ImageBytes = ImageSize&
102.             BMP.NumColors = 256
103.             BMP.Size = ImageSize& + OffsetBITS&
104.             BMP.Offset = OffsetBITS&
105.         CASE 4
106.             temp = SPACE$(3)
107.             OffsetBITS& = 54 'no palette in 24/32 bit
108.             BMP.BPP = 24
109.             IF ((BMP.PWidth * 3) MOD 4) THEN ZeroPAD$ = SPACE$(4 - ((BMP.PWidth * 3) MOD 4))
110.             ImageSize& = (BMP.PWidth + LEN(ZeroPAD$)) * BMP.PDepth
111.             BMP.ImageBytes = ImageSize&
112.             BMP.NumColors = 0
113.             BMP.Size = ImageSize& * 3 + OffsetBITS&
114.             BMP.Offset = OffsetBITS&
115.     END SELECT
116.  
117.     F = FREEFILE
118.     n = _MEMNEW(BMP.Size)
119.     _MEMPUT n, n.OFFSET, BMP
120.     o = n.OFFSET + 54
121.     zp& = LEN(ZeroPAD$)
122.     $CHECKING:OFF
123.  
124.     IF BMP.BPP = 8 THEN 'Store the Palette for 256 color mode
125.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
126.             cv& = _PALETTECOLOR(c&, image) ' color attribute to read.
127.             b$ = CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
128.             _MEMPUT n, o, b$
129.             o = o + 4
130.         NEXT
131.         y = y2% + 1
132.         w& = _WIDTH(image&)
133.         x = x2% - x1% + 1
134.         DO
135.             y = y - 1
136.             _MEMGET m, m.OFFSET + (w& * y + x1%), temp
137.             _MEMPUT n, o, temp
138.             o = o + x
139.             _MEMPUT n, o, ZeroPAD$
140.             o = o + zp&
141.         LOOP UNTIL y = y1%
142.     ELSE
143.         y = y2% + 1
144.         w& = _WIDTH(image&)
145.         DO
146.             y = y - 1: x = x1% - 1
147.             DO
148.                 x = x + 1
149.                 _MEMGET m, m.OFFSET + (w& * y + x) * 4, temp
150.                 _MEMPUT n, o, temp
151.                 o = o + 3
152.             LOOP UNTIL x = x2%
153.             _MEMPUT n, o, ZeroPAD$
154.             o = o + zp&
155.         LOOP UNTIL y = y1%
156.     END IF
157.     $CHECKING:ON
158.     _MEMFREE m
159.     OPEN filename$ FOR BINARY AS #F
160.     t1$ = SPACE$(BMP.Size)
161.     _MEMGET n, n.OFFSET, t1$
162.     PUT #F, , t1$
163.     _MEMFREE n
164.     CLOSE #F
165.     _SOURCE s&
166. END SUB
167.  
168. FUNCTION TextScreenToImage256& (image&)
169.     d& = _DEST: s& = _SOURCE
170.     DIM Plt(15) AS LONG
171.     _SOURCE image&: _DEST image&
172.     FOR i = 0 TO 15: Plt(i) = _PALETTECOLOR(i, image&): NEXT
173.     f& = _FONT(image&)
174.     _FONT f&
175.     fw& = _FONTWIDTH
176.     fh& = _FONTHEIGHT
177.     w& = _WIDTH * _FONTWIDTH
178.     h& = _HEIGHT * _FONTHEIGHT '+ _HEIGHT
179.     l& = (_WIDTH * _HEIGHT) * 2 'The screen is width * height in pixels.  (80X25) = 2000 X 2 bytes each = 4000 total bytes to hold a page of screen 0 text and color
180.     tempscreen& = _NEWIMAGE(w&, h& + _HEIGHT, 256)
181.     Screen0to256& = _NEWIMAGE(w&, h&, 256)
182.  
183.     DIM m AS _MEM, b AS _UNSIGNED _BYTE, t AS STRING * 1
184.     DIM o AS _OFFSET
185.     m = _MEMIMAGE(image&)
186.     o = m.OFFSET
187.  
188.     _DEST (tempscreen&)
189.     FOR i = 0 TO 15: _PALETTECOLOR i, Plt(i): NEXT
190.     _FONT f&
191.  
192.     FOR i = 0 TO l& - 2 STEP 2
193.         _MEMGET m, m.OFFSET + i, t
194.         _MEMGET m, m.OFFSET + i + 1, b
195.         IF b > 127 THEN b = b - 128
196.         COLOR b MOD 16, b \ 16
197.         PRINT t;
198.     NEXT
199.     _PUTIMAGE , tempscreen&, Screen0to256&, (0, 0)-(w&, h&)
200.     _FREEIMAGE tempscreen&
201.     _DEST d&: _SOURCE s&
202.     _MEMFREE m
203.     TextScreenToImage256 = Screen0to256&
204. END FUNCTION
205.  
206. FUNCTION TextScreenToImage32& (image&)
207.     d& = _DEST: s& = _SOURCE
208.     DIM Plt(15) AS LONG
209.     _SOURCE image&
210.     FOR i = 0 TO 15: Plt(i) = _PALETTECOLOR(i, image&): NEXT
211.     f& = _FONT(image&)
212.     _FONT f&
213.     fw& = _FONTWIDTH
214.     fh& = _FONTHEIGHT
215.     w& = _WIDTH * _FONTWIDTH
216.     h& = _HEIGHT * _FONTHEIGHT '+ _HEIGHT
217.     l& = (_WIDTH * _HEIGHT) * 2 'The screen is width * height in pixels.  (80X25) = 2000 X 2 bytes each = 4000 total bytes to hold a page of screen 0 text and color
218.     tempscreen& = _NEWIMAGE(w&, h& + _HEIGHT, 32)
219.     Screen0to32& = _NEWIMAGE(w&, h&, 32)
220.     _DEST tempscreen&
221.  
222.     DIM m AS _MEM, b AS _UNSIGNED _BYTE, t AS STRING * 1
223.     DIM o AS _OFFSET
224.     m = _MEMIMAGE(image&)
225.     o = m.OFFSET
226.  
227.     _FONT f&
228.  
229.     FOR i = 0 TO l& - 2 STEP 2
230.         _MEMGET m, m.OFFSET + i, t
231.         _MEMGET m, m.OFFSET + i + 1, b
232.         IF b > 127 THEN b = b - 128
233.         fgc = b MOD 16: bgc = b \ 16
234.         COLOR _RGB32(_RED(fgc, image&), _GREEN(fgc, image&), _BLUE(fgc, image&)), _RGB32(_RED(bgc, image&), _GREEN(bgc, image&), _BLUE(bgc, image&))
235.         PRINT t;
236.     NEXT
237.     _PUTIMAGE , tempscreen&, Screen0to32&, (0, 0)-(w&, h&)
238.     _FREEIMAGE tempscreen&
239.     _DEST d&: _SOURCE s&
240.     _MEMFREE m
241.     TextScreenToImage32 = Screen0to32&
242. END FUNCTION
243.  

[SMcNeill]

A brief explaination of the functions.

If you grab the attachment from the first post, just include it in your program, at the bottom of the code, and you're all set to make use of everything.

Code: QB64: [Select]

1. 'Your code goes first
2.  
3.  
4.  
5. 'and then down at the end:
6.  
7. '$INCLUDE:'SaveBMP.BM'

***************************************

To save the full screen to a BMP file on your disk, it's as simple as:

SaveFullBMP filename$

Screen mode doesn't matter; the routine automatically detects what screen you're in, and it handles everything itself.  Text screens work just fine (SCREEN 0), as well as 256 color and 32 bit color screens.

****************************************

To save a portion of a screen, or an inactive screen, all you do is:

SaveBMP filename$, image&, x1%, y1%, x2%, y2%

filename% is the name of the file you want to save it to.
image& is the image handle you want to save.  (0 for the active desktop.)
And the other 4 are the X/Y coordinates of the screen section you want to save.

For example, to save a section of the screen from 100,100 to 400,400, it'd be:
SaveBMP "whatever.BMP", 0, 100, 100, 400, 400
 
****************************************

If you look, there's also 2 more functions in this little package:

FUNCTION TextScreenToImage256& (image&)
FUNCTION TextScreenToImage32& (image&)

These allow you to take an existing text screen and convert it over to either a 256 color screen, or a 32-bit color screen.

newscreen = TextScreenToImage32& (0) would be all it'd normally take to convert a SCREEN 0 to a 32-bit color screen.

 
****************************************

And, if you look, there *IS* one variable/CONST which you can set, to change the behavior of the routines:

SaveTextAs256Color

Since QB64 currently doesn't load 256 color images, you may not want to save a text screen as a 256 color screen.  (Or, then again, you might, if you're going to use it for something externally and want to reduce overall size of the file.)  This variable lets you change the mode which SaveBMP uses to convert a text screen into.

SaveTextAs256Color = 0   <-- Then you use 32-bit colors when converting and saving.
SaveTextAs256Color = (anything but 0)    <--   Then you use 256 colors when converting and saving.

****************************************
****************************************

And that's the whole thing in a nutshell.  :D

[STxAxTIC]

Always liked this one. Thanks for resurrecting it!

[Petr]

Hi Steve. Add here please BI file, because this call:   DIM PNGImageHeader AS PNGImageHeaderType  is not valid now.


No. It is ok, I just have a mess here

[SMcNeill]

Hi Steve. Add here please BI file, because this call:   DIM PNGImageHeader AS PNGImageHeaderType  is not valid now.

We don't use PNG files with this library.  Did I miss removing a reference somewhere?

EDIT:  Nope.  Just checked; no references to PNG in this library.  All this does is BMP files for us, but it does it for all OSes, and both 32-bit and 64-bit versions.

[Petr]

my fail

[Petr]

Sorry!!! i read BAD FILE...

[SMcNeill]

Sorry!!! i read BAD FILE...

No worries.  I think you were looking at the SaveImage library from the other site.  It's more flexible and saves PNG files as well as BMP, but it only runs on Windows 32-bit versions of QB64.  This works for everyone.  :)

[Petr]

Ah, you say only in 32-bit versions? I have tried to add your PNG option to my program, but the IDE has compiled it, but program then reported that it was missing the DLL library, although it was in the same folder as EXE.

[SMcNeill]

Ah, you say only in 32-bit versions? I have tried to add your PNG option to my program, but the IDE has compiled it, but program then reported that it was missing the DLL library, although it was in the same folder as EXE.

That's the issue with QB64x64 I was talking about.  It needs a 64-bit version of zlib1.dll to work on 64-bit versions, and I haven't found one of those yet.

[Petr]

Yeah, so  that's why!. I was rubbing my head when I could see that DLL it was there, but  the program write, that DLL there is not... Thanks, Steve.