Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: SierraKen on October 27, 2019, 09:21:55 pm

Title: Random Hills Generator
Post by: SierraKen on October 27, 2019, 09:21:55 pm
This program will create between 1 and 25 different size and shaped hills and blue sky on the screen. You can keep pressing the Space Bar to create different ones. If you want to save any of the screens to your computer as a .bmp file, press S and it will go to the Save screen where you can name it anything you want. The commands are in the Title Bar. I made it so the hills have darkness in the center and as they expand out they lighten up with a brighter green. This program can be used with other graphics programs to add text for logos or any kind of picture you wish and/or rename it to a .jpg or any other type of graphic file. Enjoy :)

Code: QB64: [Select]
  1. _TITLE "Random Hills Generator - Press Space Bar to Make More. Press S to Save to Computer. Esc to Quit."
  2. SCREEN _NEWIMAGE(800, 600, 32)
  3. start:
  5. PAINT (2, 2), _RGB32(127, 200, 255)
  7. tt = INT(RND * 25) + 1
  9.     _LIMIT 500
  11.     x = RND * 800
  12.     y = (RND * 100) + 600
  13.     s = RND * 400
  14.     sh = RND * 2
  15.     c = 1
  16.     DO
  17.         ss = ss + .5
  18.         c = c + .25
  19.         IF ss > s THEN GOTO more:
  20.         CIRCLE (x, y), ss, _RGB32(0, c, 0), , , sh
  21.     LOOP
  22.     more:
  23.     ss = 0
  24.     t = t + 1
  25.     IF t = tt THEN EXIT DO
  27. t = 0
  28. lp:
  29. a$ = INKEY$
  30. IF a$ = CHR$(27) THEN END
  31. IF a$ = " " THEN GOTO start:
  32. IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  33. GOTO lp:
  34.  
  35. saving:
  36. 'Now we call up the SUB to save the image to BMP.
  37. SaveImage 0, "temp.bmp"
  38. _DELAY .25
  40. PRINT "                               Saving"
  42. PRINT "                  Your BMP file will be saved in the"
  43. PRINT "                  same directory as this program is."
  44. PRINT "                  It can be used with almost any"
  45. PRINT "                  other graphics program or website."
  46. PRINT "                  It is saved using:"
  47. PRINT "                  width: 800  height: 600 pixels."
  49. PRINT "                  Type a name to save your picture"
  50. PRINT "                  and press the Enter key. Do not"
  51. PRINT "                  add .bmp at the end, the program"
  52. PRINT "                  will do it automatically."
  54. PRINT "                  Also do not use the name temp"
  55. PRINT "                  because the program uses that name"
  56. PRINT "                  and it would be erased the next time"
  57. PRINT "                  you save a picture."
  58. PRINT "                  Example: MyPic"
  59. PRINT "                  Quit and Enter key ends program."
  61. INPUT "         ->"; nm$
  62. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
  63. nm$ = nm$ + ".bmp"
  64. 'Checking to see if the file already exists on your computer.
  65. theFileExists = _FILEEXISTS(nm$)
  66. IF theFileExists = -1 THEN
  67.     PRINT
  68.     PRINT "             File Already Exists"
  69.     PRINT "             Saving will delete your old"
  70.     PRINT "             bmp picture."
  71.     PRINT "             Would you like to still do it?"
  72.     PRINT "             (Y/N)."
  73.     PRINT "             Esc goes to start screen."
  74.     llloop:
  75.     _LIMIT 100
  76.     ag2$ = INKEY$
  77.     IF ag2$ = CHR$(27) THEN GOTO start:
  78.     IF ag2$ = "" THEN GOTO llloop:
  79.     IF ag2$ = "y" OR ag$ = "Y" THEN
  80.         SHELL _HIDE "DEL " + nm$
  81.         GOTO saving2:
  82.     END IF
  83.     GOTO llloop:
  85. saving2:
  86. SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
  87. nm$ = ""
  88. FOR snd = 100 TO 500 STEP 100
  89.     SOUND snd, 2
  90. NEXT snd
  92. GOTO start:
  93.  
  94. SUB SaveImage (image AS LONG, filename AS STRING)
  95.     bytesperpixel& = _PIXELSIZE(image&)
  96.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
  97.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
  98.     x& = _WIDTH(image&)
  99.     y& = _HEIGHT(image&)
  100.     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)
  101.     IF bytesperpixel& = 1 THEN
  102.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  103.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  104.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  105.         NEXT
  106.     END IF
  107.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
  108.     lastsource& = _SOURCE
  109.     _SOURCE image&
  110.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
  111.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
  112.         r$ = ""
  113.         FOR px& = 0 TO x& - 1
  114.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
  115.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
  116.         NEXT px&
  117.         d$ = d$ + r$ + padder$
  118.     NEXT py&
  119.     _SOURCE lastsource&
  120.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
  121.     b$ = b$ + d$ ' total file data bytes to create file
  122.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
  123.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
  124.     f& = FREEFILE
  125.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
  126.     OPEN filename$ + ext$ FOR BINARY AS #f&
  127.     PUT #f&, , b$
  128.     CLOSE #f&
  130.  
