Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Messages - pagetelegram

Pages: [1] 2
1
QB64 Discussion / Re: Compiler error due to memory limits
« on: December 18, 2018, 12:44:51 pm »
Here is your compiled program:

http://hand.is/alpha4000lines.zip

Works! used fbc!

2
QB64 Discussion / Re: Compiler error due to memory limits
« on: December 18, 2018, 12:36:17 pm »
Did you ever bother to try compiling using fbc, the FreeBasic compiler?

It will get you just what you want....small binary executable and it does compile your stuff when QB64 does not.

Or are you just trolling qb64 in-capabilities with your alphabet soup?

Someone posting your alphabet soup on this forum did crash the MySQL entry rendering this thread inaccessible, yesterday. :P

Fellippe came to the rescue doing some under the engine MySQL to delete that "malicious" alphabet soup of yours lol in the post reply.

For tinfoil=1 to 4000
shell "echo ? "+chr$(34)+"hat's off to you for crashing MySQL database yesterday with your secret 'burn after reading' program"+chr$(34)+" >> hat.bas"
next tinfoil

3
QB64 Discussion / Re: How do you guys keep track of your files?
« on: December 18, 2018, 09:21:01 am »
Quote from: luke on December 18, 2018, 08:30:46 am
Pagetelegram: your mention of curl makes me suspect you might not have the full picture with how git works. git itself is just a local tool, all its internals for a project are kept in a .git folder in your project directory. You manipulate this and your project files with the `git` command (or one of the various gui frontends like sourcetree).

git alo has the ability to synchronise with a 'remote', which is just another git repository on a networked machine. This is what github, bitbucket, gitlab etc. are. You can do all your work locally then push (a git command) to send your work to github. Of course if you make it public this has the benefit of allowing other people to clone the repository and work with it.

Git on windows is... a little awkward to setup. On one hand the gui frontends makethe initial process easier, but I find they obscure the core behaviour of git. On the other hand the command line experience in windows is somewhat lacking. The installer gives the option of installing a cygwin shell which I'd recommend if you've any Unix experience, otherwise you'll just have to tough it out with the cmd version.

The basic "workflow" for a simple project: git init to create a new repository, then git add all your files and git commit. Then when you make a change you just add those files and commit to save them.
Syncing to github is just a git push, which uploads your commits. If you want to take a local backup too, all your committed changes are stored in the .git folder.

Thanks Luke,

I will try the CMD version, hopefully it doesn't require cygwin; hate to add overhead to my system; a huge library unnecessary to load if only using less than 1% of it. And I might write a basic shell program for operating the git command and helping to organize my programs better. Might also include a shell out to any number of editors to create the readme.md file on the spot.

4
Programs / Re: Convert image content to PSET expressions....
« on: December 17, 2018, 10:59:35 pm »
I get memory out of range error, using:

Code: QB64: [Select]
  1.     _MEMGET m, m.OFFSET + writeit, colors  

trying a 400x333 something image.

full program:

