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.


Topics - Pete

Pages: [1] 2 3 ... 9
1
QB64 Discussion / [fixed] Forum link needs updating...
« on: October 29, 2021, 08:32:42 pm »
QB64 V 2.0.1 Out Now
Click here to get it

That link goes to: V 1.4 https://github.com/QB64Team/qb64/releases/tag/v1.4

Correct link should be: https://github.com/QB64Team/qb64/releases/tag/v2.0.1

The link under the "The Team is on FIRE!" redirects properly to version 2.0.1. Could someone please put out the burning team member long enough to have the header link corrected?

Pete 😲🧯

2
QB64 Discussion / Inspired by bplus...
« on: October 25, 2021, 07:06:15 pm »
I don't often do graphics, but when I do... I really , really hate to do the grunt work. I had a lot of that with my Wheel of Fortune spoof, and then I participated in the thread where bplus was discussing a _FONT incompatibility issue in past QB64 versions. I've seen enough of Mark's apps to know he makes use of algorithms, often, to do the grunt work. Anyway, versions aside, I decided if I want to do any more graphics applications, I want to start with some algorithms like the one I wrote for this demo. It automatically determines where to draw boxes around letters, rather than trying to estimate or map them out.

Requires version 1.5 or above.

Code: QB64: [Select]
  1. DIM SHARED overlay
  3.  
  4. Screen0 = _NEWIMAGE(80, 25, 0)
  5. SCREEN Screen0
  6.  
  7. font = _LOADFONT("lucon.ttf", 60, "monospace")
  8. IF font <= 0 THEN font = 16
  9.  
  11. _DEST overlay
  12. _FONT font
  13. COLOR _RGB(255, 102, 0), 0
  14.  
  15. row = 2: col = 2: r1% = 255: r2% = 0: r3% = 0
  16. COLOR _RGB(255, 255, 255)
  17. text$ = "I'd like to solve the puzzle, please!"
  18. y = row: x = col
  19. FOR i = 1 TO LEN(text$)
  20.     IF (x + LEN(MID$(text$, i, INSTR(i, text$, " ") - i))) * _FONTWIDTH > _WIDTH THEN BEEP: x = 2: y = y + 2
  21.     t$ = MID$(text$, i, 1)
  22.     PSL y, x, t$, r1%, r2%, r3%
  23.     x = x + 1
  26.  
  29. _FREEIMAGE overlay
  30.  
  32. _DELAY .66
  33.  
  35.  
  36. SUB PSL (y, x, t$, r1%, r2%, r3%)
  37.     IF t$ <> CHR$(32) THEN CALL box(y, x, r1%, r2%, r3%)
  38.     _PRINTSTRING ((x - 1) * _FONTWIDTH, (y - 1) * _FONTHEIGHT), t$
  39.     overlay_hardware = _COPYIMAGE(overlay, 33)
  40.     _PUTIMAGE (0, 0), overlay_hardware
  41.     _DISPLAY
  43.  
  44. SUB box (y, x, r1%, r2%, r3%)
  45.     LINE ((x - 1) * _FONTWIDTH, ((y - 1) * _FONTHEIGHT))-((x - 1) * _FONTWIDTH + _FONTWIDTH, ((y - 1) * _FONTHEIGHT) + _FONTHEIGHT), _RGB(r1%, r2%, r3%), B , 255
  46.     overlay_hardware = _COPYIMAGE(overlay, 33)
  47.     _PUTIMAGE (0, 0), overlay_hardware
  48.     _DISPLAY

Pete

3
QB64 Discussion / Let's PLAY(0) Wheel of Fortune...
« on: October 21, 2021, 10:24:13 pm »

Code: QB64: [Select]
  1. DIM SHARED overlay
  3.  
  4. Screen0 = _NEWIMAGE(80, 25, 0)
  5. SCREEN Screen0
  6.  
  7. COLOR 8, 0
  8. FOR i = 1 TO 25
  9.     LOCATE i, 1: PRINT STRING$(80, 176);
  11.  
  12. font = _LOADFONT("lucon.ttf", 60, "monospace")
  13. IF font <= 0 THEN font = 16
  14.  
  16. _DEST overlay
  17. _FONT font
  18. COLOR _RGB(255, 102, 0), 0
  19.  
  20. b = 73
  21.  
  22. FOR i = 0 TO 7
  23.     IF i <> 4 THEN LINE (25 + i * b + 18, 55)-(76 + i * b + 18, 125 - 10), _RGB(255, 255, 255), B , 255
  25.  
  26. FOR i = 1 TO 5
  27.     LINE (25 + i * b + 54, 175)-(76 + i * b + 54, 245 - 10), _RGB(255, 255, 255), B , 255
  29.  
  30. Overlay_Hardware = _COPYIMAGE(overlay, 33)
  31. _PUTIMAGE (0, 0), Overlay_Hardware
  33.  
  35.  
  36. FOR i = 1 TO 8
  37.     READ z$, q, w
  38.     t$(i) = z$: q(i) = q: w(i) = w
  40.  
  41. FOR i = 1 TO 8
  42.     FOR j = 1 TO 8
  43.         IF i <> j THEN
  44.             IF q(i) < q(j) THEN SWAP t$(i), t$(j): SWAP q(i), q(j): SWAP w(i), w(j)
  45.         END IF
  46.     NEXT
  48.  
  49. FOR h = 1 TO 8
  50.     IF w(h) < 10 THEN
  51.         t$ = t$(h)
  52.         x = 2.5 + (w(h) - 1) * 2: y = 2
  53.         PSL y, x, t$
  54.     ELSE
  55.         t$ = t$(h)
  56.         x = 3.5 + (w(h) - 9) * 2: y = 4
  57.         PSL y, x, t$
  58.     END IF
  59.     IF h <> 2 THEN _DELAY 3
  61.  
  63. y = 20: x = 23
  64. COLOR _RGB(255, 255, 255)
  65. t$ = "I'd like to solve the puzzle, please!"
  66. PSL y, x, t$
  68.  
  70.  
  72.  
  73. _DEST overlay
  75.  
  76. COLOR _RGB(255, 102, 0), 0
  77.  
  78. x = 0: y = 0: t$ = ""
  79. font = _LOADFONT("lucon.ttf", 60, "monospace")
  80. IF font <= 0 THEN font = 16
  81. _FONT font
  82.  
  83. a$ = CHR$(76) + CHR$(101) + CHR$(116) + "'" + CHR$(115) + CHR$(32) + CHR$(71) + CHR$(111) + CHR$(32) + CHR$(66) + CHR$(114) + CHR$(97) + CHR$(110) + CHR$(100) + CHR$(111) + CHR$(110) + "!"
  84. m$ = "MBn29L3n24L3n33L3n29L4"
  85.  
  87.     IF seed% = 0 THEN PLAY m$
  88.     y = 150: x = 8 + x + LEN(t$) * 36
  89.     t$ = MID$(a$ + " ", seed%, INSTR(seed%, a$ + " ", " ") - seed% + 1)
  90.     _PRINTSTRING (x, y), RTRIM$(t$)
  91.     Overlay_Hardware = _COPYIMAGE(overlay, 33)
  92.     _PUTIMAGE (0, 0), Overlay_Hardware
  93.     _DISPLAY
  94.     IF seed% < LEN(a$) THEN
  95.         seed% = INSTR(seed%, a$ + " ", " ") + 1
  96.         _DELAY .66
  97.     ELSE
  98.         _DELAY .66: CLS: _DISPLAY: seed% = 0: x = 0: _DELAY 1.33
  99.     END IF
  103. _FREEIMAGE overlay
  104.  
  106. _DELAY .66
  107.  
  109.  
  110. DATA C,8,3
  111. DATA K,4,4
  112. DATA B,7,10
  113. DATA J,5,6
  114. DATA F,1,1
  115. DATA E,2,8
  116. DATA N,6,14
  117. DATA E,3,13
  118.  
  119. SUB PSL (y, x, t$)
  120.     _PRINTSTRING ((x - 1) * _FONTWIDTH, (y - 1) * _FONTHEIGHT), t$
  121.     overlay_hardware = _COPYIMAGE(overlay, 33)
  122.     _PUTIMAGE (0, 0), overlay_hardware
  123.     _DISPLAY