Title: Re: Random Hills Generator
Post by: bplus on October 27, 2019, 11:12:29 pm
Love the colors, kind of cartoonist.
Title: Re: Random Hills Generator
Post by: SierraKen on October 27, 2019, 11:27:09 pm
Thanks :). Sure would be cool if I can figure out how to add an INPUT command anywhere on the screen someone clicks, like _PRINTSTRING can do. I guess I can try to calculate it as good as I can using LOCATE and the mouse. Does anyone know of an equation that converts graphic coordinates to LOCATE text coordinates? I'll Google it to see if there's something online. I just think it would be cool if someone can add text to this program to make logos or signs, etc.
Or I guess I could just add the INPUT above and then it uses PRINTSTRING To where the person clicks.
Title: Re: Random Hills Generator
Post by: bplus on October 28, 2019, 12:31:06 am
Quote from: SierraKen on October 27, 2019, 11:27:09 pm
Thanks :). Sure would be cool if I can figure out how to add an INPUT command anywhere on the screen someone clicks, like _PRINTSTRING can do. I guess I can try to calculate it as good as I can using LOCATE and the mouse. Does anyone know of an equation that converts graphic coordinates to LOCATE text coordinates? I'll Google it to see if there's something online. I just think it would be cool if someone can add text to this program to make logos or signs, etc.
Or I guess I could just add the INPUT above and then it uses PRINTSTRING To where the person clicks.

Locate row, col : input "Is this where you want to put the prompt? "; yesno$

Try different value for row (vertical character cells) , col ( horizontal character cells)

So where they click _mouseY/16 = row, and _mouseX/8 = column.

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 32)
  2.  
  5.     mx = _MOUSEX: my = _MOUSEY: mb = _MOUSEBUTTON(1)
  6.     IF mb THEN
  7.         LOCATE my / 16, mx / 8: INPUT "Is this where you want your INPUT prompts "; yes$
  8.  
  9.     END IF
Title: Re: Random Hills Generator
Post by: SierraKen on October 28, 2019, 12:34:50 am
I added a way to add text to it with the mouse. At first I tried a different way using _PUTIMAGE so the screen would be 100% as you left it, but for some reason I couldn't figure it out again. So instead I just put a blue box around the INPUT text when you are done with it. The only problem with that is if you add text in that same location, it will be erased if you want more after that. Oh well, it's all for fun anyway. You can also type one word and then keep moving and clicking the mouse as much as you want in as many locations as you want for that same text. I also used the POINT command to use the same color as where you clicked as the background of the text. Like if click in the sky, it will make the background text blue. If you clicked the same word(s) on the hills, it will use that certain shade of green. It's standard small text but it's OK with me.