Code: QB64: [Select]
  1. DIM fil$(255)
  3. 'DIM m AS _MEM
  5. SHELL _HIDE "dir/b *.jpg > list.txt"
  6. SHELL _HIDE "dir/b *.png >> list.txt"
  7. SHELL _HIDE "dir/b *.bmp >> list.txt"
  8. SHELL _HIDE "dir/b *.gif >> list.txt"
  9. OPEN "list.txt" FOR INPUT AS #1
  10. a = 0
  12.     a = a + 1
  13.     IF NOT (EOF(1)) THEN INPUT #1, fil$(a) ELSE SYSTEM
  14.     list$ = list$ + fil$(a) + "|"
  17. '
  18. ' Originally: COUNTRY.BAS
  19. ' This program asks the user to select his country from a list.
  20. ' The user may press the UP and DOWN arrows or PAGE UP/PAGE DOWN
  21. ' or HOME/END keys to navigate the menu. The user may also start
  22. ' typing the name of his country to find it faster.
  23. '
  24. ' Written by Zsolt Nagy-Perge in October 2018, Pensacola, Fla.
  25. ' <zsolt500n@gmail.com>
  26. '
  27. ' Code adapted in file selector for loadimg.bas by Jason Page
  28. ' December 2018. This program generates a file containing
  29. ' all the pset commands needed to generate any image you put
  30. ' in the program. This is ideal to generate images using for
  31. ' example wwwbasic. This program will only work and compile
  32. ' using QB64. Visit QB64.org to use the free compiler/IDE
  33. ' <pagetelegram@gmail.com>
  34. '
  35. ' QBasic 1.1 source code:
  36. '
  37. DEFINT A-Z
  38. DECLARE SUB CENTER (TEXTCOLOR, ROW, TEXT$)
  39. DECLARE SUB MENU (S, TITLE$, L$, TEXT$)
  40. DECLARE FUNCTION GETWORD$ (L$, N, S)
  41.  
  42. SELECTED = 3
  43. 'list$ = "United States of America|Mexico|Canada|United Kingdom|Australia|Afghanistan|Albania|Algeria|Andorra|Angola|Anguilla|Antigua and Barbuda|Argentina|Armenia|Aruba|Austria|Azerbaijan|Bahamas|Bahrain|Bangladesh|Barbados|Belarus|Belgium|Belize|Benin|Bermuda|Bhutan|Bolivia|Bonaire|Bosnia and Herzegovina|Botswana|Brazil|British Virgin Islands|Brunei|Bulgaria|Burkina Faso|Burundi|Cabo Verde|Cambodia|Cameroon|Cayman Islands|Central African Republic|Chad|Chile|China|Clipperton Island|Colombia|Comoros|Costa Rica|Cote d'Ivoire|Croatia|Cuba|Curacao|Cyprus|Czech Republic|Democratic Republic of the Congo|Denmark|Djibouti|Dominica|Dominican Republic|Ecuador|Egypt|El Salvador|Equatorial Guinea|Eritrea|Estonia|Ethiopia|Fiji|Finland|France|French Polynesia|Gabon|Gambia|Georgia|Germany|Ghana|Greece|Greenland|Grenada|Guadeloupe|Guatemala|Guinea|Guinea-Bissau|Guyana|Haiti|Honduras|Hungary|Iceland|India|Indonesia|Iran|Iraq|Ireland|Israel|Italy|Jamaica|Japan|Jordan|Kazakhstan|Kenya|Kiribati|Kosovo|Kuwait|Kyrgyzstan|Laos|Latvia|Lebanon|Lesotho|Liberia|Libya|Liechtenstein|Lithuania|Luxembourg|Macedonia (FYROM)|Madagascar|Malawi|Malaysia|Maldives|Mali|Malta|Marshall Islands|Martinique|Mauritania|Mauritius|Micronesia|Moldova|Monaco|Mongolia|Montenegro|Montserrat|Morocco|Mozambique|Myanmar (Burma)|Namibia|Nauru|Navassa Island|Nepal|Netherlands|New Zealand|Nicaragua|Niger|Nigeria|North Korea|Norway|Oman|Pakistan|Palau|Palestine|Panama|Papua New Guinea|Paraguay|Peru|Philippines|Poland|Portugal|Puerto Rico|Qatar|Republic of the Congo|Romania|Russia|Rwanda|Saba|Saint Barthelemy|Saint Kitts and Nevis|Saint Lucia|Saint Martin|Saint Pierre and Miquelon|Saint Vincent and the Grenadines|Samoa|San Marino|Sao Tome and Principe|Saudi Arabia|Senegal|Serbia|Seychelles|Sierra Leone|Singapore|Sint Eustatius|Sint Maarten|Slovakia|Slovenia|Solomon Islands|Somalia|South Africa|South Korea|South Sudan|Spain|Sri Lanka|Sudan|Suriname|Swaziland|Sweden|Switzerland|Syria|Taiwan|Tajikistan|Tanzania|Thailand|Timor-Leste|Togo|Tonga|Trinidad and Tobago|Tunisia|Turkey|Turkmenistan|Turks and Caicos Islands|Tuvalu|Uganda|Ukraine|United Arab Emirates|Uruguay|US Virgin Islands|Uzbekistan|Vanuatu|Vatican City|Venezuela|Vietnam|Yemen|Zambia|Zimbabwe"
  44. MENU SELECTED, "Files", list$, "Please select your image file from the list below:"
  45.  
  46. CENTER 15, 10, "You picked :    " + GETWORD$(list$, SELECTED, 124)
  47. fle$ = GETWORD$(list$, SELECTED, 124)
  48.  
  49. SCREEN _NEWIMAGE(640, 480, 32)
  50.  
  51. 'img& = _LOADIMAGE(fle$, 32) 'load the image file to be drawn
  52.  
  53. n = _LOADIMAGE(fle$, 32)
  54. m = _MEMIMAGE(n) 'screen memory of image
  55.  
  56. 'wide% = _WIDTH(img&): deep% = _HEIGHT(img&)
  57. 'TLC$ = "BL" + STR$(wide% \ 2) + "BU" + STR$(deep% \ 2) 'start draw at top left corner
  58. 'RET$ = "BD BL" + STR$(wide%) 'return to left side of image
  59. '_SOURCE img&
  60. '_DEST 0
  61. 'SHELL "echo. > pset.txt"
  62. 'OPEN "pset.txt" FOR OUTPUT AS #2
  63. 'CLS
  64. 'Tmp& = _NEWIMAGE(32, 32, 256)
  65. 'DO
  66. '    x = x + 1
  67. 'IF x > wide% THEN
  68. 'x = 0: y = y + 1
  69. 'END IF
  70. 'DRAW "C" + STR$(POINT(x, y)) + "R1" 'color and DRAW each pixel
  71. '
  72. 'colour~& = POINT(x, y)
  73. 'c% = _RGB(_RED32(colour~&), _GREEN32(colour~&), _BLUE32(colour~&), Tmp&)
  74. 'clr = (c%) 'POINT(x, y) / (16553 * 256 * 16 * 8)
  75. 'x$ = STR$(x)
  76. 'y$ = STR$(y)
  77. 'clr$ = STR$(clr)
  78. 'PRINT #2, "pset(" + x$ + CHR$(44) + y$ + ")" + CHR$(44) + clr$
  79. 'LOCATE 2, 1: PRINT x, y
  80. 'PSET (x, y), clr
  81.  
  82. 'LOOP UNTIL y >= deep%
  83. 'CLOSE #2
  84. 'LOCATE 22, 1
  85. 'PRINT "Saved as pset.txt"
  86. 'SLEEP 1
  87.  
  88. ' Steve Contrib (SMcNeill):
  89.  
  90. 'DIM c AS _UNSIGNED LONG 'color value of the pixels
  91. 'DIM ShortByte AS _UNSIGNED _BYTE, LongData AS _UNSIGNED LONG
  92. 'ShortByte = 0
  93. SHELL _HIDE "echo. > databas.txt"
  94. ''open  a file for saving
  95. 'OPEN "databas.txt" FOR OUTPUT AS #1
  96.  
  97.  
  98. 'DO UNTIL finished
  99. 'count = 1 'count is the count of repetitive times a color appears in a row
  100. '_MEMGET m, m.OFFSET + p * 4, c 'p is the current point
  101. 'IF p >= m.SIZE THEN
  102. '    finished = -1
  103. 'ELSE
  104. '    IF (p + count) * 4 >= m.SIZE THEN
  105. '    finished = -1
  106. 'ELSE
  107. '    DO UNTIL _MEMGET(m, m.OFFSET + (p + count) * 4, _UNSIGNED LONG) <> c
  108. '    count = count + 1
  109. '    IF (p + count) * 4 >= m.SIZE THEN finished = -1: count = count - 1: EXIT DO
  110. 'LOOP
  111. 'END IF
  112. 'END IF
  113. 'p = p + count
  114. 'r = _RED32(c): g = _GREEN32(c): b = _BLUE32(c)
  115. 'PRINT #1, "DATA "; r; ","; g; ","; b; ",";
  116. 'IF count > 255 THEN
  117. '    LongData = count
  118. 'PRINT #1, ShortByte; ","; LongData
  119. 'ELSE
  120. '    ShortByte = count
  121. 'PRINT #1, ShortByte
  122. 'END IF
  123. 'ShortByte = 0 'reset the default count to 0
  124. 'LOOP
  125.  
  126. 'free resources
  127. 'CLOSE #1
  128. '_MEMFREE m
  129. ' Example by Petr
  130.  
  131. image = n '_LOADIMAGE(fle$, 32)
  132. outfile$ = "databas.txt"
  133. chan = FREEFILE
  134. OPEN outfile$ FOR OUTPUT AS #chan 'but binary access is much faster than input / output mode
  135. head$ = "DATA " + STR$(_WIDTH(image)) + "," + STR$(_HEIGHT(image))
  136. PRINT #chan, head$
  137.  
  138.  
  139. m = _MEMIMAGE(image)
  140.  
  141. FOR writeit = 0 TO _WIDTH(image) * _HEIGHT(image) * 4 - 4 STEP 4
  142.     _MEMGET m, m.OFFSET + writeit, colors
  143.     R = _RED32(colors): G = _GREEN32(colors): B = _BLUE32(colors)
  144.     d$ = "DATA " + STR$(R) + "," + STR$(G) + "," + STR$(B)
  145.     PRINT #chan, d$ '
  147. CLOSE #chan
  148.  
  149. LOCATE 23, 1
  150. PRINT "Image saved as database.txt"
  151.  
  152. SUB MENU (S, TITLE$, L$, TEXT$)
  153.  
  154.     C0 = 0 ' Main window background pick:0-7
  155.     C1 = 7 ' Color 2 (FG) pick:0-7
  156.     C2 = 0 ' Color 1 (BG) pick:0-7
  157.     C3 = 15 ' Typing color pick:0-15
  158.     C4 = 12 ' Mistyped item color pick:0-15
  159.     C5 = 9 ' Title color (TITLE$) pick:0-15
  160.     C6 = 14 ' Description color (TEXT$) pick:0-15
  161.  
  162.     ORIGINAL = S
  163.     SCREEN 0
  164.     WIDTH 80, 25
  165.     COLOR C1, C0
  166.     CLS
  167.  
  168.     ' Display title.
  169.     CENTER C5, 2, TITLE$
  170.  
  171.     ' Display description text.
  172.     CENTER C6, 4, TEXT$
  173.  
  174.     REDIM C$(1 TO 250) ' <<< Array size may need to be modified.
  175.  
  176.     ' Split list into string array
  177.     P = 1
  178.     LL = 0 ' Longest line
  179.     FOR I = 1 TO UBOUND(C$)
  180.         F = P
  181.         P = INSTR(P, L$, "|")
  182.         IF P < 1 THEN P = 9999
  183.         C$(I) = MID$(L$, F, P - F)
  184.         IF LL < LEN(C$(I)) THEN LL = LEN(C$(I))
  185.         IF P = 9999 THEN EXIT FOR
  186.         P = P + 1
  187.     NEXT I
  188.  
  189.     ' S   = Selected Item
  190.     ' LL  = Longest line length
  191.     MM = I ' MM  = Number of menu items
  192.     W$ = "" ' W$  = User typed search text
  193.     N = 0 ' N   = User typed search text found?
  194.     F = 0 ' F   = Vertical Display Offset
  195.     M = 8 ' M   = Number of menu items to display on screen
  196.     TOP = 5 ' TOP = Top row where menu starts Y
  197.     ' X   = Start printing menu at pos X
  198.     X = 33 - FIX(LL / 2)
  199.  
  200.  
  201.     ' Displays a menu on the screen, and allows the user to select
  202.     ' one item from the list. L$ should contain the list of menu items
  203.     ' separated by the | character. S will hold the number of the
  204.     ' selected menu item. If S is 5 at the beginning, this means the
  205.     ' 5th item on the list is selected by default. If the user picks
  206.     ' a different menu item and presses Enter, then S will change.
  207.     ' If the user presses ESC, ALT+X or ALT+F4, S will be -1.
  208.     '
  209.  
  210.  
  211.     DO
  212.         ' Print menu items
  213.         FOR I = 1 TO M
  214.             Y = I * 2 + TOP
  215.             IF S = I + F THEN
  216.                 COLOR C2, C1
  217.             ELSE
  218.                 COLOR C1, C2
  219.             END IF
  220.             T$ = C$(I + F)
  221.             LOCATE Y, X: PRINT SPACE$(5); T$; SPACE$(LL - LEN(T$) + 10);
  222.         NEXT I
  223.  
  224.         ' Put lines or spaces among menu items
  225.         FOR I = 1 TO M + 1
  226.             IF S = I + F THEN
  227.                 COLOR C1, C2
  228.             ELSEIF S = I + F - 1 THEN
  229.                 COLOR C2, C1
  230.             ELSE
  231.                 COLOR C2, C2
  232.             END IF
  233.             LOCATE I * 2 + TOP - 1, X: PRINT STRING$(LL + 15, CHR$(220));
  234.         NEXT I
  235.  
  236.         ' Print search text
  237.         IF N THEN COLOR C3, C2 ELSE COLOR C4, C2
  238.         Z$ = LEFT$(W$, 40)
  239.         LOCATE 24, 20: PRINT Z$; SPACE$(40 - LEN(Z$));
  240.         IF LEN(W$) THEN LOCATE 24, 20 + LEN(Z$), 1, 12, 13 ELSE LOCATE 1, 1, 0
  241.  
  242.         K$ = "": WHILE K$ = "": K$ = INKEY$: WEND
  243.  
  244.         LOCATE 1, 1, 0 ' Turn off cursor
  245.  
  246.         ' Process search text
  247.         N = 0
  248.         IF LEN(K$) = 1 THEN
  249.             U = ASC(UCASE$(K$))
  250.             IF LEN(W$) AND K$ = CHR$(8) THEN ' BACKSPACE
  251.                 W$ = LEFT$(W$, LEN(W$) - 1)
  252.             ELSEIF U = 32 OR U > 64 AND U < 91 OR (U > 47 AND U < 58) THEN ' TYPING
  253.                 W$ = W$ + K$
  254.             END IF
  255.             IF LEN(W$) THEN
  256.                 FOR G = 1 TO UBOUND(C$) ' FIND ITEM
  257.                     IF UCASE$(LEFT$(C$(G), LEN(W$))) = UCASE$(W$) THEN
  258.                         N = 1
  259.                         S = G
  260.                         IF S < F OR S > F + M THEN
  261.                             F = S - FIX(M / 2)
  262.                             IF F < 0 THEN F = 0
  263.                             IF F > MM - M THEN F = MM - M
  264.                         END IF
  265.                         EXIT FOR
  266.                     END IF
  267.                 NEXT G
  268.             END IF
  269.         END IF
  270.  
  271.         SELECT CASE K$
  272.             CASE CHR$(0) + "G": ' HOME
  273.                 W$ = ""
  274.                 S = 1
  275.                 F = 0
  276.             CASE CHR$(0) + "O": ' END
  277.                 W$ = ""
  278.                 S = MM
  279.                 F = MM - M
  280.                 IF F < 0 THEN F = 0
  281.             CASE CHR$(0) + "I": ' PGUP
  282.                 W$ = ""
  283.                 S = S - M
  284.                 F = F - M
  285.                 IF S < 1 THEN S = 1
  286.                 IF F < 0 THEN F = 0
  287.             CASE CHR$(0) + "Q": ' PGDN
  288.                 W$ = ""
  289.                 S = S + M
  290.                 F = F + M
  291.                 IF S > MM THEN S = MM
  292.                 IF F > MM - M THEN F = MM - M
  293.                 IF F < 0 THEN F = 0
  294.             CASE CHR$(0) + "H": ' UP ARROW
  295.                 W$ = ""
  296.                 IF S > 1 THEN
  297.                     S = S - 1
  298.                     IF S <= F THEN F = F - 1
  299.                 END IF
  300.             CASE CHR$(0) + "P": ' DOWN ARROW
  301.                 W$ = ""
  302.                 IF S < MM THEN
  303.                     S = S + 1
  304.                     IF S >= F + I - 1 THEN F = F + 1
  305.                 END IF
  306.             CASE CHR$(13): EXIT DO ' ENTER
  307.             CASE CHR$(0) + "K": EXIT DO ' LEFT ARROW
  308.             CASE CHR$(0) + "M": EXIT DO ' RIGHT ARROW
  309.             CASE CHR$(0) + "-": S = -1: EXIT DO ' ALT-X
  310.             CASE CHR$(0) + "k": S = -1: EXIT DO ' ALT-F4
  311.             CASE CHR$(27): S = -1: EXIT DO ' ESC
  312.         END SELECT
  313.     LOOP
  314.  
  315.     ERASE C$
  316.     COLOR 7, 0
  317.     CLS
  318.  
  320.  
  321. ' Prints some text in the middle of the screen.
  322. ' We're assuming 80x25 color text mode.
  323. SUB CENTER (TEXTCOLOR, ROW, TEXT$)
  324.     COLOR TEXTCOLOR
  325.     LOCATE ROW, 40 - FIX(LEN(TEXT$) / 2): PRINT TEXT$;
  327.  
  328. ' This function returns the Nth word from a list.
  329. ' Words must be separated by the separator character S.
  330. ' S must hold the ASCII value of the character to be
  331. ' used as a separator character. i.e. S=32 means space
  332. ' Example:
  333. '    GETWORD$("apples peaches kiwi grapes", 1, 32) -> "apples"
  334. '    GETWORD$("apples/peaches/kiwi/grapes", 3, 47) -> "kiwi"
  335. '    GETWORD$("apples+peaches+kiwi+grapes", 9, 43) -> "" (out of range)
  336. '
  337. FUNCTION GETWORD$ (L$, N, S)
  338.     LL = LEN(L$)
  339.     IF N < 1 OR N > LL / 2 + 2 THEN GETWORD$ = "": EXIT FUNCTION
  340.     W = 0
  341.     F = 0
  342.     FOR I = 1 TO LL + 1
  343.         IF I > LL THEN C = S ELSE C = ASC(MID$(L$, I, 1))
  344.         IF C = S THEN
  345.             IF F AND W = N THEN
  346.                 GETWORD$ = MID$(L$, F, I - F)
  347.                 EXIT FUNCTION
  348.             END IF
  349.             F = 0
  350.         ELSE
  351.             IF F = 0 THEN F = I: W = W + 1
  352.         END IF
  353.     NEXT I
  354.     GETWORD$ = ""
  356.  
  357.  