Well, on a serious "note," It's a shame QB64 was not able to get the PLAY(0) function implemented. PLAY(0) was a QB / QuickBASIC function that tracked the number notes (up to 36) in the buffer if the MB handle was used to tell PLAY to play the notes in the background. You could use it to figure out where you were in a music loop, or when the last note ended. Very useful.

So my question is probably to @SpriggsySpriggs

Is there a Windows API method to track the sound buffer, or at least to tell us when sound playing sound / music in the background has completed? 

Pete

4
QB64 Discussion / Really? Does _PRINTSTRING have lag issues? [SOLVED]
« on: October 19, 2021, 02:16:41 pm »
This is just for testing. I'm using _PRINTSTRING to write to a hardware overlay. Now in SCREEN 0, this type of letter printing works properly, but _PRINTSTRING seems to have lag, which throws off the timer.

If you try the code, you will need to hold down alt, and it will start printing the alphabet. The problem... what comes after J? O_ay, I'm just _idding. The problem is this: It should print each character with a .4 sec delay between characters. On my machine, it seems to lag around "M" "N" or "P" and then some buffer effect causes it to print two letters together. Now if you use this to print one letter over the other, instead of in a line, that makes it appear like it misses a letter. In other words A-M appears one letter at a time, but N and O get buffered together, so the user sees O as the next letter, instead of N. This is why, for this example, I put the display in a line, so you could see the lag/buffering issue more clearly. Do a REPLACE: [nxt + i] to: [nxt] if you want to see the letters print over themselves.

So, is there a way around this lag issue? 

Code: QB64: [Select]
  2. Screen0 = _NEWIMAGE(80, 25, 0)
  3. SCREEN Screen0
  4. swidth = _WIDTH
  5.  
  6. DIM SHARED Overlay
  7.  
  9. DIM SHARED lmargin%, rmargin%, topmargin%, screenwidth%, level, ibk, ileadingrow
  10. DIM SHARED irow, icol, inextrnd, imaxalienmissiles, alienforce%, ileadingmax, imaxalienforce, ihits, score$
  11.  
  13.  
  15.  
  16. _DEST Overlay
  17.  
  18. font = _LOADFONT("lucon.ttf", 20, "monospace")
  19. IF font <= 0 THEN font = 16
  20. _FONT font
  21.  
  22. bxy% = 3.5
  23. bxx% = 13 '27
  24. COLOR DarkOrange, 0
  25. t$ = " " + CHR$(218) + STRING$(27, CHR$(196)) + CHR$(191) + " "
  26. PSL bxy%, bxx% - 1, t$
  27. FOR i = 1 TO 11
  28.     t$ = " " + CHR$(179) + STRING$(27, CHR$(32)) + CHR$(179) + " "
  29.     PSL bxy% + i, bxx% - 1, t$
  31. t$ = " " + CHR$(192) + STRING$(27, CHR$(196)) + CHR$(217) + " "
  32. PSL bxy% + i, bxx% - 1, t$
  33.  
  34. COLOR Black, DarkOrange
  35. t$ = "    NAME   SCORE    DATE   "
  36. PSL bxy% + 1, bxx% + 1, t$
  37.  
  38. COLOR DarkOrange, 0
  39. FOR i = 1 TO 5
  40.     t$ = hsdata$(i)
  41.     PSL bxy% + 1 + i * 2, bxx% + 1, t$
  43.  
  44.  
  45. DEF SEG = 0
  46. initials$ = "": delay = .4
  47. i = 0
  48. bar$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + CHR$(27) + CHR$(27) + CHR$(27)
  49. lscr = 14
  51.     IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
  52.         DO
  53.             i = i + 1
  54.             COLOR , Black: t$ = " "
  55.             PSL 6 + rank * 2, lscr + nxt, t$
  56.             IF MID$(bar$, i, 1) = CHR$(27) AND LEN(initials$) = 0 THEN i = 1 ' No go back symbol shown on first initial.
  57.             IF i > LEN(bar$) THEN i = 1
  58.             COLOR DarkOrange: t$ = MID$(bar$, i, 1)
  59.             PSL 6 + rank * 2, lscr + nxt + i, t$
  60.             z1 = TIMER
  61.             IF LEN(initials$) = 3 THEN
  62.                 bar$ = CHR$(27) + CHR$(26) + CHR$(26) + CHR$(26) + CHR$(27)
  63.             END IF
  64.             DO UNTIL ABS(TIMER - z1) > delay
  65.                 IF PEEK(1047) MOD 16 <> 7 AND PEEK(1047) MOD 16 <> 8 THEN
  66.                     IF MID$(bar$, i, 1) = CHR$(26) THEN
  67.                         ''''''''PRINT " ";
  68.                         COLOR , Black: t$ = " "
  69.                         PSL 6 + rank * 2, lscr + nxt, t$
  70.                         COLOR DarkOrange
  71.                         flag = -999
  72.                         EXIT DO
  73.                     END IF
  74.                     IF MID$(bar$, i, 1) = CHR$(27) THEN
  75.                         IF LEN(initials$) THEN
  76.                             i = ASC(RIGHT$(initials$, 1)) - 66: IF i < 0 THEN i = 0
  77.                             initials$ = MID$(initials$, 1, LEN(initials$) - 1)
  78.                             COLOR , Black: t$ = " "
  79.                             PSL 6 + rank * 2, lscr + nxt, t$
  80.                             COLOR DarkOrange
  81.                             nxt = nxt - 1
  82.  
  83.                             flag = -2
  84.                         END IF
  85.                     ELSE
  86.                         initials$ = initials$ + MID$(bar$, i, 1)
  87.                         bar$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + CHR$(27) + CHR$(27) + CHR$(27)
  88.                         i = 26
  89.                         flag = -1
  90.                     END IF
  91.                     EXIT DO
  92.                 END IF
  93.             LOOP
  94.             IF flag THEN EXIT DO
  95.         LOOP
  96.         IF flag = -999 THEN flag = 0: EXIT DO
  97.         IF flag <> -2 THEN
  98.             IF MID$(bar$, i, 1) <> CHR$(27) THEN nxt = nxt + 1 ELSE i = 0
  99.         END IF
  100.     ELSE
  101.         _DELAY .5
  102.     END IF
  103.     flag = 0
  106.  
  107. SUB PSL (y, x, t$)
  108.     _PRINTSTRING ((x - 1) * _FONTWIDTH, (y - 1) * _FONTHEIGHT), t$
  109.     Overlay_Hardware = _COPYIMAGE(Overlay, 33)
  110.  
  111.     _PUTIMAGE (0, 0), Overlay_Hardware
  112.     _DISPLAY
  113.  
  115.  