Code: QB64: [Select]
  1. _TITLE "Random Hills Generator - Press Space Bar to Make More. T to Add New Text. S to Save to Computer. Esc to Quit."
  2. start:
  3. SCREEN _NEWIMAGE(800, 600, 32)
  5. PAINT (2, 2), _RGB32(127, 200, 255)
  7. tt = INT(RND * 25) + 2
  9.     _LIMIT 500
  11.     x = RND * 800
  12.     y = (RND * 100) + 600
  13.     s = RND * 400
  14.     sh = RND * 2
  15.     c = 1
  16.     DO
  17.         ss = ss + .5
  18.         c = c + .25
  19.         IF ss > s THEN GOTO more:
  20.         CIRCLE (x, y), ss, _RGB32(0, c, 0), , , sh
  21.     LOOP
  22.     more:
  23.     ss = 0
  24.     t = t + 1
  25.     IF t = tt THEN EXIT DO
  27. t = 0
  29.     a$ = INKEY$
  30.     IF a$ = CHR$(27) THEN END
  31.     IF a$ = " " THEN GOTO start:
  32.     IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  33.     IF a$ = "t" OR a$ = "T" THEN
  34.         COLOR _RGB32(0, 0, 0), _RGB32(127, 200, 255)
  35.         LOCATE 1, 1
  36.         PRINT "Type here then click your mouse where you want it."
  37.         INPUT "->", txt$
  38.         LINE (0, 0)-(800, 34), _RGB32(127, 200, 255), BF
  39.     END IF
  41.         mouseX = _MOUSEX
  42.         mouseY = _MOUSEY
  43.         mouseLeftButton = _MOUSEBUTTON(1)
  44.     LOOP
  45.     IF mouseLeftButton = -1 THEN
  46.         clr& = POINT(mouseX, mouseY)
  47.         COLOR _RGB32(0, 0, 0), clr&
  48.         _PRINTSTRING (mouseX, mouseY), txt$
  49.     END IF
  51.  
  52. saving:
  53. 'Now we call up the SUB to save the image to BMP.
  54. SaveImage 0, "temp.bmp"
  55. _DELAY .25
  57. COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
  58. PRINT "                               Saving"
  60. PRINT "                  Your BMP file will be saved in the"
  61. PRINT "                  same directory as this program is."
  62. PRINT "                  It can be used with almost any"
  63. PRINT "                  other graphics program or website."
  64. PRINT "                  It is saved using:"
  65. PRINT "                  width: 800  height: 600 pixels."
  67. PRINT "                  Type a name to save your picture"
  68. PRINT "                  and press the Enter key. Do not"
  69. PRINT "                  add .bmp at the end, the program"
  70. PRINT "                  will do it automatically."
  72. PRINT "                  Also do not use the name temp"
  73. PRINT "                  because the program uses that name"
  74. PRINT "                  and it would be erased the next time"
  75. PRINT "                  you save a picture."
  76. PRINT "                  Example: MyPic"
  77. PRINT "                  Quit and Enter key ends program."
  79. INPUT "         ->"; nm$
  80. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
  81. nm$ = nm$ + ".bmp"
  82. 'Checking to see if the file already exists on your computer.
  83. theFileExists = _FILEEXISTS(nm$)
  84. IF theFileExists = -1 THEN
  85.     PRINT
  86.     PRINT "             File Already Exists"
  87.     PRINT "             Saving will delete your old"
  88.     PRINT "             bmp picture."
  89.     PRINT "             Would you like to still do it?"
  90.     PRINT "             (Y/N)."
  91.     PRINT "             Esc goes to start screen."
  92.     llloop:
  93.     _LIMIT 100
  94.     ag2$ = INKEY$
  95.     IF ag2$ = CHR$(27) THEN GOTO start:
  96.     IF ag2$ = "" THEN GOTO llloop:
  97.     IF ag2$ = "y" OR ag$ = "Y" THEN
  98.         SHELL _HIDE "DEL " + nm$
  99.         GOTO saving2:
  100.     END IF
  101.     GOTO llloop:
  103. saving2:
  104. SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
  105. nm$ = ""
  106. FOR snd = 100 TO 500 STEP 100
  107.     SOUND snd, 2
  108. NEXT snd
  110. GOTO start:
  111.  
  112. SUB SaveImage (image AS LONG, filename AS STRING)
  113.     bytesperpixel& = _PIXELSIZE(image&)
  114.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
  115.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
  116.     x& = _WIDTH(image&)
  117.     y& = _HEIGHT(image&)
  118.     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)
  119.     IF bytesperpixel& = 1 THEN
  120.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  121.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  122.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  123.         NEXT
  124.     END IF
  125.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
  126.     lastsource& = _SOURCE
  127.     _SOURCE image&
  128.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
  129.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
  130.         r$ = ""
  131.         FOR px& = 0 TO x& - 1
  132.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
  133.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
  134.         NEXT px&
  135.         d$ = d$ + r$ + padder$
  136.     NEXT py&
  137.     _SOURCE lastsource&
  138.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
  139.     b$ = b$ + d$ ' total file data bytes to create file
  140.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
  141.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
  142.     f& = FREEFILE
  143.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
  144.     OPEN filename$ + ext$ FOR BINARY AS #f&
  145.     PUT #f&, , b$
  146.     CLOSE #f&
  148.  
Title: Re: Random Hills Generator
Post by: SierraKen on October 28, 2019, 12:42:23 am
Sorry Bplus, I just added that new version a few seconds after you tried to help me. I kind of like it this way so people can quickly click with the mouse as many times as they want for the same text. But I guess your way would fix that problem I have with not having to delete anything. I will see what I can do.
Title: Re: Random Hills Generator
Post by: bplus on October 28, 2019, 12:44:20 am
yeah looked good to me.
Title: Re: Random Hills Generator
Post by: SierraKen on October 28, 2019, 12:53:29 am
I liked your way better. This time no text is erased at all. I didn't add any of your text though, just using the LOCATE conversion math with INPUT worked perfectly. Thank you!

Here is that certain area I changed:

Code: QB64: [Select]
  2.     a$ = INKEY$
  3.     IF a$ = CHR$(27) THEN END
  4.     IF a$ = " " THEN GOTO start:
  5.     IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  7.         mouseX = _MOUSEX
  8.         mouseY = _MOUSEY
  9.         mouseLeftButton = _MOUSEBUTTON(1)
  10.     LOOP
  11.     IF mouseLeftButton = -1 THEN
  12.         clr& = POINT(mouseX, mouseY)
  13.         COLOR _RGB32(0, 0, 0), clr&
  14.         LOCATE mouseY / 16, mouseX / 8
  15.         INPUT "", txt$
  16.     END IF
  18.  

Title: Re: Random Hills Generator
Post by: SierraKen on October 28, 2019, 01:06:13 am
Here is the whole program. I had to fix the Saving screen to get the right color again hehe.
I also added my name and date in the top comments and a thank you to bplus and this forum for the help.