5
Programs / Re: Convert image content to PSET expressions....
« on: December 17, 2018, 10:06:58 pm »
Thank you!

I'll post final code and wwwbasic template example once I get it all working.

6
Programs / Re: Convert image content to PSET expressions....
« on: December 17, 2018, 08:28:41 pm »
Found this on an old forum on Pete's site:


color = 65536 * BLUE + 256 * GREEN + RED

wondering if that will work in wwwbasic the same.

7
QB64 Discussion / Re: My QB64 debut anniversary
« on: December 17, 2018, 06:23:53 pm »
QB64 is what re-woke my dusty DOS programming into the new world!

Thank you,

Maybe a history book should be in the works of everyone major behind the effort.

8
Programs / Re: Convert image content to PSET expressions....
« on: December 17, 2018, 06:18:50 pm »
Petr,

Nice though:

How do I do this in 1981 BASIC:

k = _RGB32(r, g, b)
        PSET (drawX, drawY), k

what exactly does RGB32(r,g,b) do under the hood in BASIC language?

9
QB64 Discussion / Re: A look to QB64 from the external of QB64 community
« on: December 17, 2018, 05:04:43 pm »
Quote from: TempodiBasic on December 17, 2018, 04:17:33 pm

1. What do you think about how we seem to the WWW?
2. What is not present in our QB64 to let it appear a good enviroment of development today?