Pete

EDIT SOLVED!

Code: QB64: [Select]
  2. Screen0 = _NEWIMAGE(80, 25, 0)
  3. SCREEN Screen0
  4. swidth = _WIDTH
  5.  
  6. DIM SHARED Overlay
  7.  
  9. DIM SHARED lmargin%, rmargin%, topmargin%, screenwidth%, level, ibk, ileadingrow
  10. DIM SHARED irow, icol, inextrnd, imaxalienmissiles, alienforce%, ileadingmax, imaxalienforce, ihits, score$
  11.  
  13.  
  15.  
  16. _DEST Overlay
  17.  
  18. font = _LOADFONT("lucon.ttf", 20, "monospace")
  19. IF font <= 0 THEN font = 16
  20. _FONT font
  21.  
  22. bxy% = 3.5
  23. bxx% = 13 '27
  24. COLOR DarkOrange, 0
  25. t$ = " " + CHR$(218) + STRING$(27, CHR$(196)) + CHR$(191) + " "
  26. PSL bxy%, bxx% - 1, t$
  27. FOR i = 1 TO 11
  28.     t$ = " " + CHR$(179) + STRING$(27, CHR$(32)) + CHR$(179) + " "
  29.     PSL bxy% + i, bxx% - 1, t$
  31. t$ = " " + CHR$(192) + STRING$(27, CHR$(196)) + CHR$(217) + " "
  32. PSL bxy% + i, bxx% - 1, t$
  33.  
  34. COLOR Black, DarkOrange
  35. t$ = "    NAME   SCORE    DATE   "
  36. PSL bxy% + 1, bxx% + 1, t$
  37.  
  38. COLOR DarkOrange, 0
  39. FOR i = 1 TO 5
  40.     t$ = hsdata$(i)
  41.     PSL bxy% + 1 + i * 2, bxx% + 1, t$
  43.  
  44.  
  45. DEF SEG = 0
  46. initials$ = "": delay = .4
  47. i = 0
  48. bar$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + CHR$(27) + CHR$(27) + CHR$(27)
  49. lscr = 14
  51.     IF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
  52.         DO
  53.             i = i + 1
  54.             COLOR , Black: t$ = " "
  55.             PSL 6 + rank * 2, lscr + nxt, t$
  56.             IF MID$(bar$, i, 1) = CHR$(27) AND LEN(initials$) = 0 THEN i = 1 ' No go back symbol shown on first initial.
  57.             IF i > LEN(bar$) THEN i = 1
  58.             COLOR DarkOrange: t$ = MID$(bar$, i, 1)
  59.             PSL 6 + rank * 2, lscr + nxt + i, t$
  60.             z1 = TIMER
  61.             IF LEN(initials$) = 3 THEN
  62.                 bar$ = CHR$(27) + CHR$(26) + CHR$(26) + CHR$(26) + CHR$(27)
  63.             END IF
  64.             _DISPLAY ' <-------------------------Moved it here from the sub.
  65.             DO UNTIL ABS(TIMER - z1) > delay
  66.                 IF PEEK(1047) MOD 16 <> 7 AND PEEK(1047) MOD 16 <> 8 THEN
  67.                     IF MID$(bar$, i, 1) = CHR$(26) THEN
  68.                         ''''''''PRINT " ";
  69.                         COLOR , Black: t$ = " "
  70.                         PSL 6 + rank * 2, lscr + nxt, t$
  71.                         COLOR DarkOrange
  72.                         flag = -999
  73.                         EXIT DO
  74.                     END IF
  75.                     IF MID$(bar$, i, 1) = CHR$(27) THEN
  76.                         IF LEN(initials$) THEN
  77.                             i = ASC(RIGHT$(initials$, 1)) - 66: IF i < 0 THEN i = 0
  78.                             initials$ = MID$(initials$, 1, LEN(initials$) - 1)
  79.                             COLOR , Black: t$ = " "
  80.                             PSL 6 + rank * 2, lscr + nxt, t$
  81.                             COLOR DarkOrange
  82.                             nxt = nxt - 1
  83.  
  84.                             flag = -2
  85.                         END IF
  86.                     ELSE
  87.                         initials$ = initials$ + MID$(bar$, i, 1)
  88.                         bar$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + CHR$(27) + CHR$(27) + CHR$(27)
  89.                         i = 26
  90.                         flag = -1
  91.                     END IF
  92.                     EXIT DO
  93.                 END IF
  94.             LOOP
  95.             IF flag THEN EXIT DO
  96.         LOOP
  97.  
  98.         IF flag = -999 THEN flag = 0: EXIT DO
  99.         IF flag <> -2 THEN
  100.             IF MID$(bar$, i, 1) <> CHR$(27) THEN nxt = nxt + 1 ELSE i = 0
  101.         END IF
  102.     ELSE
  103.         _DELAY .5
  104.     END IF
  105.     flag = 0
  108.  
  109. SUB PSL (y, x, t$)
  110.     _PRINTSTRING ((x - 1) * _FONTWIDTH, (y - 1) * _FONTHEIGHT), t$
  111.     Overlay_Hardware = _COPYIMAGE(Overlay, 33)
  112.  
  113.     _PUTIMAGE (0, 0), Overlay_Hardware
  114.  
  115.     ' --------------> Moved this out of sub and into main: _DISPLAY
  117.  

I had to move the _DISPLAY out of the sub, for some reason I still haven't figured out. I just took a shot at it. Bullet casings everywhere!

Edit: Well moving did cut the number of _DISPLAY calls in half, if that was the issue. Now it prints the blank space and then the next letter before it cycles to _DISPLAY again. Before, it printed the blank character, displayed it, and then the next character, and displayed it. Weird. Graphics stuff is just weird. SCREEN 0 up Mr. Sulu, and phasers on _FULLSCREEN.

Pete out

5
QB64 Discussion / If I posted it once, I posted it a thousand times...
« on: October 18, 2021, 01:05:39 pm »
Ad - Tired of seeing yet another thread about string math? Tired of waking up in the morning and saying, "Where in the hell is the the last thread this discussion was posted in? Well, now you don't have to worry ever again thanks to the newest forum feature, Post Away! Post Away is a quantum age bot that automatically dissolves even the toughest most persistent duplicate posts; leaving us with a clean single-subject thread, with no clutter, or off-topic interference. So pick up a zip file of Post-Away today, and you'll be on your way to cleaner, brighter forum threads in no time!

Man, I knew Fell was looking for ways to raise cash, but since when did he start allowing ads on the forum? Anyway, kidding aside, here's how we handled this on the QBasic Forum...

1) Created a F.A.Q. sub-forum: This sub-forum could include a question followed by copies of various coding solutions posted from various threads. I would not recommend using links because posts could be modified by authors and it's just about as fast to cut and paste the code, and it's easier for the user to have it all presented on the same page, anyway. [I would say our LEARNING sub-forum is similar.]