Code: QB64: [Select]
  1. 'Thanks to bplus and QB64.org Forum for some help!
  2. 'Made by Ken G. on Oct. 27, 2019.
  3.  
  4. _TITLE "Space Bar to Make More. Left Click Mouse where you want Text and Press Enter. S Saves to Computer. Esc to Quit."
  5. start:
  6. SCREEN _NEWIMAGE(800, 600, 32)
  8. PAINT (2, 2), _RGB32(127, 200, 255)
  10. tt = INT(RND * 25) + 2
  12.     _LIMIT 500
  14.     x = RND * 800
  15.     y = (RND * 100) + 600
  16.     s = RND * 400
  17.     sh = RND * 2
  18.     c = 1
  19.     DO
  20.         ss = ss + .5
  21.         c = c + .25
  22.         IF ss > s THEN GOTO more:
  23.         CIRCLE (x, y), ss, _RGB32(0, c, 0), , , sh
  24.     LOOP
  25.     more:
  26.     ss = 0
  27.     t = t + 1
  28.     IF t = tt THEN EXIT DO
  30. t = 0
  32.     a$ = INKEY$
  33.     IF a$ = CHR$(27) THEN END
  34.     IF a$ = " " THEN GOTO start:
  35.     IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  37.         mouseX = _MOUSEX
  38.         mouseY = _MOUSEY
  39.         mouseLeftButton = _MOUSEBUTTON(1)
  40.     LOOP
  41.     IF mouseLeftButton = -1 THEN
  42.         clr& = POINT(mouseX, mouseY)
  43.         COLOR _RGB32(0, 0, 0), clr&
  44.         LOCATE mouseY / 16, mouseX / 8
  45.         INPUT "", txt$
  46.     END IF
  48. saving:
  49. 'Now we call up the SUB to save the image to BMP.
  50. SaveImage 0, "temp.bmp"
  51. _DELAY .25
  53. LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
  54. COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
  55. PRINT "                               Saving"
  57. PRINT "                  Your BMP file will be saved in the"
  58. PRINT "                  same directory as this program is."
  59. PRINT "                  It can be used with almost any"
  60. PRINT "                  other graphics program or website."
  61. PRINT "                  It is saved using:"
  62. PRINT "                  width: 800  height: 600 pixels."
  64. PRINT "                  Type a name to save your picture"
  65. PRINT "                  and press the Enter key. Do not"
  66. PRINT "                  add .bmp at the end, the program"
  67. PRINT "                  will do it automatically."
  69. PRINT "                  Also do not use the name temp"
  70. PRINT "                  because the program uses that name"
  71. PRINT "                  and it would be erased the next time"
  72. PRINT "                  you save a picture."
  73. PRINT "                  Example: MyPic"
  74. PRINT "                  Quit and Enter key ends program."
  76. INPUT "         ->"; nm$
  77. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
  78. nm$ = nm$ + ".bmp"
  79. 'Checking to see if the file already exists on your computer.
  80. theFileExists = _FILEEXISTS(nm$)
  81. IF theFileExists = -1 THEN
  82.     PRINT
  83.     PRINT "             File Already Exists"
  84.     PRINT "             Saving will delete your old"
  85.     PRINT "             bmp picture."
  86.     PRINT "             Would you like to still do it?"
  87.     PRINT "             (Y/N)."
  88.     PRINT "             Esc goes to start screen."
  89.     llloop:
  90.     _LIMIT 100
  91.     ag2$ = INKEY$
  92.     IF ag2$ = CHR$(27) THEN GOTO start:
  93.     IF ag2$ = "" THEN GOTO llloop:
  94.     IF ag2$ = "y" OR ag$ = "Y" THEN
  95.         SHELL _HIDE "DEL " + nm$
  96.         GOTO saving2:
  97.     END IF
  98.     GOTO llloop:
  100. saving2:
  101. SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
  102. nm$ = ""
  103. FOR snd = 100 TO 500 STEP 100
  104.     SOUND snd, 2
  105. NEXT snd
  107. GOTO start:
  108. SUB SaveImage (image AS LONG, filename AS STRING)
  109.     bytesperpixel& = _PIXELSIZE(image&)
  110.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
  111.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
  112.     x& = _WIDTH(image&)
  113.     y& = _HEIGHT(image&)
  114.     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)
  115.     IF bytesperpixel& = 1 THEN
  116.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  117.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  118.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  119.         NEXT
  120.     END IF
  121.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
  122.     lastsource& = _SOURCE
  123.     _SOURCE image&
  124.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
  125.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
  126.         r$ = ""
  127.         FOR px& = 0 TO x& - 1
  128.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
  129.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
  130.         NEXT px&
  131.         d$ = d$ + r$ + padder$
  132.     NEXT py&
  133.     _SOURCE lastsource&
  134.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
  135.     b$ = b$ + d$ ' total file data bytes to create file
  136.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
  137.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
  138.     f& = FREEFILE
  139.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
  140.     OPEN filename$ + ext$ FOR BINARY AS #f&
  141.     PUT #f&, , b$
  142.     CLOSE #f&
  144.  
Title: Re: Random Hills Generator
Post by: bplus on October 28, 2019, 01:08:51 am
Those hills....

I am thinking some sort of golfing game? Maybe it's getting late ;-))
Title: Re: Random Hills Generator
Post by: SierraKen on October 28, 2019, 12:15:52 pm
LOL yeah I'm thinking about trying it a different way to make the hills.
Title: Re: Random Hills Generator
Post by: Qwerkey on October 28, 2019, 02:55:45 pm
Very nice.  If you had added an audio track, some wag who likes wordplay could have commented "The Hills are Alive with the Sound of Music" and we could all have pictured Julie Andrews in Alpine garb.
Title: Re: Random Hills Generator
Post by: SierraKen on October 28, 2019, 05:50:22 pm
LOL cool Qwerky.