1. I googled around about 10 years ago and found it that way looking for a 32/64 bit way to compile my old 16 bit DOS programs bc you can't expect noobs to know how to use DOSbox etc.

2. For me, it is good development platform for command line level. I have not tried the form option yet and I'm not too interested in it either. Everything just works better in DOS.

Also the introduction of the _STATEMENTS have expanded the use of the programming to modern application/device support

What I would like to see is audio sound card Input and Soft-Modem i/o use. Most audio stuff supported is only output.

10
Programs / Re: Convert image content to PSET expressions....
« on: December 17, 2018, 04:32:57 pm »
Thank you,

Program now works, after debugging some other obvious issues.

Code: QB64: [Select]
  1. DIM fil$(255)
  3. SHELL _HIDE "dir/b *.jpg > list.txt"
  4. SHELL _HIDE "dir/b *.png >> list.txt"
  5. SHELL _HIDE "dir/b *.bmp >> list.txt"
  6. SHELL _HIDE "dir/b *.gif >> list.txt"
  7. OPEN "list.txt" FOR INPUT AS #1
  8. a = 0
  10.     a = a + 1
  11.     IF NOT (EOF(1)) THEN INPUT #1, fil$(a) ELSE SYSTEM
  12.     list$ = list$ + fil$(a) + "|"
  15. '
  16. ' Originally: COUNTRY.BAS
  17. ' This program asks the user to select his country from a list.
  18. ' The user may press the UP and DOWN arrows or PAGE UP/PAGE DOWN
  19. ' or HOME/END keys to navigate the menu. The user may also start
  20. ' typing the name of his country to find it faster.
  21. '
  22. ' Written by Zsolt Nagy-Perge in October 2018, Pensacola, Fla.
  23. ' <zsolt500n@gmail.com>
  24. '
  25. ' Code adapted in file selector for loadimg.bas by Jason Page
  26. ' December 2018. This program generates a file containing
  27. ' all the pset commands needed to generate any image you put
  28. ' in the program. This is ideal to generate images using for
  29. ' example wwwbasic. This program will only work and compile
  30. ' using QB64. Visit QB64.org to use the free compiler/IDE
  31. ' <pagetelegram@gmail.com>
  32. '
  33. ' QBasic 1.1 source code:
  34. '
  35. DEFINT A-Z
  36. DECLARE SUB CENTER (TEXTCOLOR, ROW, TEXT$)
  37. DECLARE SUB MENU (S, TITLE$, L$, TEXT$)
  38. DECLARE FUNCTION GETWORD$ (L$, N, S)
  39.  
  40. SELECTED = 3
  41. 'list$ = "United States of America|Mexico|Canada|United Kingdom|Australia|Afghanistan|Albania|Algeria|Andorra|Angola|Anguilla|Antigua and Barbuda|Argentina|Armenia|Aruba|Austria|Azerbaijan|Bahamas|Bahrain|Bangladesh|Barbados|Belarus|Belgium|Belize|Benin|Bermuda|Bhutan|Bolivia|Bonaire|Bosnia and Herzegovina|Botswana|Brazil|British Virgin Islands|Brunei|Bulgaria|Burkina Faso|Burundi|Cabo Verde|Cambodia|Cameroon|Cayman Islands|Central African Republic|Chad|Chile|China|Clipperton Island|Colombia|Comoros|Costa Rica|Cote d'Ivoire|Croatia|Cuba|Curacao|Cyprus|Czech Republic|Democratic Republic of the Congo|Denmark|Djibouti|Dominica|Dominican Republic|Ecuador|Egypt|El Salvador|Equatorial Guinea|Eritrea|Estonia|Ethiopia|Fiji|Finland|France|French Polynesia|Gabon|Gambia|Georgia|Germany|Ghana|Greece|Greenland|Grenada|Guadeloupe|Guatemala|Guinea|Guinea-Bissau|Guyana|Haiti|Honduras|Hungary|Iceland|India|Indonesia|Iran|Iraq|Ireland|Israel|Italy|Jamaica|Japan|Jordan|Kazakhstan|Kenya|Kiribati|Kosovo|Kuwait|Kyrgyzstan|Laos|Latvia|Lebanon|Lesotho|Liberia|Libya|Liechtenstein|Lithuania|Luxembourg|Macedonia (FYROM)|Madagascar|Malawi|Malaysia|Maldives|Mali|Malta|Marshall Islands|Martinique|Mauritania|Mauritius|Micronesia|Moldova|Monaco|Mongolia|Montenegro|Montserrat|Morocco|Mozambique|Myanmar (Burma)|Namibia|Nauru|Navassa Island|Nepal|Netherlands|New Zealand|Nicaragua|Niger|Nigeria|North Korea|Norway|Oman|Pakistan|Palau|Palestine|Panama|Papua New Guinea|Paraguay|Peru|Philippines|Poland|Portugal|Puerto Rico|Qatar|Republic of the Congo|Romania|Russia|Rwanda|Saba|Saint Barthelemy|Saint Kitts and Nevis|Saint Lucia|Saint Martin|Saint Pierre and Miquelon|Saint Vincent and the Grenadines|Samoa|San Marino|Sao Tome and Principe|Saudi Arabia|Senegal|Serbia|Seychelles|Sierra Leone|Singapore|Sint Eustatius|Sint Maarten|Slovakia|Slovenia|Solomon Islands|Somalia|South Africa|South Korea|South Sudan|Spain|Sri Lanka|Sudan|Suriname|Swaziland|Sweden|Switzerland|Syria|Taiwan|Tajikistan|Tanzania|Thailand|Timor-Leste|Togo|Tonga|Trinidad and Tobago|Tunisia|Turkey|Turkmenistan|Turks and Caicos Islands|Tuvalu|Uganda|Ukraine|United Arab Emirates|Uruguay|US Virgin Islands|Uzbekistan|Vanuatu|Vatican City|Venezuela|Vietnam|Yemen|Zambia|Zimbabwe"
  42. MENU SELECTED, "Files", list$, "Please select your image file from the list below:"
  43.  
  44. CENTER 15, 10, "You picked :    " + GETWORD$(list$, SELECTED, 124)
  45. fle$ = GETWORD$(list$, SELECTED, 124)
  46.  
  47. SCREEN _NEWIMAGE(640, 480, 32)
  48.  
  49. img& = _LOADIMAGE(fle$, 32) 'load the image file to be drawn
  51. n = _LOADIMAGE(fle$, 32)
  52. m = _MEMIMAGE(n) 'screen memory of image
  53.  
  54. wide% = _WIDTH(img&): deep% = _HEIGHT(img&)
  55. TLC$ = "BL" + STR$(wide% \ 2) + "BU" + STR$(deep% \ 2) 'start draw at top left corner
  56. RET$ = "BD BL" + STR$(wide%) 'return to left side of image
  57. _SOURCE img&
  59. SHELL "echo. > pset.txt"
  60. OPEN "pset.txt" FOR OUTPUT AS #2
  62. Tmp& = _NEWIMAGE(32, 32, 256)
  64.     x = x + 1
  65.     IF x > wide% THEN
  66.         x = 0: y = y + 1
  67.     END IF
  68.     DRAW "C" + STR$(POINT(x, y)) + "R1" 'color and DRAW each pixel
  69.  
  70.     colour~& = POINT(x, y)
  71.     c% = _RGB(_RED32(colour~&), _GREEN32(colour~&), _BLUE32(colour~&), Tmp&)
  72.     clr = (c%) 'POINT(x, y) / (16553 * 256 * 16 * 8)
  73.     x$ = STR$(x)
  74.     y$ = STR$(y)
  75.     clr$ = STR$(clr)
  76.     PRINT #2, "pset(" + x$ + CHR$(44) + y$ + ")" + CHR$(44) + clr$
  77.     'LOCATE 2, 1: PRINT x, y
  78.     PSET (x, y), clr
  79.  
  80. LOOP UNTIL y >= deep%
  82. LOCATE 22, 1
  83. PRINT "Saved as pset.txt"
  85.  
  86. ' Steve Contrib:
  87.  
  88. DIM c AS _UNSIGNED LONG 'color value of the pixels
  89. DIM ShortByte AS _UNSIGNED _BYTE, LongData AS _UNSIGNED LONG
  90. ShortByte = 0
  91. SHELL _HIDE "echo. > databas.txt"
  92. 'open  a file for saving
  93. OPEN "databas.txt" FOR OUTPUT AS #1
  94.  
  95.  
  96. DO UNTIL finished
  97.     count = 1 'count is the count of repetitive times a color appears in a row
  98.     _MEMGET m, m.OFFSET + p * 4, c 'p is the current point
  99.     IF p >= m.SIZE THEN
  100.         finished = -1
  101.     ELSE
  102.         IF (p + count) * 4 >= m.SIZE THEN
  103.             finished = -1
  104.         ELSE
  105.             DO UNTIL _MEMGET(m, m.OFFSET + (p + count) * 4, _UNSIGNED LONG) <> c
  106.                 count = count + 1
  107.                 IF (p + count) * 4 >= m.SIZE THEN finished = -1: count = count - 1: EXIT DO
  108.             LOOP
  109.         END IF
  110.     END IF
  111.     p = p + count
  112.     r = _RED32(c): g = _GREEN32(c): b = _BLUE32(c)
  113.     PRINT #1, "DATA "; r; ","; g; ","; b; ",";
  114.     IF count > 255 THEN
  115.         LongData = count
  116.         PRINT #1, ShortByte; ","; LongData
  117.     ELSE
  118.         ShortByte = count
  119.         PRINT #1, ShortByte
  120.     END IF
  121.     ShortByte = 0 'reset the default count to 0
  123.  
  124. 'free resources
  127. LOCATE 23, 1
  128. PRINT "Image saved as database.txt"
  129.  
  130. SUB MENU (S, TITLE$, L$, TEXT$)
  131.  
  132.     C0 = 0 ' Main window background pick:0-7
  133.     C1 = 7 ' Color 2 (FG) pick:0-7
  134.     C2 = 0 ' Color 1 (BG) pick:0-7
  135.     C3 = 15 ' Typing color pick:0-15
  136.     C4 = 12 ' Mistyped item color pick:0-15
  137.     C5 = 9 ' Title color (TITLE$) pick:0-15
  138.     C6 = 14 ' Description color (TEXT$) pick:0-15
  139.  
  140.     ORIGINAL = S
  141.     SCREEN 0
  142.     WIDTH 80, 25
  143.     COLOR C1, C0
  144.     CLS
  145.  
  146.     ' Display title.
  147.     CENTER C5, 2, TITLE$
  148.  
  149.     ' Display description text.
  150.     CENTER C6, 4, TEXT$
  151.  
  152.     REDIM C$(1 TO 250) ' <<< Array size may need to be modified.
  153.  
  154.     ' Split list into string array
  155.     P = 1
  156.     LL = 0 ' Longest line
  157.     FOR I = 1 TO UBOUND(C$)
  158.         F = P
  159.         P = INSTR(P, L$, "|")
  160.         IF P < 1 THEN P = 9999
  161.         C$(I) = MID$(L$, F, P - F)
  162.         IF LL < LEN(C$(I)) THEN LL = LEN(C$(I))
  163.         IF P = 9999 THEN EXIT FOR
  164.         P = P + 1
  165.     NEXT I
  166.  
  167.     ' S   = Selected Item
  168.     ' LL  = Longest line length
  169.     MM = I ' MM  = Number of menu items
  170.     W$ = "" ' W$  = User typed search text
  171.     N = 0 ' N   = User typed search text found?
  172.     F = 0 ' F   = Vertical Display Offset
  173.     M = 8 ' M   = Number of menu items to display on screen
  174.     TOP = 5 ' TOP = Top row where menu starts Y
  175.     ' X   = Start printing menu at pos X
  176.     X = 33 - FIX(LL / 2)
  177.  
  178.  
  179.     ' Displays a menu on the screen, and allows the user to select
  180.     ' one item from the list. L$ should contain the list of menu items
  181.     ' separated by the | character. S will hold the number of the
  182.     ' selected menu item. If S is 5 at the beginning, this means the
  183.     ' 5th item on the list is selected by default. If the user picks
  184.     ' a different menu item and presses Enter, then S will change.
  185.     ' If the user presses ESC, ALT+X or ALT+F4, S will be -1.
  186.     '
  187.  
  188.  
  189.     DO
  190.         ' Print menu items
  191.         FOR I = 1 TO M
  192.             Y = I * 2 + TOP
  193.             IF S = I + F THEN
  194.                 COLOR C2, C1
  195.             ELSE
  196.                 COLOR C1, C2
  197.             END IF
  198.             T$ = C$(I + F)
  199.             LOCATE Y, X: PRINT SPACE$(5); T$; SPACE$(LL - LEN(T$) + 10);
  200.         NEXT I
  201.  
  202.         ' Put lines or spaces among menu items
  203.         FOR I = 1 TO M + 1
  204.             IF S = I + F THEN
  205.                 COLOR C1, C2
  206.             ELSEIF S = I + F - 1 THEN
  207.                 COLOR C2, C1
  208.             ELSE
  209.                 COLOR C2, C2
  210.             END IF
  211.             LOCATE I * 2 + TOP - 1, X: PRINT STRING$(LL + 15, CHR$(220));
  212.         NEXT I
  213.  
  214.         ' Print search text
  215.         IF N THEN COLOR C3, C2 ELSE COLOR C4, C2
  216.         Z$ = LEFT$(W$, 40)
  217.         LOCATE 24, 20: PRINT Z$; SPACE$(40 - LEN(Z$));
  218.         IF LEN(W$) THEN LOCATE 24, 20 + LEN(Z$), 1, 12, 13 ELSE LOCATE 1, 1, 0
  219.  
  220.         K$ = "": WHILE K$ = "": K$ = INKEY$: WEND
  221.  
  222.         LOCATE 1, 1, 0 ' Turn off cursor
  223.  
  224.         ' Process search text
  225.         N = 0
  226.         IF LEN(K$) = 1 THEN
  227.             U = ASC(UCASE$(K$))
  228.             IF LEN(W$) AND K$ = CHR$(8) THEN ' BACKSPACE
  229.                 W$ = LEFT$(W$, LEN(W$) - 1)
  230.             ELSEIF U = 32 OR U > 64 AND U < 91 OR (U > 47 AND U < 58) THEN ' TYPING
  231.                 W$ = W$ + K$
  232.             END IF
  233.             IF LEN(W$) THEN
  234.                 FOR G = 1 TO UBOUND(C$) ' FIND ITEM
  235.                     IF UCASE$(LEFT$(C$(G), LEN(W$))) = UCASE$(W$) THEN
  236.                         N = 1
  237.                         S = G
  238.                         IF S < F OR S > F + M THEN
  239.                             F = S - FIX(M / 2)
  240.                             IF F < 0 THEN F = 0
  241.                             IF F > MM - M THEN F = MM - M
  242.                         END IF
  243.                         EXIT FOR
  244.                     END IF
  245.                 NEXT G
  246.             END IF
  247.         END IF
  248.  
  249.         SELECT CASE K$
  250.             CASE CHR$(0) + "G": ' HOME
  251.                 W$ = ""
  252.                 S = 1
  253.                 F = 0
  254.             CASE CHR$(0) + "O": ' END
  255.                 W$ = ""
  256.                 S = MM
  257.                 F = MM - M
  258.                 IF F < 0 THEN F = 0
  259.             CASE CHR$(0) + "I": ' PGUP
  260.                 W$ = ""
  261.                 S = S - M
  262.                 F = F - M
  263.                 IF S < 1 THEN S = 1
  264.                 IF F < 0 THEN F = 0
  265.             CASE CHR$(0) + "Q": ' PGDN
  266.                 W$ = ""
  267.                 S = S + M
  268.                 F = F + M
  269.                 IF S > MM THEN S = MM
  270.                 IF F > MM - M THEN F = MM - M
  271.                 IF F < 0 THEN F = 0
  272.             CASE CHR$(0) + "H": ' UP ARROW
  273.                 W$ = ""
  274.                 IF S > 1 THEN
  275.                     S = S - 1
  276.                     IF S <= F THEN F = F - 1
  277.                 END IF
  278.             CASE CHR$(0) + "P": ' DOWN ARROW
  279.                 W$ = ""
  280.                 IF S < MM THEN
  281.                     S = S + 1
  282.                     IF S >= F + I - 1 THEN F = F + 1
  283.                 END IF
  284.             CASE CHR$(13): EXIT DO ' ENTER
  285.             CASE CHR$(0) + "K": EXIT DO ' LEFT ARROW
  286.             CASE CHR$(0) + "M": EXIT DO ' RIGHT ARROW
  287.             CASE CHR$(0) + "-": S = -1: EXIT DO ' ALT-X
  288.             CASE CHR$(0) + "k": S = -1: EXIT DO ' ALT-F4
  289.             CASE CHR$(27): S = -1: EXIT DO ' ESC
  290.         END SELECT
  291.     LOOP
  292.  
  293.     ERASE C$
  294.     COLOR 7, 0
  295.     CLS
  296.  
  298.  
  299. ' Prints some text in the middle of the screen.
  300. ' We're assuming 80x25 color text mode.
  301. SUB CENTER (TEXTCOLOR, ROW, TEXT$)
  302.     COLOR TEXTCOLOR
  303.     LOCATE ROW, 40 - FIX(LEN(TEXT$) / 2): PRINT TEXT$;
  305.  
  306. ' This function returns the Nth word from a list.
  307. ' Words must be separated by the separator character S.
  308. ' S must hold the ASCII value of the character to be
  309. ' used as a separator character. i.e. S=32 means space
  310. ' Example:
  311. '    GETWORD$("apples peaches kiwi grapes", 1, 32) -> "apples"
  312. '    GETWORD$("apples/peaches/kiwi/grapes", 3, 47) -> "kiwi"
  313. '    GETWORD$("apples+peaches+kiwi+grapes", 9, 43) -> "" (out of range)
  314. '
  315. FUNCTION GETWORD$ (L$, N, S)
  316.     LL = LEN(L$)
  317.     IF N < 1 OR N > LL / 2 + 2 THEN GETWORD$ = "": EXIT FUNCTION
  318.     W = 0
  319.     F = 0
  320.     FOR I = 1 TO LL + 1
  321.         IF I > LL THEN C = S ELSE C = ASC(MID$(L$, I, 1))
  322.         IF C = S THEN
  323.             IF F AND W = N THEN
  324.                 GETWORD$ = MID$(L$, F, I - F)
  325.                 EXIT FUNCTION
  326.             END IF
  327.             F = 0
  328.         ELSE
  329.             IF F = 0 THEN F = I: W = W + 1
  330.         END IF
  331.     NEXT I
  332.     GETWORD$ = ""
  334.  