2) Created a Programs I am Proud of sub-forum. This forum gave privileges to forum regulars to showcase their finest work by both author and subject. Now Fell and the Librarians (sounds like a rock group I'd listen too) have already created the SAMPLES sub-forum, and it's really good.  I especially like how it links to the discussions that were involved in the development of the project, thereby preserving the history, but the addition of a "Proud of" sub-forum would give active members a place to showcase their finest works, and a sub-forum visitors could pointed to for working solutions and code snippets and samples. [I would say our SAMPLES sub-forum is similar.]

The one thing I would not recommend would be what I call "Mac's Dream." Mac hated clutter, but he was wise enough to realize the organic nature of members and if he had run the forum that way, he would have also ran off the talent providing most of the content. In other words when admins or owners make it to uptight of a place to post, members leave. So it's really always a balancing act. I mean you go too far in the other direction,  you get so much irrelevance in a post that newcomers don't see a point in staying.

Anyway, since a Librarian mentioned this topic in an unrelated thread, which would have him banned for life on that nightmare of a "Dream Forum" I mentioned, I'd thought I open it up for a discussion here.  Sorry Google! Oh, and in regard to search engines, using <strong> tags and h1, h2 headings is probably enough to help bump up the search results on a more organized sub-forum board, which would take the pressure off to move or delete repeated posts through out the other sub-forums.

Pete 

This message was brought to you by Post Away. Now available in MicroSoft stores, everywhere.


6
QB64 Discussion / Anyone else having trouble with V2.0 not keeping IDE color changes?
« on: October 17, 2021, 08:44:49 pm »
I've never had this happen before. I've had to set the IDE colors every time I open a new instance of the V2.0 IDE. For whatever reason, I can't get the changes I make and save to load on the next instance. The changes do take effect while the IDE is open, but get this...

I open an IDE instance called untitled(4) and it is in the default color scheme. I change the color scheme and save it. Now I cut the text and close the IDE. Now I open the IDE and it opens AS CHANGED, so far, so good, and I paste the text back in. Oh, but now I click my desktop shortcut, to open untitled(5) and guess what? It opens up back in that default dark blue background with all the other default options, ignoring all the changes I previously made. Nothing I saved is being applied. Am I somehow missing a new hoop I need to jump through to make these changes on every IDE instance? If so, I can't find it.

Pete

7
QB64 Discussion / Is this at all possible in SCREEN 0?
« on: October 15, 2021, 10:49:43 pm »
Is there anyway in SCREEN 0 to make a screen overlay, and I'll attempt to explain.

A program has a window with a black background and multi-colored ascii images on it. Next step, make the characters on the screen grey, that's the easy part.... Next somehow make this grey on black screen a background image. Final step, write on top of that scree with translucent lettering, so the background bleeds through. This is easy to accomplish in HTML. Any chance it can be done in QB64?

Note: This is different than using two screens to make a popup window, although if that popup window could have a translucent background, I don't know, maybe that would work. But as a solid background, it's just a popup window that obliterates everything behind it. That I could do, but I'd rather have the overlay effect, if possible.

Pete

8
QB64 Discussion / Welcome DeltaOscarSierra
« on: October 08, 2021, 12:03:50 pm »
I had to post a welcome, because I love the handle... DOS.

Pete

9
QB64 Discussion / I discovered this difference between QB and QB64... [My mistake. No Difference.]
« on: October 07, 2021, 05:39:26 pm »
QB64 allows this to run...

Code: QB64: [Select]
  1. DIM a$(100)
  2. a$(11) = "x"
  3. PRINT a$(11)
  5. PRINT a$(11)

QB does not, throwing a subscript out of range error at line 5.

Note that both QB64 and QB throw that error if REDIM is used instead of DIM...

Code: QB64: [Select]
  1. ]REDIM a$(100)
  2. a$(11) = "x"
  3. PRINT a$(11)
  5. PRINT a$(11)

Pete

Edit: It turned out I made some sort of error. I retyped the code in QuickBASIC, and the DIM example worked the same as QB64.

10
QB64 Discussion / Mighty Menu?
« on: October 06, 2021, 06:22:00 pm »
I bet Steve is getting mighty tired of these menu titles, but since we are on the subject of menus...