Well, I completely re-wrote the program to make it more realistic looking. I went back to the old SIN and COS again to add shades of green on the sides of the hills.
The only thing I couldn't figure out is how to change the shape of the hills like I had before. I tried to add numbers to every line but I'm not sure if that itself would do the job, it might need completely different equations that I don't know of. But anyway, this is what I have so far. With this version you can't save the picture yet since I'm not finished with it. But I thought you all would like to see it. Keep pressing the Space Bar to make new random renditions.

Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(800, 600, 32)
  2. again:
  4. PAINT (2, 2), _RGB32(128, 194, 255)
  5. a$ = ""
  6. seconds = 45
  7. r = 127
  8. g = 100
  9. b = 127
  11. size = INT(RND * 100)
  13. amount = INT(RND * 25) + 5
  16.     tt = RND * 90
  17.     xx = RND * 800
  18.     one:
  19.     seconds = seconds + .25
  20.     s = (60 - seconds) * 6 + (180 + tt)
  21.     x = INT(SIN(s / (180 + tt) * 3.141592) * ((180 - t) + size)) + xx
  22.     y = INT(COS(s / (180 + tt) * 3.141592) * ((180 - t) + size)) + 750
  23.     CIRCLE (x, y), 4, _RGB32(r, g, b)
  24.     PAINT (x, y), _RGB32(r, g, b)
  25.     g = g + 1
  26.     IF seconds = 75 THEN
  27.         seconds = 45
  28.         t = t + 1
  29.         IF t = (180 + size) THEN
  30.             t = 0
  31.             GOTO more:
  32.         END IF
  33.         g = 100
  34.         GOTO one:
  35.     END IF
  36.     GOTO one:
  37.     more:
  39.     size = INT(RND * 100)
  40.     m = m + 1
  41.     IF m = amount THEN EXIT DO
  43. m = 0
  45.     a$ = INKEY$
  46.     IF a$ = " " THEN GOTO again:
  47.     IF a$ = CHR$(27) THEN END
  49.  
Title: Re: Random Hills Generator
Post by: SierraKen on October 28, 2019, 07:35:32 pm
OK I added a sky that gets darker as you look higher and added the Text and Save features again. I think I'm about done, unless someone can figure out an equation to change the shape of the hills, but I'm not worried about it. Again, I don't use the CIRCLE command for these hills, I use SIN and COS in order for the shades of green to change on the sides. This program is just a tool to add more graphics to with another graphics program mostly. Or you can just enjoy the scenes. :)