11
QB64 Discussion / Re: Compiler error due to memory limits
« on: December 17, 2018, 03:55:12 pm »
OP, you kind of sound a bit like me on one point I think we can relate: with your expression that "every byte was worth it's weight in gold." I could concur with that, that Moore's law has led to bloat in my opinion.

However I also concur to William Strunk's philosophy to "omit needless words," in the Elements of Style even though I maybe better at that as a writer than  as a programmer.

With programming, I'm a tad bit lazy to think about organization and making code easily understandable by others with well put remarks and variable names that make sense.

12
QB64 Discussion / Re: How big is yours?
« on: December 17, 2018, 03:35:22 pm »
Quote from: rcamp48 on December 02, 2018, 05:55:33 am
My Lottery programs are only 3000 line max, but my data for them can extend to 10,000 lines depending on how many draws have been made and how far back I go, generally I go back at least 5 years. Russ

Lottery program?

Anything like this ?

http://pagetelegram.com/piball.html


A lot less lines than 4k tho.

13
QB64 Discussion / Re: Compiler error due to memory limits
« on: December 17, 2018, 03:21:42 pm »
Ryster,

Use FreeBasic! With that compiler every byte does counts! Instead of a 1.5mb+ QB64 compile you get your old DOS sized 40kb+ compiled executable.