Code: QB64: [Select]
  1. REM mydemo% = -1
  2. DIM UI AS UserInput
  3. REDIM Menu$(100)
  4.  
  5. TYPE UserInput
  6.     KeyPress AS STRING
  7.     KeyCombos AS INTEGER
  8.     MbStatus AS INTEGER
  9.     MbEnvoked AS INTEGER
  10.     drag AS INTEGER
  11.     DoubleClick AS INTEGER
  12.     MbLeftx AS INTEGER
  13.     MbLefty AS INTEGER
  14.     mx AS INTEGER
  15.     oldmx AS INTEGER
  16.     my AS INTEGER
  17.     oldmy AS INTEGER
  19.  
  20. IF demo% THEN PRINT "Press keys or use mouse for demo.";
  22.     MenuSetup = MenuSetup + 1: GOSUB MenuSetup
  23.     DO
  24.         CALL keyboard_mouse(UI, mydemo%)
  25.         IF UI.MbStatus < 0 AND UI.MbEnvoked = 0 THEN
  26.             SOUND 1000, .1
  27.             UI.MbEnvoked = -1
  28.         END IF
  29.  
  30.         SELECT CASE UI.MbStatus
  31.             CASE -1
  32.                 GOSUB FindMenu
  33.  
  34.                 SELECT CASE x$
  35.                     CASE Menu$(1)
  36.                         LOCATE 1, 1: PRINT Menu$(1); "                  ";
  37.                         _DELAY 2
  38.                         EXIT DO
  39.                     CASE Menu$(2)
  40.                         LOCATE 1, 1: PRINT Menu$(2); "                  ";
  41.                     CASE Menu$(3)
  42.                         LOCATE 1, 1: PRINT Menu$(3); "                  ";
  43.                     CASE Menu$(4)
  44.                         LOCATE 1, 1: PRINT Menu$(4); "                  ";
  45.                     CASE Menu$(5)
  46.                         END
  47.                 END SELECT
  48.  
  49.         END SELECT
  50.     LOOP
  51. LOOP UNTIL MenuSetup = 2
  53.  
  54. MenuSetup:
  55. SELECT CASE MenuSetup
  56.     CASE 1
  57.         MenuType% = 1
  58.         DrawBox% = -1
  59.         MenuX = 0 ' Auto-Center
  60.         MenuY = 0 ' Auto-Center
  61.         Menu$(1) = "[Enter] Next Menu"
  62.         Menu$(2) = "[F1] Help"
  63.         Menu$(3) = "[F5] Save"
  64.         Menu$(4) = "[F12] Run Demo"
  65.         Menu$(5) = "[Esc] End"
  66.         Menu$(6) = ""
  67.         Menu$(7) = ""
  68.         Menu$(8) = ""
  69.         Menu$(9) = ""
  70.         Menu$(10) = ""
  71.     CASE 2
  72.         MenuType% = 2
  73.         DrawBox% = 0
  74.         MenuX = 0 ' Auto-Center
  75.         MenuY = 0 ' Auto-Center
  76.         Menu$(1) = "[Enter] Next Menu"
  77.         Menu$(2) = "[F1] Help"
  78.         Menu$(3) = "[F5] Save"
  79.         Menu$(4) = "[F12] Run Demo"
  80.         Menu$(5) = "[Esc] End"
  81.         Menu$(6) = ""
  82.         Menu$(7) = ""
  83.         Menu$(8) = ""
  84.         Menu$(9) = ""
  85.         Menu$(10) = ""
  87.  
  88. FOR noe = UBOUND(Menu$) TO 1 STEP -1
  89.     IF LEN(Menu$(noe)) THEN EXIT FOR
  91.  
  92. SELECT CASE MenuType%
  93.     CASE 1
  94.         x = 0
  95.         FOR i = 1 TO noe
  96.             IF LEN(Menu$(i)) > x THEN x = LEN(Menu$(i))
  97.         NEXT
  98.  
  99.         IF MenuX = 0 THEN MenuX = INT(_WIDTH / 2 + 1 - (x / 2))
  100.         IF MenuY = 0 THEN MenuY = INT(_HEIGHT / 2 - (noe / 2) - 1)
  101.  
  102.         IF DrawBox% THEN GOSUB DrawBox
  103.  
  104.         FOR i = 1 TO noe
  105.             LOCATE MenuY + i - 1, MenuX
  106.             PRINT Menu$(i);
  107.         NEXT
  108.     CASE 2
  109.         Menu$ = "": x$ = "": k = 0
  110.         FOR i = 1 TO noe
  111.             IF LEN(Menu$(i)) THEN
  112.                 k = k + 1: Menu$ = Menu$ + CHR$(255) + Menu$(i)
  113.             END IF
  114.         NEXT
  115.         j = (_WIDTH - LEN(Menu$)) \ k
  116.         IF j > 5 THEN j = 5
  117.         Menu$ = MID$(Menu$, 2) + CHR$(255)
  118.         DO UNTIL INSTR(Menu$, CHR$(255)) = 0
  119.             a$ = CHR$(255) + MID$(Menu$, 1, INSTR(Menu$, CHR$(255)) - 1) 'SPACE$(j)
  120.             Menu$ = MID$(Menu$, INSTR(Menu$, CHR$(255)) + 1)
  121.             x$ = x$ + a$ + SPACE$(j)
  122.         LOOP
  123.         Menu$ = _TRIM$(x$)
  124.         CLS
  125.         LOCATE _HEIGHT, _WIDTH \ 2 - LEN(Menu$) \ 2
  126.         PRINT Menu$;
  129.  
  130. DrawBox:
  131. LOCATE MenuY - 1, MenuX - 2
  132. PRINT CHR$(218) + STRING$(x + 2, 196) + CHR$(191)
  133. FOR i = 1 TO noe
  134.     LOCATE , MenuX - 2
  135.     PRINT CHR$(179);: LOCATE , POS(0) + x + 2: PRINT CHR$(179)
  137. LOCATE , MenuX - 2
  138. PRINT CHR$(192) + STRING$(x + 2, 196) + CHR$(217);
  140.  
  141. FindMenu:
  142. SELECT CASE MenuType%
  143.     CASE 0
  144.         CLS: PRINT "You did not assign a value to the variable: MenuType": END '''
  145.     CASE 1 ' Vertical
  146.         IF UI.my >= MenuY AND UI.my <= MenuY + noe - 1 THEN
  147.             x$ = ""
  148.             FOR i = MenuX TO MenuX + x
  149.                 a$ = CHR$(SCREEN(UI.my, i))
  150.                 x$ = x$ + a$
  151.                 IF flag = 0 THEN IF a$ <> " " THEN flag = i
  152.             NEXT
  153.             x$ = _TRIM$(x$)
  154.             IF UI.mx >= flag AND UI.mx <= flag + LEN(x$) THEN
  155.                 IF VAL(x$) THEN x$ = LTRIM$(STR$(VAL(x$)))
  156.             END IF
  157.             flag = 0
  158.         END IF
  159.     CASE 2 ' Horizontal
  160.         x$ = ""
  161.         FOR i = 1 TO _WIDTH
  162.             a$ = CHR$(SCREEN(UI.my, i))
  163.             x$ = x$ + a$
  164.         NEXT
  165.         x$ = CHR$(255) + x$ + CHR$(255)
  166.         x$ = _TRIM$(MID$(x$, 1, INSTR(UI.mx + 1, x$, CHR$(255)) - 1))
  167.         IF LEN(x$) <= UI.mx THEN
  168.             x$ = "" ' Mouse is not on a menu item.
  169.         ELSE
  170.             x$ = _TRIM$(MID$(x$, _INSTRREV(x$, CHR$(255)) + 1))
  171.         END IF
  172.     CASE ELSE
  173.         CLS: PRINT "You assigned a value to MenuType that was out-of-range.": END '''
  176.  
  177. SUB keyboard_mouse (UI AS UserInput, mydemo%)
  178.     STATIC z1, lclick
  179.  
  180.     _LIMIT 30
  181.  
  182.     DEF SEG = 0
  183.     IF PEEK(1047) MOD 16 = 1 OR PEEK(1047) MOD 16 = 2 THEN
  184.         UI.KeyCombos = 1 ' Shift  % = -1 ELSE shift% = 0
  185.     ELSEIF PEEK(1047) MOD 16 = 3 OR PEEK(1047) MOD 16 = 4 THEN
  186.         UI.KeyCombos = 2 ' Ctrl  % = -1 ELSE ctrl% = 0
  187.     ELSEIF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
  188.         UI.KeyCombos = 3 ' Alt  % = -1
  189.     ELSEIF PEEK(1047) MOD 16 = 5 OR PEEK(1047) MOD 16 = 6 THEN
  190.         UI.KeyCombos = 4 ' Ctrl+Shift  % = -1 ELSE ctrlshift% = 0
  191.     ELSE
  192.         UI.KeyCombos = 0
  193.     END IF
  194.     DEF SEG
  195.  
  196.     IF mydemo% THEN GOSUB check_UI.KeyCombos
  197.  
  198.     UI.KeyPress = INKEY$
  199.     IF LEN(UI.KeyPress) THEN ' A key was pressed.
  200.         UI.MbEnvoked = 0: UI.MbLeftx = 0
  201.         SELECT CASE LEN(UI.KeyPress)
  202.             CASE 1 ' 1-byte key A-Z, etc.
  203.                 IF mydemo% THEN mydemo% = 1: GOSUB mydemo
  204.                 SELECT CASE UI.KeyPress
  205.                     ' Place key selection routine here...
  206.                     CASE CHR$(27): SYSTEM
  207.                 END SELECT
  208.             CASE 2 '2-byte key F1-F12, etc.
  209.                 IF mydemo% THEN mydemo% = 2: GOSUB mydemo
  210.                 SELECT CASE RIGHT$(UI.KeyPress, 1)
  211.                     ' Place key selection routine here...
  212.                 END SELECT
  213.         END SELECT
  214.     ELSE ' Check for mouse input since no keyboard input was detected.
  215.  
  216.         IF lclick THEN ' Check timer for double-clicks.
  217.             IF TIMER < z1 THEN z1 = z1 - 86400 ' Midnight adjustment.
  218.             IF TIMER - z1 > .33 THEN lclick = 0 ' Too much time ellapsed for a double click.
  219.         END IF
  220.  
  221.         WHILE _MOUSEINPUT
  222.             mw = mw + _MOUSEWHEEL ' Check for mouse wheel use.
  223.         WEND
  224.  
  225.         ' Get mouse status.
  226.         UI.mx = _MOUSEX
  227.         UI.my = _MOUSEY
  228.         lb = _MOUSEBUTTON(1)
  229.         rb = _MOUSEBUTTON(2)
  230.         mb = _MOUSEBUTTON(3)
  231.  
  232.         SELECT CASE UI.MbEnvoked
  233.             CASE 0
  234.                 IF lb OR rb OR mb THEN
  235.  
  236.                 END IF
  237.             CASE 1
  238.                 IF lb OR rb OR mb THEN UI.MbEnvoked = 0
  239.             CASE -1
  240.                 IF lb = 0 AND rb = 0 AND mb = 0 THEN UI.MbEnvoked = 0
  241.         END SELECT
  242.  
  243.         IF UI.MbStatus < 0 THEN ' Mouse button pressed. UI.MbStatus identity is by number. -1=left, -2=right, -3=middle.
  244.             SELECT CASE UI.MbStatus
  245.                 CASE -1 ' Left button was pressed.
  246.                     IF lb = 0 THEN ' Left button released.
  247.                         SELECT CASE lclick ' Single or double click analysis.
  248.                             CASE 0
  249.                                 IF mydemo% THEN mydemo% = 3: GOSUB mydemo
  250.                                 lclick = lclick + 1
  251.                             CASE ELSE ' Double click. Completed upon 2nd left button release.
  252.                                 IF mydemo% THEN mydemo% = 11: GOSUB mydemo
  253.                                 UI.DoubleClick = -1
  254.                                 lclick = 0
  255.                         END SELECT
  256.                         UI.MbStatus = 1
  257.  
  258.                         IF UI.MbLeftx THEN
  259.                             IF UI.mx <> UI.MbLeftx OR UI.my <> UI.MbLefty THEN UI.MbStatus = 0: lclick = 0
  260.                             UI.MbLeftx = 0: UI.MbLefty = 0
  261.                         END IF
  262.  
  263.                         IF UI.drag THEN UI.drag = 0
  264.                     ELSE ' Left button is being held down. Check for UI.drag.
  265.                         IF UI.mx <> UI.oldmx OR UI.my <> UI.oldmy THEN ' Mouse cursor has moved. UI.drag.
  266.                             IF mydemo% THEN mydemo% = 12: GOSUB mydemo
  267.                             UI.drag = -1
  268.                         END IF
  269.                     END IF
  270.                 CASE -2 ' Right button was pressed.
  271.                     IF rb = 0 THEN ' Right button was relased.
  272.                         IF mydemo% THEN mydemo% = 4: GOSUB mydemo
  273.                         UI.MbStatus = 2
  274.                     END IF
  275.                 CASE -3 ' Middle button was pressed
  276.                     IF mb = 0 THEN ' Middle button was released.
  277.                         IF mydemo% THEN mydemo% = 5: GOSUB mydemo
  278.                         UI.MbStatus = 3
  279.                     END IF
  280.             END SELECT
  281.         ELSE
  282.             IF lb THEN ' Left button just pressed.
  283.                 IF mydemo% THEN mydemo% = 6: GOSUB mydemo
  284.                 UI.MbStatus = -1
  285.                 IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
  286.                 z1 = TIMER
  287.             ELSEIF rb THEN ' Right button just pressed.
  288.                 IF mydemo% THEN mydemo% = 7: GOSUB mydemo
  289.                 IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
  290.                 UI.MbStatus = -2
  291.             ELSEIF mb THEN ' Middle button just pressed.
  292.                 IF mydemo% THEN mydemo% = 8: GOSUB mydemo
  293.                 IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
  294.                 UI.MbStatus = -3
  295.             ELSEIF mw THEN ' Mouse wheel just moved.
  296.                 SELECT CASE mw
  297.                     CASE IS > 0 ' Scroll down.
  298.                         IF mydemo% THEN mydemo% = 9: GOSUB mydemo
  299.                     CASE IS < 0 ' Scroll up.
  300.                         IF mydemo% THEN mydemo% = 10: GOSUB mydemo
  301.                 END SELECT
  302.             END IF
  303.         END IF
  304.  
  305.         UI.oldmx = UI.mx: UI.oldmy = UI.my: mw = 0 ' Mouse position past and present.
  306.     END IF
  307.     EXIT SUB
  308.  
  309.     mydemo:
  310.     LOCATE 1, 1: PRINT "Last User Status:                                    ";
  311.     LOCATE , 19
  312.     SELECT CASE mydemo%
  313.         CASE 1
  314.             PRINT "1-byte Key = "; UI.KeyPress
  315.         CASE 2
  316.             PRINT "2-byte Key = "; UI.KeyPress
  317.         CASE 3
  318.             PRINT "Left button released."
  319.         CASE 4
  320.             PRINT "Right button released."
  321.         CASE 5
  322.             PRINT "Middle button released."
  323.         CASE 6
  324.             PRINT "Left button down."
  325.         CASE 7
  326.             PRINT "Right button down."
  327.         CASE 8
  328.             PRINT "Middle button down."
  329.         CASE 9
  330.             PRINT "Wheel scroll down."
  331.         CASE 10
  332.             PRINT "Wheel scroll up."
  333.         CASE 11
  334.             PRINT "Left button double click."
  335.         CASE 12
  336.             PRINT "Drag..."
  337.     END SELECT
  338.     mydemo% = -1
  339.     RETURN
  340.  
  341.     check_UI.KeyCombos:
  342.     IF UI.KeyCombos THEN
  343.         LOCATE 1, 50
  344.         SELECT CASE UI.KeyCombos
  345.             CASE 1
  346.                 PRINT "Shift key down.        ";
  347.             CASE 2
  348.                 PRINT "Ctrl key down.         ";
  349.             CASE 3
  350.                 PRINT "Alt key down.          ";
  351.             CASE 4
  352.                 PRINT "Ctrl + Shift key down. ";
  353.         END SELECT
  354.     ELSE
  355.         LOCATE 1, 50: PRINT SPACE$(29);
  356.     END IF
  357.     RETURN