Code: QB64: [Select]
  1. 'Thank you to bplus and the QB64.org forum for the motivation and help!
  2. 'This was made by Ken G. on Oct. 28, 2019.
  3. _TITLE "Space Bar Makes New Picture, Mouse For Text And Press Enter When Finished, (S)ave To BMP File, Esc to Quit."  
  4. SCREEN _NEWIMAGE(800, 600, 32)
  5. again:
  6. _LIMIT 500
  8. bb = 50
  9. FOR sky = 0 TO 600
  10.     bb = bb + .25
  11.     LINE (0, sky)-(800, sky), _RGB32(75, 75, bb + 50)
  12. NEXT sky
  13. a$ = ""
  14. seconds = 45
  15. r = 127
  16. g = 100
  17. b = 127
  19. size = INT(RND * 100)
  21. amount = INT(RND * 25) + 5
  24.     tt = RND * 90
  25.     xx = RND * 800
  26.     one:
  27.     seconds = seconds + .25
  28.     s = (60 - seconds) * 6 + (180 + tt)
  29.     x = INT(SIN(s / (180 + tt) * 3.141592) * ((180 - t) + size)) + xx
  30.     y = INT(COS(s / (180 + tt) * 3.141592) * ((180 - t) + size)) + 750
  31.     CIRCLE (x, y), 4, _RGB32(r, g, b)
  32.     PAINT (x, y), _RGB32(r, g, b)
  33.     g = g + 1
  34.     IF seconds = 75 THEN
  35.         seconds = 45
  36.         t = t + 1
  37.         IF t = (180 + size) THEN
  38.             t = 0
  39.             GOTO more:
  40.         END IF
  41.         g = 100
  42.         GOTO one:
  43.     END IF
  44.     GOTO one:
  45.     more:
  47.     size = INT(RND * 100)
  48.     m = m + 1
  49.     IF m = amount THEN EXIT DO
  51. m = 0
  53.     _LIMIT 500
  54.     a$ = INKEY$
  55.     IF a$ = " " THEN GOTO again:
  56.     IF a$ = CHR$(27) THEN END
  57.     IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  59.         mouseX = _MOUSEX
  60.         mouseY = _MOUSEY
  61.         mouseLeftButton = _MOUSEBUTTON(1)
  62.     LOOP
  63.     IF mouseLeftButton = -1 THEN
  64.         clr& = POINT(mouseX, mouseY)
  65.         COLOR _RGB32(0, 0, 0), clr&
  66.         LOCATE mouseY / 16, mouseX / 8
  67.         INPUT "", txt$
  68.     END IF
  70. saving:
  71. _LIMIT 500
  72. 'Now we call up the SUB to save the image to BMP.
  73. SaveImage 0, "temp.bmp"
  74. _DELAY .25
  76. LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
  77. COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
  78. PRINT "                               Saving"
  80. PRINT "                  Your BMP file will be saved in the"
  81. PRINT "                  same directory as this program is."
  82. PRINT "                  It can be used with almost any"
  83. PRINT "                  other graphics program or website."
  84. PRINT "                  It is saved using:"
  85. PRINT "                  width: 800  height: 600 pixels."
  87. PRINT "                  Type a name to save your picture"
  88. PRINT "                  and press the Enter key. Do not"
  89. PRINT "                  add .bmp at the end, the program"
  90. PRINT "                  will do it automatically."
  92. PRINT "                  Also do not use the name temp"
  93. PRINT "                  because the program uses that name"
  94. PRINT "                  and it would be erased the next time"
  95. PRINT "                  you save a picture."
  96. PRINT "                  Example: MyPic"
  97. PRINT "                  Quit and Enter key ends program."
  99. INPUT "         ->"; nm$
  100. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
  101. nm$ = nm$ + ".bmp"
  102. 'Checking to see if the file already exists on your computer.
  103. theFileExists = _FILEEXISTS(nm$)
  104. IF theFileExists = -1 THEN
  105.     PRINT
  106.     PRINT "             File Already Exists"
  107.     PRINT "             Saving will delete your old"
  108.     PRINT "             bmp picture."
  109.     PRINT "             Would you like to still do it?"
  110.     PRINT "             (Y/N)."
  111.     PRINT "             Esc goes to start screen."
  112.     llloop:
  113.     _LIMIT 100
  114.     ag2$ = INKEY$
  115.     IF ag2$ = CHR$(27) THEN GOTO again:
  116.     IF ag2$ = "" THEN GOTO llloop:
  117.     IF ag2$ = "y" OR ag$ = "Y" THEN
  118.         SHELL _HIDE "DEL " + nm$
  119.         GOTO saving2:
  120.     END IF
  121.     GOTO llloop:
  123. saving2:
  124. SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
  125. nm$ = ""
  126. FOR snd = 100 TO 500 STEP 100
  127.     SOUND snd, 2
  128. NEXT snd
  130. GOTO again:
  131. SUB SaveImage (image AS LONG, filename AS STRING)
  132.     bytesperpixel& = _PIXELSIZE(image&)
  133.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
  134.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
  135.     x& = _WIDTH(image&)
  136.     y& = _HEIGHT(image&)
  137.     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)
  138.     IF bytesperpixel& = 1 THEN
  139.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  140.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  141.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  142.         NEXT
  143.     END IF
  144.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
  145.     lastsource& = _SOURCE
  146.     _SOURCE image&
  147.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
  148.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
  149.         r$ = ""
  150.         FOR px& = 0 TO x& - 1
  151.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
  152.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
  153.         NEXT px&
  154.         d$ = d$ + r$ + padder$
  155.     NEXT py&
  156.     _SOURCE lastsource&
  157.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
  158.     b$ = b$ + d$ ' total file data bytes to create file
  159.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
  160.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
  161.     f& = FREEFILE
  162.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
  163.     OPEN filename$ + ext$ FOR BINARY AS #f&
  164.     PUT #f&, , b$
  165.     CLOSE #f&
  167.  
Title: Re: Random Hills Generator
Post by: bplus on October 28, 2019, 07:54:07 pm
Nice shading of sky and hills but I miss the green.
Title: Re: Random Hills Generator
Post by: SierraKen on October 28, 2019, 08:18:17 pm
LOL thanks bplus. Well you can do what I did, and have both programs. The older one I posted on this thread and the last one. :)
Title: Re: Random Hills Generator
Post by: SierraKen on October 28, 2019, 08:20:05 pm
I will post both here...

Here is the original bright green cartoon version:

