Simple BMP Save Example

[SierraKen]

If anyone is wondering how to save anything on the screen to a .BMP picture, you don't need any libraries or extra files. Here's an example I've been using for awhile. This isn't a complete program so you will have to add your own code to make a picture on the screen to save it. It's easy to see on this example where to add that. This is just an example to feel free to change anything. The SUB and some other code is from the QB64 wiki pages.

Code: QB64: [Select]

1. 'Example code of how to save a screen picture to a .bmp file.
2. start:
3. CLS
4. picture& = _NEWIMAGE(800, 600, 32)  
5. SCREEN picture&  
6. '------------------------------------
7. 'Make picture here.
8.  
9.  
10.  
11.  
12. '------------------------------------
13. choice:
14. a$=INKEY$
15. IF a$="s" OR a$="S" THEN GOTO saving:
16. IF a$=chr$(27) THEN END
17. GOTO choice: 'Or you can loop it somewhere if you want the picture to be ongoing.
18.  
19. saving:
20. picture2& = _COPYIMAGE(picture&)
21. _DELAY .2
22. CLS
23. PRINT "                       Saving"
24. PRINT
25. PRINT "         Your bmp file will be saved in the"
26. PRINT "         same directory as this program is."
27. PRINT "         It can be used with almost any"
28. PRINT "         other graphics program or website."
29. PRINT "         It is saved using:"
30. PRINT "         width: 800  height: 600 pixels."
31. PRINT
32. PRINT "         Type a name to save your picture"
33. PRINT "         and press the Enter key. Do not"
34. PRINT "         add .bmp at the end, the program"
35. PRINT "         will do it automatically."
36. PRINT
37. PRINT "         Example: MyPic"
38. PRINT "         Quit and Enter key ends program."
39. PRINT
40. INPUT "         ->"; nm$
41. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
42. nm$ = nm$ + ".bmp"
43. 'Checking to see if the file already exists on your computer.
44. theFileExists = _FILEEXISTS(nm$)
45. IF theFileExists = -1 THEN
46.     PRINT
47.     PRINT "       File Already Exists"
48.     PRINT "       Saving will delete your old"
49.     PRINT "       bmp picture."
50.     PRINT "       Would you like to still do it?"
51.     PRINT "      (Y/N)."
52.     PRINT "      Esc goes to start screen."
53.     llloop:
54.     _LIMIT 100
55.     ag2$ = INKEY$
56.     IF ag2$ = CHR$(27) THEN GOTO start:
57.     IF ag2$ = "" THEN GOTO llloop:
58.     IF ag2$ = "y" OR ag$ = "Y" THEN
59.         SHELL _HIDE "DEL " + nm$
60.         GOTO saving2:
61.     END IF
62.     GOTO llloop:
63. END IF
64. saving2:
65. CLS
66. SCREEN picture&
67. _PUTIMAGE , picture&
68. _DISPLAY
69. SaveImage 0, nm$
70. nm$ = ""
71. FOR snd = 100 TO 700 STEP 100
72.     SOUND snd, 2
73. NEXT snd
74. picture& = 0
75. picture2& = 0
76. _AUTODISPLAY
77. GOTO start:
78.  
79. 'Here is the SUB needed to save the image to BMP.
80. SUB SaveImage (image AS LONG, filename AS STRING)
81.     bytesperpixel& = _PIXELSIZE(image&)
82.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
83.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
84.     x& = _WIDTH(image&)
85.     y& = _HEIGHT(image&)
86.     b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
87.     IF bytesperpixel& = 1 THEN
88.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
89.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
90.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
91.         NEXT
92.     END IF
93.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
94.     lastsource& = _SOURCE
95.     _SOURCE image&
96.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
97.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
98.         r$ = ""
99.         FOR px& = 0 TO x& - 1
100.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
101.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
102.         NEXT px&
103.         d$ = d$ + r$ + padder$
104.     NEXT py&
105.     _SOURCE lastsource&
106.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
107.     b$ = b$ + d$ ' total file data bytes to create file
108.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
109.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
110.     f& = FREEFILE
111.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
112.     OPEN filename$ + ext$ FOR BINARY AS #f&
113.     PUT #f&, , b$
114.     CLOSE #f&
115. END SUB
116.  

[SMcNeill]

Have you taken a look at the SaveImage library?  https://www.qb64.org/forum/index.php?topic=1651.0

Useage is:

Code: [Select]

‘$INCLUDE:’SaveImage.BI’

result = SaveImageFull (“Filename.BMP”)

‘$INCLUDE:’SaveImage.BM’

Works with all screen modes, including screen 0 text screens.  Saves in BMP, PNG, GIF, and PNG formats just by changing the extension to the desired format.

Other routines in the library allow converting from 32-bit images to 256 color images, saving segments of the screen and not just the whole image, and ZLIB compression/decompression routines.  Most routines are written individually, so you can just extract the code you need for your project, if desired, and ignore all the rest of it.  ;)

[SierraKen]

Steve, I apologize for not commenting on that in the original post. I did in fact look at that post but since I've never used libraries before (except for one time with the windows color picker library which seemed to fail on some people's computers), I haven't looked into using them yet. But I will download it and see what I can do with it sometime. Thanks!

[bplus]

Hi Ken,

The current ColorDialog$ is working for everyone I hope? I just checked your most recent Paint program and have comment about Cancel or Escape from colorDialog in that thread.

[SierraKen]

Got it, thanks bplus.