So in time, I will reinvent one of my many wheels again, and much like the mouse routine, that this routine uses, I will have a universal menu routine. The next stage is to put the horizontal menu in. Ah, did I mention how much I love that edit post feature restored? I think I did.

So if this goes well, all that would be needed is for the user to decide on a couple of options, like the box around the vertical menu, and then just fill in as many of the menu$() arrays. Skip every-other one to space the entries. Of course, it will get more complicated. Scrolling menu for more than the height of the program window will allow, etc.

Anyway, I'd just thought I'd post what I have so far. I wish I was more comfortable with _PRINTSTRING. It would be fun to be working on a graphics clone.
 
Pete

EDIT: Added the horizontal menu option.

11
QB64 Discussion / Mighty Mouse?
« on: October 05, 2021, 02:16:59 pm »
I'll let you guys decide...

Code: QB64: [Select]
  1. mydemo% = -1
  2. DIM UI AS UserInput
  3.  
  4. TYPE UserInput
  5.     KeyPress AS STRING
  6.     KeyCombos AS INTEGER
  7.     MbStatus AS INTEGER
  8.     MbEnvoked AS INTEGER
  9.     drag AS INTEGER
  10.     DoubleClick AS INTEGER
  11.     MbLeftx AS INTEGER
  12.     MbLefty AS INTEGER
  13.     mx AS INTEGER
  14.     oldmx AS INTEGER
  15.     my AS INTEGER
  16.     oldmy AS INTEGER
  18.  
  19. PRINT "Press keys or use mouse for demo.";
  21.     CALL keyboard_mouse(UI, mydemo%)
  22.     IF UI.MbStatus < 0 AND UI.MbEnvoked = 0 THEN
  23.         SOUND 1000, .3: UI.MbEnvoked = -1
  24.     END IF
  25.     IF UI.KeyPress = CHR$(13) THEN BEEP: EXIT DO
  27.  
  29.     CALL keyboard_mouse(UI, mydemo%)
  30.     IF UI.MbStatus > 0 AND UI.MbEnvoked = 0 THEN
  31.         SOUND 300, .3: UI.MbEnvoked = 1
  32.     END IF
  34.  
  36.  
  37. SUB keyboard_mouse (UI AS UserInput, mydemo%)
  38.     STATIC z1, lclick
  39.  
  40.     _LIMIT 30
  41.  
  42.     DEF SEG = 0
  43.     IF PEEK(1047) MOD 16 = 1 OR PEEK(1047) MOD 16 = 2 THEN
  44.         UI.KeyCombos = 1 ' Shift  % = -1 ELSE shift% = 0
  45.     ELSEIF PEEK(1047) MOD 16 = 3 OR PEEK(1047) MOD 16 = 4 THEN
  46.         UI.KeyCombos = 2 ' Ctrl  % = -1 ELSE ctrl% = 0
  47.     ELSEIF PEEK(1047) MOD 16 = 7 OR PEEK(1047) MOD 16 = 8 THEN
  48.         UI.KeyCombos = 3 ' Alt  % = -1
  49.     ELSEIF PEEK(1047) MOD 16 = 5 OR PEEK(1047) MOD 16 = 6 THEN
  50.         UI.KeyCombos = 4 ' Ctrl+Shift  % = -1 ELSE ctrlshift% = 0
  51.     ELSE
  52.         UI.KeyCombos = 0
  53.     END IF
  54.     DEF SEG
  55.  
  56.     IF mydemo% THEN GOSUB check_UI.KeyCombos
  57.  
  58.     UI.KeyPress = INKEY$
  59.     IF LEN(UI.KeyPress) THEN ' A key was pressed.
  60.         UI.MbEnvoked = 0: UI.MbLeftx = 0
  61.         SELECT CASE LEN(UI.KeyPress)
  62.             CASE 1 ' 1-byte key A-Z, etc.
  63.                 IF mydemo% THEN mydemo% = 1: GOSUB mydemo
  64.                 SELECT CASE UI.KeyPress
  65.                     ' Place key selection routine here...
  66.                     CASE CHR$(27): SYSTEM
  67.                 END SELECT
  68.             CASE 2 '2-byte key F1-F12, etc.
  69.                 IF mydemo% THEN mydemo% = 2: GOSUB mydemo
  70.                 SELECT CASE RIGHT$(UI.KeyPress, 1)
  71.                     ' Place key selection routine here...
  72.                 END SELECT
  73.         END SELECT
  74.     ELSE ' Check for mouse input since no keyboard input was detected.
  75.  
  76.         IF lclick THEN ' Check timer for double-clicks.
  77.             IF TIMER < z1 THEN z1 = z1 - 86400 ' Midnight adjustment.
  78.             IF TIMER - z1 > .33 THEN lclick = 0 ' Too much time ellapsed for a double click.
  79.         END IF
  80.  
  81.         WHILE _MOUSEINPUT
  82.             mw = mw + _MOUSEWHEEL ' Check for mouse wheel use.
  83.         WEND
  84.  
  85.         ' Get mouse status.
  86.         UI.mx = _MOUSEX
  87.         UI.my = _MOUSEY
  88.         lb = _MOUSEBUTTON(1)
  89.         rb = _MOUSEBUTTON(2)
  90.         mb = _MOUSEBUTTON(3)
  91.  
  92.         SELECT CASE UI.MbEnvoked
  93.             CASE 0
  94.                 IF lb OR rb OR mb THEN
  95.  
  96.                 END IF
  97.             CASE 1
  98.                 IF lb OR rb OR mb THEN UI.MbEnvoked = 0
  99.             CASE -1
  100.                 IF lb = 0 AND rb = 0 AND mb = 0 THEN UI.MbEnvoked = 0
  101.         END SELECT
  102.  
  103.         ' Check for mouse movement.
  104.         IF UI.mx <> UI.oldmx OR UI.my <> UI.oldmy THEN
  105.             oldcsrlin = CSRLIN: oldpos = POS(0)
  106.             LOCATE 3, 1: PRINT "Mouse row/col ="; UI.my; UI.mx; "     ";: LOCATE oldcsrlin, oldpos
  107.         END IF
  108.  
  109.         IF UI.MbStatus < 0 THEN ' Mouse button pressed. UI.MbStatus identity is by number. -1=left, -2=right, -3=middle.
  110.             SELECT CASE UI.MbStatus
  111.                 CASE -1 ' Left button was pressed.
  112.                     IF lb = 0 THEN ' Left button released.
  113.                         SELECT CASE lclick ' Single or double click analysis.
  114.                             CASE 0
  115.                                 IF mydemo% THEN mydemo% = 3: GOSUB mydemo
  116.                                 lclick = lclick + 1
  117.                             CASE ELSE ' Double click. Completed upon 2nd left button release.
  118.                                 IF mydemo% THEN mydemo% = 11: GOSUB mydemo
  119.                                 UI.DoubleClick = -1
  120.                                 lclick = 0
  121.                         END SELECT
  122.                         UI.MbStatus = 1
  123.  
  124.                         IF UI.MbLeftx THEN
  125.                             IF UI.mx <> UI.MbLeftx OR UI.my <> UI.MbLefty THEN UI.MbStatus = 0: lclick = 0
  126.                             UI.MbLeftx = 0: UI.MbLefty = 0
  127.                         END IF
  128.  
  129.                         IF UI.drag THEN UI.drag = 0
  130.                     ELSE ' Left button is being held down. Check for UI.drag.
  131.                         IF UI.mx <> UI.oldmx OR UI.my <> UI.oldmy THEN ' Mouse cursor has moved. UI.drag.
  132.                             IF mydemo% THEN mydemo% = 12: GOSUB mydemo
  133.                             UI.drag = -1
  134.                         END IF
  135.                     END IF
  136.                 CASE -2 ' Right button was pressed.
  137.                     IF rb = 0 THEN ' Right button was relased.
  138.                         IF mydemo% THEN mydemo% = 4: GOSUB mydemo
  139.                         UI.MbStatus = 2
  140.                     END IF
  141.                 CASE -3 ' Middle button was pressed
  142.                     IF mb = 0 THEN ' Middle button was released.
  143.                         IF mydemo% THEN mydemo% = 5: GOSUB mydemo
  144.                         UI.MbStatus = 3
  145.                     END IF
  146.             END SELECT
  147.         ELSE
  148.             IF lb THEN ' Left button just pressed.
  149.                 IF mydemo% THEN mydemo% = 6: GOSUB mydemo
  150.                 UI.MbStatus = -1
  151.                 IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
  152.                 z1 = TIMER
  153.             ELSEIF rb THEN ' Right button just pressed.
  154.                 IF mydemo% THEN mydemo% = 7: GOSUB mydemo
  155.                 IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
  156.                 UI.MbStatus = -2
  157.             ELSEIF mb THEN ' Middle button just pressed.
  158.                 IF mydemo% THEN mydemo% = 8: GOSUB mydemo
  159.                 IF UI.MbLeftx = 0 THEN UI.MbLeftx = UI.mx: UI.MbLefty = UI.my
  160.                 UI.MbStatus = -3
  161.             ELSEIF mw THEN ' Mouse wheel just moved.
  162.                 SELECT CASE mw
  163.                     CASE IS > 0 ' Scroll down.
  164.                         IF mydemo% THEN mydemo% = 9: GOSUB mydemo
  165.                     CASE IS < 0 ' Scroll up.
  166.                         IF mydemo% THEN mydemo% = 10: GOSUB mydemo
  167.                 END SELECT
  168.             END IF
  169.         END IF
  170.  
  171.         UI.oldmx = UI.mx: UI.oldmy = UI.my: mw = 0 ' Mouse position past and present.
  172.     END IF
  173.     EXIT SUB
  174.  
  175.     mydemo:
  176.     LOCATE 1, 1: PRINT "Last User Status:                                    ";
  177.     LOCATE , 19
  178.     SELECT CASE mydemo%
  179.         CASE 1
  180.             PRINT "1-byte Key = "; UI.KeyPress
  181.         CASE 2
  182.             PRINT "2-byte Key = "; UI.KeyPress
  183.         CASE 3
  184.             PRINT "Left button released."
  185.         CASE 4
  186.             PRINT "Right button released."
  187.         CASE 5
  188.             PRINT "Middle button released."
  189.         CASE 6
  190.             PRINT "Left button down."
  191.         CASE 7
  192.             PRINT "Right button down."
  193.         CASE 8
  194.             PRINT "Middle button down."
  195.         CASE 9
  196.             PRINT "Wheel scroll down."
  197.         CASE 10
  198.             PRINT "Wheel scroll up."
  199.         CASE 11
  200.             PRINT "Left button double click."
  201.         CASE 12
  202.             PRINT "Drag..."
  203.     END SELECT
  204.     mydemo% = -1
  205.     RETURN
  206.  
  207.     check_UI.KeyCombos:
  208.     IF UI.KeyCombos THEN
  209.         LOCATE 1, 50
  210.         SELECT CASE UI.KeyCombos
  211.             CASE 1
  212.                 PRINT "Shift key down.        ";
  213.             CASE 2
  214.                 PRINT "Ctrl key down.         ";
  215.             CASE 3
  216.                 PRINT "Alt key down.          ";
  217.             CASE 4
  218.                 PRINT "Ctrl + Shift key down. ";
  219.         END SELECT
  220.     ELSE
  221.         LOCATE 1, 50: PRINT SPACE$(29);
  222.     END IF
  223.     RETURN