Code: QB64: [Select]
  1. 'Thanks to bplus and QB64.org Forum for some help!
  2. 'Made by Ken G. on Oct. 27, 2019.
  3.  
  4. _TITLE "Space Bar to Make More. Left Click Mouse where you want Text and Press Enter. S Saves to Computer. Esc to Quit."
  5. start:
  6. SCREEN _NEWIMAGE(800, 600, 32)
  8. PAINT (2, 2), _RGB32(127, 200, 255)
  10. tt = INT(RND * 25) + 2
  12.     _LIMIT 500
  14.     x = RND * 800
  15.     y = (RND * 100) + 600
  16.     s = RND * 400
  17.     sh = RND * 2
  18.     c = 1
  19.     DO
  20.         ss = ss + .5
  21.         c = c + .25
  22.         IF ss > s THEN GOTO more:
  23.         CIRCLE (x, y), ss, _RGB32(0, c, 0), , , sh
  24.     LOOP
  25.     more:
  26.     ss = 0
  27.     t = t + 1
  28.     IF t = tt THEN EXIT DO
  30. t = 0
  32.     a$ = INKEY$
  33.     IF a$ = CHR$(27) THEN END
  34.     IF a$ = " " THEN GOTO start:
  35.     IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  37.         mouseX = _MOUSEX
  38.         mouseY = _MOUSEY
  39.         mouseLeftButton = _MOUSEBUTTON(1)
  40.     LOOP
  41.     IF mouseLeftButton = -1 THEN
  42.         clr& = POINT(mouseX, mouseY)
  43.         COLOR _RGB32(0, 0, 0), clr&
  44.         LOCATE mouseY / 16, mouseX / 8
  45.         INPUT "", txt$
  46.     END IF
  48. saving:
  49. 'Now we call up the SUB to save the image to BMP.
  50. SaveImage 0, "temp.bmp"
  51. _DELAY .25
  53. LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
  54. COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
  55. PRINT "                               Saving"
  57. PRINT "                  Your BMP file will be saved in the"
  58. PRINT "                  same directory as this program is."
  59. PRINT "                  It can be used with almost any"
  60. PRINT "                  other graphics program or website."
  61. PRINT "                  It is saved using:"
  62. PRINT "                  width: 800  height: 600 pixels."
  64. PRINT "                  Type a name to save your picture"
  65. PRINT "                  and press the Enter key. Do not"
  66. PRINT "                  add .bmp at the end, the program"
  67. PRINT "                  will do it automatically."
  69. PRINT "                  Also do not use the name temp"
  70. PRINT "                  because the program uses that name"
  71. PRINT "                  and it would be erased the next time"
  72. PRINT "                  you save a picture."
  73. PRINT "                  Example: MyPic"
  74. PRINT "                  Quit and Enter key ends program."
  76. INPUT "         ->"; nm$
  77. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
  78. nm$ = nm$ + ".bmp"
  79. 'Checking to see if the file already exists on your computer.
  80. theFileExists = _FILEEXISTS(nm$)
  81. IF theFileExists = -1 THEN
  82.     PRINT
  83.     PRINT "             File Already Exists"
  84.     PRINT "             Saving will delete your old"
  85.     PRINT "             bmp picture."
  86.     PRINT "             Would you like to still do it?"
  87.     PRINT "             (Y/N)."
  88.     PRINT "             Esc goes to start screen."
  89.     llloop:
  90.     _LIMIT 100
  91.     ag2$ = INKEY$
  92.     IF ag2$ = CHR$(27) THEN GOTO start:
  93.     IF ag2$ = "" THEN GOTO llloop:
  94.     IF ag2$ = "y" OR ag$ = "Y" THEN
  95.         SHELL _HIDE "DEL " + nm$
  96.         GOTO saving2:
  97.     END IF
  98.     GOTO llloop:
  100. saving2:
  101. SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
  102. nm$ = ""
  103. FOR snd = 100 TO 500 STEP 100
  104.     SOUND snd, 2
  105. NEXT snd
  107. GOTO start:
  108. SUB SaveImage (image AS LONG, filename AS STRING)
  109.     bytesperpixel& = _PIXELSIZE(image&)
  110.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
  111.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
  112.     x& = _WIDTH(image&)
  113.     y& = _HEIGHT(image&)
  114.     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)
  115.     IF bytesperpixel& = 1 THEN
  116.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  117.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  118.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  119.         NEXT
  120.     END IF
  121.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
  122.     lastsource& = _SOURCE
  123.     _SOURCE image&
  124.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
  125.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
  126.         r$ = ""
  127.         FOR px& = 0 TO x& - 1
  128.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
  129.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
  130.         NEXT px&
  131.         d$ = d$ + r$ + padder$
  132.     NEXT py&
  133.     _SOURCE lastsource&
  134.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
  135.     b$ = b$ + d$ ' total file data bytes to create file
  136.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
  137.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
  138.     f& = FREEFILE
  139.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
  140.     OPEN filename$ + ext$ FOR BINARY AS #f&
  141.     PUT #f&, , b$
  142.     CLOSE #f&
  144.  

And here is the newer color shaded version:

Code: QB64: [Select]
  1.     'Thank you to bplus and the QB64.org forum for the motivation and help!
  2.     'This was made by Ken G. on Oct. 28, 2019.
  3.     _TITLE "Space Bar Makes New Picture, Mouse For Text And Press Enter When Finished, (S)ave To BMP File, Esc to Quit."  
  4.     SCREEN _NEWIMAGE(800, 600, 32)
  5.     again:
  6.     _LIMIT 500
  7.     CLS
  8.     bb = 50
  9.     FOR sky = 0 TO 600
  10.         bb = bb + .25
  11.         LINE (0, sky)-(800, sky), _RGB32(75, 75, bb + 50)
  12.     NEXT sky
  13.     a$ = ""
  14.     seconds = 45
  15.     r = 127
  16.     g = 100
  17.     b = 127
  19.     size = INT(RND * 100)
  21.     amount = INT(RND * 25) + 5
  22.     DO
  23.         RANDOMIZE TIMER
  24.         tt = RND * 90
  25.         xx = RND * 800
  26.         one:
  27.         seconds = seconds + .25
  28.         s = (60 - seconds) * 6 + (180 + tt)
  29.         x = INT(SIN(s / (180 + tt) * 3.141592) * ((180 - t) + size)) + xx
  30.         y = INT(COS(s / (180 + tt) * 3.141592) * ((180 - t) + size)) + 750
  31.         CIRCLE (x, y), 4, _RGB32(r, g, b)
  32.         PAINT (x, y), _RGB32(r, g, b)
  33.         g = g + 1
  34.         IF seconds = 75 THEN
  35.             seconds = 45
  36.             t = t + 1
  37.             IF t = (180 + size) THEN
  38.                 t = 0
  39.                 GOTO more:
  40.             END IF
  41.             g = 100
  42.             GOTO one:
  43.         END IF
  44.         GOTO one:
  45.         more:
  46.         RANDOMIZE TIMER
  47.         size = INT(RND * 100)
  48.         m = m + 1
  49.         IF m = amount THEN EXIT DO
  50.     LOOP
  51.     m = 0
  52.     DO
  53.         _LIMIT 500
  54.         a$ = INKEY$
  55.         IF a$ = " " THEN GOTO again:
  56.         IF a$ = CHR$(27) THEN END
  57.         IF a$ = "s" OR a$ = "S" THEN GOTO saving:
  58.         DO WHILE _MOUSEINPUT
  59.             mouseX = _MOUSEX
  60.             mouseY = _MOUSEY
  61.             mouseLeftButton = _MOUSEBUTTON(1)
  62.         LOOP
  63.         IF mouseLeftButton = -1 THEN
  64.             clr& = POINT(mouseX, mouseY)
  65.             COLOR _RGB32(0, 0, 0), clr&
  66.             LOCATE mouseY / 16, mouseX / 8
  67.             INPUT "", txt$
  68.         END IF
  69.     LOOP
  70.     saving:
  71.     _LIMIT 500
  72.     'Now we call up the SUB to save the image to BMP.
  73.     SaveImage 0, "temp.bmp"
  74.     _DELAY .25
  75.     CLS
  76.     LINE (0, 0)-(800, 600), _RGB32(0, 0, 0), BF
  77.     COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0)
  78.     PRINT "                               Saving"
  79.     PRINT
  80.     PRINT "                  Your BMP file will be saved in the"
  81.     PRINT "                  same directory as this program is."
  82.     PRINT "                  It can be used with almost any"
  83.     PRINT "                  other graphics program or website."
  84.     PRINT "                  It is saved using:"
  85.     PRINT "                  width: 800  height: 600 pixels."
  86.     PRINT
  87.     PRINT "                  Type a name to save your picture"
  88.     PRINT "                  and press the Enter key. Do not"
  89.     PRINT "                  add .bmp at the end, the program"
  90.     PRINT "                  will do it automatically."
  91.     PRINT
  92.     PRINT "                  Also do not use the name temp"
  93.     PRINT "                  because the program uses that name"
  94.     PRINT "                  and it would be erased the next time"
  95.     PRINT "                  you save a picture."
  96.     PRINT "                  Example: MyPic"
  97.     PRINT "                  Quit and Enter key ends program."
  98.     PRINT
  99.     INPUT "         ->"; nm$
  100.     IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
  101.     nm$ = nm$ + ".bmp"
  102.     'Checking to see if the file already exists on your computer.
  103.     theFileExists = _FILEEXISTS(nm$)
  104.     IF theFileExists = -1 THEN
  105.         PRINT
  106.         PRINT "             File Already Exists"
  107.         PRINT "             Saving will delete your old"
  108.         PRINT "             bmp picture."
  109.         PRINT "             Would you like to still do it?"
  110.         PRINT "             (Y/N)."
  111.         PRINT "             Esc goes to start screen."
  112.         llloop:
  113.         _LIMIT 100
  114.         ag2$ = INKEY$
  115.         IF ag2$ = CHR$(27) THEN GOTO again:
  116.         IF ag2$ = "" THEN GOTO llloop:
  117.         IF ag2$ = "y" OR ag$ = "Y" THEN
  118.             SHELL _HIDE "DEL " + nm$
  119.             GOTO saving2:
  120.         END IF
  121.         GOTO llloop:
  122.     END IF
  123.     saving2:
  124.     SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
  125.     nm$ = ""
  126.     FOR snd = 100 TO 500 STEP 100
  127.         SOUND snd, 2
  128.     NEXT snd
  129.     CLS
  130.     GOTO again:
  131.     SUB SaveImage (image AS LONG, filename AS STRING)
  132.         bytesperpixel& = _PIXELSIZE(image&)
  133.         IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
  134.         IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
  135.         x& = _WIDTH(image&)
  136.         y& = _HEIGHT(image&)
  137.         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)
  138.         IF bytesperpixel& = 1 THEN
  139.             FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
  140.                 cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
  141.                 b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
  142.             NEXT
  143.         END IF
  144.         MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
  145.         lastsource& = _SOURCE
  146.         _SOURCE image&
  147.         IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
  148.         FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
  149.             r$ = ""
  150.             FOR px& = 0 TO x& - 1
  151.                 c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
  152.                 IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
  153.             NEXT px&
  154.             d$ = d$ + r$ + padder$
  155.         NEXT py&
  156.         _SOURCE lastsource&
  157.         MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
  158.         b$ = b$ + d$ ' total file data bytes to create file
  159.         MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
  160.         IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
  161.         f& = FREEFILE
  162.         OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
  163.         OPEN filename$ + ext$ FOR BINARY AS #f&
  164.         PUT #f&, , b$
  165.         CLOSE #f&
  166.     END SUB
  167.  
Text Only | Text with Attachments