Just put
Code: QB64: [Select]
  1. #lang "qb"
  2.  

at the top of your code and compile away!


https://www.freebasic.net/

14
Programs / Re: Convert image content to PSET expressions....
« on: December 17, 2018, 03:16:09 pm »
Steve, I do not want to screen grab just load from file.

I'm lost in this new method unable to feasibly translate from old method.

The problem I have is in the '_MEM' method, which I do not understand.

Here is the code I have so far in my initial attempt to adapt:

Code: QB64: [Select]
  1. DIM fil$(255)
  3. SHELL _HIDE "dir/b *.jpg > list.txt"
  4. SHELL _HIDE "dir/b *.png >> list.txt"
  5. SHELL _HIDE "dir/b *.bmp >> list.txt"
  6. SHELL _HIDE "dir/b *.gif >> list.txt"
  7. OPEN "list.txt" FOR INPUT AS #1
  8. a = 0
  10.     a = a + 1
  11.     IF NOT (EOF(1)) THEN INPUT #1, fil$(a) ELSE SYSTEM
  12.     list$ = list$ + fil$(a) + "|"
  15. '
  16. ' COUNTRY.BAS
  17. ' This program asks the user to select his country from a list.
  18. ' The user may press the UP and DOWN arrows or PAGE UP/PAGE DOWN
  19. ' or HOME/END keys to navigate the menu. The user may also start
  20. ' typing the name of his country to find it faster.
  21. '
  22. ' Written by Zsolt Nagy-Perge in October 2018, Pensacola, Fla.
  23. ' <zsolt500n@gmail.com>
  24. '
  25. ' Code adapted in file selector for loadimg.bas by Jason Page
  26. ' December 2018. This program generates a file containing
  27. ' all the pset commands needed to generate any image you put
  28. ' in the program. This is ideal to generate images using for
  29. ' example wwwbasic. This program will only work and compile
  30. ' using QB64. Visit QB64.org to use the free compiler/IDE
  31. ' <pagetelegram@gmail.com>
  32. '
  33. ' QBasic 1.1 source code:
  34. '
  35. DEFINT A-Z
  36. DECLARE SUB CENTER (TEXTCOLOR, ROW, TEXT$)
  37. DECLARE SUB MENU (S, TITLE$, L$, TEXT$)
  38. DECLARE FUNCTION GETWORD$ (L$, N, S)
  39.  
  40. SELECTED = 3
  41. 'list$ = "United States of America|Mexico|Canada|United Kingdom|Australia|Afghanistan|Albania|Algeria|Andorra|Angola|Anguilla|Antigua and Barbuda|Argentina|Armenia|Aruba|Austria|Azerbaijan|Bahamas|Bahrain|Bangladesh|Barbados|Belarus|Belgium|Belize|Benin|Bermuda|Bhutan|Bolivia|Bonaire|Bosnia and Herzegovina|Botswana|Brazil|British Virgin Islands|Brunei|Bulgaria|Burkina Faso|Burundi|Cabo Verde|Cambodia|Cameroon|Cayman Islands|Central African Republic|Chad|Chile|China|Clipperton Island|Colombia|Comoros|Costa Rica|Cote d'Ivoire|Croatia|Cuba|Curacao|Cyprus|Czech Republic|Democratic Republic of the Congo|Denmark|Djibouti|Dominica|Dominican Republic|Ecuador|Egypt|El Salvador|Equatorial Guinea|Eritrea|Estonia|Ethiopia|Fiji|Finland|France|French Polynesia|Gabon|Gambia|Georgia|Germany|Ghana|Greece|Greenland|Grenada|Guadeloupe|Guatemala|Guinea|Guinea-Bissau|Guyana|Haiti|Honduras|Hungary|Iceland|India|Indonesia|Iran|Iraq|Ireland|Israel|Italy|Jamaica|Japan|Jordan|Kazakhstan|Kenya|Kiribati|Kosovo|Kuwait|Kyrgyzstan|Laos|Latvia|Lebanon|Lesotho|Liberia|Libya|Liechtenstein|Lithuania|Luxembourg|Macedonia (FYROM)|Madagascar|Malawi|Malaysia|Maldives|Mali|Malta|Marshall Islands|Martinique|Mauritania|Mauritius|Micronesia|Moldova|Monaco|Mongolia|Montenegro|Montserrat|Morocco|Mozambique|Myanmar (Burma)|Namibia|Nauru|Navassa Island|Nepal|Netherlands|New Zealand|Nicaragua|Niger|Nigeria|North Korea|Norway|Oman|Pakistan|Palau|Palestine|Panama|Papua New Guinea|Paraguay|Peru|Philippines|Poland|Portugal|Puerto Rico|Qatar|Republic of the Congo|Romania|Russia|Rwanda|Saba|Saint Barthelemy|Saint Kitts and Nevis|Saint Lucia|Saint Martin|Saint Pierre and Miquelon|Saint Vincent and the Grenadines|Samoa|San Marino|Sao Tome and Principe|Saudi Arabia|Senegal|Serbia|Seychelles|Sierra Leone|Singapore|Sint Eustatius|Sint Maarten|Slovakia|Slovenia|Solomon Islands|Somalia|South Africa|South Korea|South Sudan|Spain|Sri Lanka|Sudan|Suriname|Swaziland|Sweden|Switzerland|Syria|Taiwan|Tajikistan|Tanzania|Thailand|Timor-Leste|Togo|Tonga|Trinidad and Tobago|Tunisia|Turkey|Turkmenistan|Turks and Caicos Islands|Tuvalu|Uganda|Ukraine|United Arab Emirates|Uruguay|US Virgin Islands|Uzbekistan|Vanuatu|Vatican City|Venezuela|Vietnam|Yemen|Zambia|Zimbabwe"
  42. MENU SELECTED, "Files", list$, "Please select your image file from the list below:"
  43.  
  44. CENTER 15, 10, "You picked :    " + GETWORD$(list$, SELECTED, 124)
  45. fle$ = GETWORD$(list$, SELECTED, 124)
  46.  
  47. SCREEN _NEWIMAGE(640, 480, 32)
  48.  
  49. img& = _LOADIMAGE(fle$, 32) 'load the image file to be drawn
  50. wide% = _WIDTH(img&): deep% = _HEIGHT(img&)
  51. TLC$ = "BL" + STR$(wide% \ 2) + "BU" + STR$(deep% \ 2) 'start draw at top left corner
  52. RET$ = "BD BL" + STR$(wide%) 'return to left side of image
  53. _SOURCE img&
  55. SHELL "echo. > image.txt"
  56. OPEN "pset.txt" FOR OUTPUT AS #2
  58. Tmp& = _NEWIMAGE(32, 32, 256)
  60.     x = x + 1
  61.     IF x > wide% THEN
  62.         x = 0: y = y + 1
  63.     END IF
  64.     DRAW "C" + STR$(POINT(x, y)) + "R1" 'color and DRAW each pixel
  65.  
  66.     colour~& = POINT(x, y)
  67.     c% = _RGB(_RED32(colour~&), _GREEN32(colour~&), _BLUE32(colour~&), Tmp&)
  68.     clr = (c%) 'POINT(x, y) / (16553 * 256 * 16 * 8)
  69.     x$ = STR$(x)
  70.     y$ = STR$(y)
  71.     clr$ = STR$(clr)
  72.     PRINT #2, "pset(" + x$ + CHR$(44) + y$ + ")" + CHR$(44) + clr$
  73.     'LOCATE 2, 1: PRINT x, y
  74.     PSET (x, y), clr
  75.  
  76.     ' Steve Contrib:
  77.  
  78.     'SCREEN _NEWIMAGE(640, 480, 32)
  79.     'RANDOMIZE TIMER
  80.     'CLS , _RGB32(RND * 255, RND * 255, RND * 255)
  81.     'draw a few boxes
  82.     'FOR i = 1 TO 3
  83.     'LINE (RND * 640, RND * 480)-(RND * 640, RND * 480), _RGB32(RND * 255, RND * 255, RND * 255), BF
  84.     'NEXT
  85.  
  86.     'Now do a screen grab
  87.     DIM m AS _MEM
  88.     ' m = _MEMIMAGE(0) 'screen memory of image
  89.     m = _LOADIMAGE(fle$, 32)
  90.  
  91.     DIM c AS _UNSIGNED LONG 'color value of the pixels
  92.     DIM ShortByte AS _UNSIGNED _BYTE, LongData AS _UNSIGNED LONG
  93.     ShortByte = 0
  94.  
  95.     'open  a file for saving
  96.     OPEN "databas.txt" FOR OUTPUT AS #3
  97.  
  98.  
  99.     DO UNTIL finished
  100.         count = 1 'count is the count of repetitive times a color appears in a row
  101.         _MEMGET m, m.OFFSET + p * 4, c 'p is the current point
  102.         IF p >= m.SIZE THEN
  103.             finished = -1
  104.         ELSE
  105.             IF (p + count) * 4 >= m.SIZE THEN
  106.                 finished = -1
  107.             ELSE
  108.                 DO UNTIL _MEMGET(m, m.OFFSET + (p + count) * 4, _UNSIGNED LONG) <> c
  109.                     count = count + 1
  110.                     IF (p + count) * 4 >= m.SIZE THEN finished = -1: count = count - 1: EXIT DO
  111.                 LOOP
  112.             END IF
  113.         END IF
  114.         p = p + count
  115.         r = _RED32(c): g = _GREEN32(c): b = _BLUE32(c)
  116.         PRINT #3, "DATA "; r; ","; g; ","; b; ",";
  117.         IF count > 255 THEN
  118.             LongData = count
  119.             PRINT #1, ShortByte; ","; LongData
  120.         ELSE
  121.             ShortByte = count
  122.             PRINT #1, ShortByte
  123.         END IF
  124.         ShortByte = 0 'reset the default count to 0
  125.     LOOP
  126.  
  127.     'free resources
  128.     CLOSE #3
  129.     _MEMFREE m
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136. LOOP UNTIL y >= deep%
  138. PRINT "Saved as image.txt"
  139.  
  140. SUB MENU (S, TITLE$, L$, TEXT$)
  141.  
  142.     C0 = 0 ' Main window background pick:0-7
  143.     C1 = 7 ' Color 2 (FG) pick:0-7
  144.     C2 = 0 ' Color 1 (BG) pick:0-7
  145.     C3 = 15 ' Typing color pick:0-15
  146.     C4 = 12 ' Mistyped item color pick:0-15
  147.     C5 = 9 ' Title color (TITLE$) pick:0-15
  148.     C6 = 14 ' Description color (TEXT$) pick:0-15
  149.  
  150.     ORIGINAL = S
  151.     SCREEN 0
  152.     WIDTH 80, 25
  153.     COLOR C1, C0
  154.     CLS
  155.  
  156.     ' Display title.
  157.     CENTER C5, 2, TITLE$
  158.  
  159.     ' Display description text.
  160.     CENTER C6, 4, TEXT$
  161.  
  162.     REDIM C$(1 TO 250) ' <<< Array size may need to be modified.
  163.  
  164.     ' Split list into string array
  165.     P = 1
  166.     LL = 0 ' Longest line
  167.     FOR I = 1 TO UBOUND(C$)
  168.         F = P
  169.         P = INSTR(P, L$, "|")
  170.         IF P < 1 THEN P = 9999
  171.         C$(I) = MID$(L$, F, P - F)
  172.         IF LL < LEN(C$(I)) THEN LL = LEN(C$(I))
  173.         IF P = 9999 THEN EXIT FOR
  174.         P = P + 1
  175.     NEXT I
  176.  
  177.     ' S   = Selected Item
  178.     ' LL  = Longest line length
  179.     MM = I ' MM  = Number of menu items
  180.     W$ = "" ' W$  = User typed search text
  181.     N = 0 ' N   = User typed search text found?
  182.     F = 0 ' F   = Vertical Display Offset
  183.     M = 8 ' M   = Number of menu items to display on screen
  184.     TOP = 5 ' TOP = Top row where menu starts Y
  185.     ' X   = Start printing menu at pos X
  186.     X = 33 - FIX(LL / 2)
  187.  
  188.     DO
  189.         ' Print menu items
  190.         FOR I = 1 TO M
  191.             Y = I * 2 + TOP
  192.             IF S = I + F THEN
  193.                 COLOR C2, C1
  194.             ELSE
  195.                 COLOR C1, C2
  196.             END IF
  197.             T$ = C$(I + F)
  198.             LOCATE Y, X: PRINT SPACE$(5); T$; SPACE$(LL - LEN(T$) + 10);
  199.         NEXT I
  200.  
  201.         ' Put lines or spaces among menu items
  202.         FOR I = 1 TO M + 1
  203.             IF S = I + F THEN
  204.                 COLOR C1, C2
  205.             ELSEIF S = I + F - 1 THEN
  206.                 COLOR C2, C1
  207.             ELSE
  208.                 COLOR C2, C2
  209.             END IF
  210.             LOCATE I * 2 + TOP - 1, X: PRINT STRING$(LL + 15, CHR$(220));
  211.         NEXT I
  212.  
  213.         ' Print search text
  214.         IF N THEN COLOR C3, C2 ELSE COLOR C4, C2
  215.         Z$ = LEFT$(W$, 40)
  216.         LOCATE 24, 20: PRINT Z$; SPACE$(40 - LEN(Z$));
  217.         IF LEN(W$) THEN LOCATE 24, 20 + LEN(Z$), 1, 12, 13 ELSE LOCATE 1, 1, 0
  218.  
  219.         K$ = "": WHILE K$ = "": K$ = INKEY$: WEND
  220.  
  221.         LOCATE 1, 1, 0 ' Turn off cursor
  222.  
  223.         ' Process search text
  224.         N = 0
  225.         IF LEN(K$) = 1 THEN
  226.             U = ASC(UCASE$(K$))
  227.             IF LEN(W$) AND K$ = CHR$(8) THEN ' BACKSPACE
  228.                 W$ = LEFT$(W$, LEN(W$) - 1)
  229.             ELSEIF U = 32 OR U > 64 AND U < 91 OR (U > 47 AND U < 58) THEN ' TYPING
  230.                 W$ = W$ + K$
  231.             END IF
  232.             IF LEN(W$) THEN
  233.                 FOR G = 1 TO UBOUND(C$) ' FIND ITEM
  234.                     IF UCASE$(LEFT$(C$(G), LEN(W$))) = UCASE$(W$) THEN
  235.                         N = 1
  236.                         S = G
  237.                         IF S < F OR S > F + M THEN
  238.                             F = S - FIX(M / 2)
  239.                             IF F < 0 THEN F = 0
  240.                             IF F > MM - M THEN F = MM - M
  241.                         END IF
  242.                         EXIT FOR
  243.                     END IF
  244.                 NEXT G
  245.             END IF
  246.         END IF
  247.  
  248.         SELECT CASE K$
  249.             CASE CHR$(0) + "G": ' HOME
  250.                 W$ = ""
  251.                 S = 1
  252.                 F = 0
  253.             CASE CHR$(0) + "O": ' END
  254.                 W$ = ""
  255.                 S = MM
  256.                 F = MM - M
  257.                 IF F < 0 THEN F = 0
  258.             CASE CHR$(0) + "I": ' PGUP
  259.                 W$ = ""
  260.                 S = S - M
  261.                 F = F - M
  262.                 IF S < 1 THEN S = 1
  263.                 IF F < 0 THEN F = 0
  264.             CASE CHR$(0) + "Q": ' PGDN
  265.                 W$ = ""
  266.                 S = S + M
  267.                 F = F + M
  268.                 IF S > MM THEN S = MM
  269.                 IF F > MM - M THEN F = MM - M
  270.                 IF F < 0 THEN F = 0
  271.             CASE CHR$(0) + "H": ' UP ARROW
  272.                 W$ = ""
  273.                 IF S > 1 THEN
  274.                     S = S - 1
  275.                     IF S <= F THEN F = F - 1
  276.                 END IF
  277.             CASE CHR$(0) + "P": ' DOWN ARROW
  278.                 W$ = ""
  279.                 IF S < MM THEN
  280.                     S = S + 1
  281.                     IF S >= F + I - 1 THEN F = F + 1
  282.                 END IF
  283.             CASE CHR$(13): EXIT DO ' ENTER
  284.             CASE CHR$(0) + "K": EXIT DO ' LEFT ARROW
  285.             CASE CHR$(0) + "M": EXIT DO ' RIGHT ARROW
  286.             CASE CHR$(0) + "-": S = -1: EXIT DO ' ALT-X
  287.             CASE CHR$(0) + "k": S = -1: EXIT DO ' ALT-F4
  288.             CASE CHR$(27): S = -1: EXIT DO ' ESC
  289.         END SELECT
  290.     LOOP
  291.  
  292.     ERASE C$
  293.     COLOR 7, 0
  294.     CLS
  295.  
  297.  
  298. ' Prints some text in the middle of the screen.
  299. ' We're assuming 80x25 color text mode.
  300. SUB CENTER (TEXTCOLOR, ROW, TEXT$)
  301.     COLOR TEXTCOLOR
  302.     LOCATE ROW, 40 - FIX(LEN(TEXT$) / 2): PRINT TEXT$;
  304.  
  305. ' This function returns the Nth word from a list.
  306. ' Words must be separated by the separator character S.
  307. ' S must hold the ASCII value of the character to be
  308. ' used as a separator character. i.e. S=32 means space
  309. ' Example:
  310. '    GETWORD$("apples peaches kiwi grapes", 1, 32) -> "apples"
  311. '    GETWORD$("apples/peaches/kiwi/grapes", 3, 47) -> "kiwi"
  312. '    GETWORD$("apples+peaches+kiwi+grapes", 9, 43) -> "" (out of range)
  313. '
  314. FUNCTION GETWORD$ (L$, N, S)
  315.     LL = LEN(L$)
  316.     IF N < 1 OR N > LL / 2 + 2 THEN GETWORD$ = "": EXIT FUNCTION
  317.     W = 0
  318.     F = 0
  319.     FOR I = 1 TO LL + 1
  320.         IF I > LL THEN C = S ELSE C = ASC(MID$(L$, I, 1))
  321.         IF C = S THEN
  322.             IF F AND W = N THEN
  323.                 GETWORD$ = MID$(L$, F, I - F)
  324.                 EXIT FUNCTION
  325.             END IF
  326.             F = 0
  327.         ELSE
  328.             IF F = 0 THEN F = I: W = W + 1
  329.         END IF
  330.     NEXT I
  331.     GETWORD$ = ""
  333.  
  334. ' Displays a menu on the screen, and allows the user to select
  335. ' one item from the list. L$ should contain the list of menu items
  336. ' separated by the | character. S will hold the number of the
  337. ' selected menu item. If S is 5 at the beginning, this means the
  338. ' 5th item on the list is selected by default. If the user picks
  339. ' a different menu item and presses Enter, then S will change.
  340. ' If the user presses ESC, ALT+X or ALT+F4, S will be -1.
  341. '
  342.  

15
QB64 Discussion / Re: How big is yours?
« on: December 17, 2018, 02:38:59 pm »
433 lines: Benford Bench.

Touched up on it on and off for 6 years. It is a digital analysis program using Benford's Law.

https://www.qb64.org/basbin/4B4B.txt

I developed it for my groups primary use to investigate time stamps of in election log data for Chicago to demonstrate admissibility of it's method for fraud detection.

I use this program and another team member uses his program in Fox Pro to solidify results.

Trouble is finding a control pool.

Pages: [1] 2