Anyway, this is just something I threw together for another member to consider. I usually write these routines from scratch each time I need one, but for fun, I thought I take a shot at one I could save as a library and use as a universal routine for future apps. I need to add some more stuff from my other routines, like my PEEK / POKE routine for detecting Shift + arrow keys, alt, ctrl, etc. I also want to add another variable to let the user decide if the mouse action should take place upon button press or release. I'll probably update this post, occasionally, if and when I make these additions. Fun stuff.

Pete

Edited: Worked in V 1.3, but not the more recent versions. Reason was as bplus pointed out, I had two IF THEN statements following a SELECT CASE statement. Both statements were moved one line up, and now work in the later versions. Thanks for catching that, Mark!

Edited: Added a method and demo for mouse action either on button press or release. The first loop signals a high tone when a mouse click is made with button down. It then shuts off more mouse input until the button is released. Press [ENTER] to exit to the next loop, which issues a low tone when a depressed mouse button is released. Now the user can decide on each mouse event if the program should respond upon mouse button press or release.

Edited: Added my PEEK / POKE routine to detect Shift, Ctrl, Alt, and Ctrl+Shift.

Editd: Added a prevent click initiation on button release if mouse cursor is moved while button is held down. So if the user decides to use the activate mouse command on button release option, this addition allows the user to abort the click, by moving the mouse cursor before the button is released.

Edited: Did some renaming and changed variables to TYPE variables.

Edited: Added mouse row and column indicator.

12
QB64 Discussion / Modify Post Permissions
« on: October 01, 2021, 03:15:21 pm »
I have read the previous thread about Modify Post permissions being limited to 5-minutes, in order to avoid some sort of abuse. As of the past couple of days, I thought it was returned to it's "forever" status, but today, Mark, Steve, and I noticed it's apparently back to the 5-minute limit. My hunch is that when the forum went down a couple of days ago, it was reset when the glitch was corrected. My second hunch is it was not noticed until today, and then it got switched to the 5-minute limit again.

As a long time QB forum owner, I just don't see any benefit in this 5-minute editing limit. I do see tremendous use, without abuse, and benefit to most all of our members by permitting a much longer editing limit, maybe a month for programs and a day for all other boards. It's far better for updating code in the Programs board. It's far better at keeping posts more relevant in all other boards. It helps members avoid embarrassment when they make some typo, or when there is a need to correct or clarify what was posted upon further reflection, which often occurs well past a 5-minute time limit.

At N54 and Tapatalk, I would simply remove or limit permissions just for the member who abused the feature. I'd highly be in favor of taking that approach here, provided it is available on Simple Machines forums. I simply cannot imagine what abuse would be so great and used so frequently it would far outweigh the benefits of longer time limits for editing in the community.

Pete

13
QB64 Discussion / I just had this amazing brainstorm!
« on: October 01, 2021, 01:42:29 pm »
Fortunately, that guy who sells Flex Tape came along and sealed things up before a lot of good info got through, but I did come away with this from the thread I stared about organization...

Why not add a TAGS option to the QB64 IDE?

So SAVE and SAVE AS now have a box to check [ ] Add Tags

Now I know this opens up a can of worms on indexing. What happens if the file name gets changed, how to keep the same tags on builds, etc. so you have to weigh the work load with the benefits. The OPEN routine would also have to include an option to sort by tags.

The internet has used this for ages, and it is a proven and useful form of organization. I think it would be great to have it as part of the QB64 IDE, but again, unless there is some simple way to create it, and there may be, I would think finding out the percentage of user usage would be warranted before trying to implement file tagging.

Thoughts?

Pete

14
QB64 Discussion / How organized are you guys?
« on: October 01, 2021, 12:33:41 pm »
Organization is my middle, no first, no wait, I can't remember what part of my name it is. Well, that's about the truth. I started a little cat herding project to round up all the various aps, utilities, algorithms, etc., I've made in QB over the years, and what I'm finding is hundreds of files with hard to apps, many with hard to deduce old MS-DOS 8.3 names. It's reminding me of the Indiana Jones Arc of the Covenant lost in the government warehouse scene, only in my case, it's more of the "wherehouse." I mean I did start making build folders, about 8 years ago, but before that, I didn't even sort out builds.

So how about you guys? Anyone develop a system of tagging files or other methods so you have a good idea of what you programmed in your past?

Pete

15
QB64 Discussion / Need help finishing my HELLO WORLD program.
« on: September 30, 2021, 11:28:23 pm »
The "O" is out on my keyboard and so far, it's just been HELL

Pete

Pages: [1] 2 3 ... 9