Author Topic: Tiny Navigator  (Read 9908 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Tiny Navigator
« on: August 23, 2019, 01:39:04 pm »
Tiny Navigator fixed and can now go anywhere you are allowed on C:

Code: QB64: [Select]
  1. _TITLE "Tiny Navigator mod orig post with perm tmpfile" 'B+
  2. ' 2019-08-22 orig post at https://www.qb64.org/forum/index.php?topic=1646.msg108682#msg108682
  3. ' 2019-08-23 try fix (to nav all directories) with one place for tmpFile, theory can't write files in some dir's
  4. ' For some reason Windows won't write to a fully pathed file in my user folder???
  5. ' Try testing if dir exists "C:\temp" exists and making one if not, yes! and I can write my temp files there
  6. ' and now I can chDir anywhere!
  7.  
  8. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  9.  
  10. ' Attention!!!  this creates a temp directory "C:\temp", do not run this program if you forbid this.
  11.  
  12. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  13.  
  14.  
  15. SCREEN _NEWIMAGE(1200, 600, 32)
  16. _SCREENMOVE 100, 50
  17.  
  18.  
  19. IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp"
  20.  
  21. DIM mySelection&, done$
  22.  
  23.     PRINT "Current Directory: " + _CWD$
  24.     REDIM myFiles(0) AS STRING
  25.     loadFA "*.*", myFiles()
  26.     mySelection& = getArrayItemNumber&(5, 5, 90, 30, myFiles())
  27.     CLS
  28.     IF mySelection& <> -1719 THEN
  29.         CHDIR myFiles(mySelection&)
  30.     ELSE
  31.         PRINT "No Directory selected."
  32.         INPUT "Press enter to continue navigator, any + enter to quit... "; done$
  33.     END IF
  34.     _LIMIT 60
  35. LOOP UNTIL done$ <> ""
  36.  
  37. SUB loadFA (spec$, fa() AS STRING)
  38.     DIM tmpFile$, Index%, fline$, d$
  39.     tmpFile$ = "C:\temp\DIR$INF0.INF"
  40.     'PRINT tmpFile$
  41.     'END
  42.     SHELL _HIDE "DIR /a:d >" + tmpFile$ 'get directories  but have to do a little pruning
  43.     'SHELL _HIDE "DIR " + spec$ + " /b > " + TmpFile$
  44.     'SHELL _HIDE "DIR " + spec$ + " /b /s /o:gen> " + TmpFile$
  45.     OPEN tmpFile$ FOR INPUT AS #1
  46.     Index% = -1
  47.     DO WHILE NOT EOF(1)
  48.         LINE INPUT #1, fline$
  49.         IF INSTR(fline$, "<DIR>") THEN
  50.             d$ = _TRIM$(rightOf$(fline$, "<DIR>"))
  51.             Index% = Index% + 1
  52.             REDIM _PRESERVE fa(Index%)
  53.             fa(Index%) = d$
  54.         END IF
  55.     LOOP
  56.     CLOSE #1
  57.     KILL tmpFile$
  58.  
  59. FUNCTION rightOf$ (source$, of$)
  60.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
  61.  
  62. 'attempting use this 4 things (2018-12-30)
  63. ' 1. expects HELP sub that uses message and message box but easy to comment out
  64. ' 2. expects to be in graphics mode
  65. ' 3. chages color of screen
  66. ' 4. needs _KEYCLEAR 2 before calling of previous keyhits will interfere!!!
  67. '
  68. ' Future Help Message Box for the function.
  69. ' "*** Mouse and Key Instructions ***"
  70. '
  71. ' "Mouse, mouse wheel, and arrow keys should work as expected for item selection."
  72. ' "Press spacebar to select a highlighted item or just click it."
  73. ' "Use number(s) + enter to select an array item by it's index number,"
  74. ' "backspace will remove last number pressed, c will clear a number started."
  75. ' "Numbers started are shown in bottom right PgDn bar."
  76. ' "Enter will also select the highlighted item, if no number has been started."
  77. ' "Home starts you at lowest array index, End highlights then highest index."
  78. ' "Use PgUp and PgDn keys to flip through pages of array items."
  79. '
  80. ' "Escape returns -1719 to allow a Cancel function and signal no slection."
  81. FUNCTION getArrayItemNumber& (locateRow, locateColumn, boxWidth, boxHeight, arr() AS STRING)
  82.     'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
  83.     'boxWidth and boxHeight are in character units, again for locate and print at correct places.
  84.     'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.
  85.  
  86.     DIM curRow AS INTEGER, curCol AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
  87.     DIM maxWidth AS INTEGER, maxHeight AS INTEGER, page AS INTEGER, hlite AS INTEGER, mx AS INTEGER, my AS INTEGER
  88.     DIM lastMX AS INTEGER, lastMY AS INTEGER, row AS INTEGER, mb AS INTEGER
  89.     DIM lba AS LONG, uba AS LONG, choice AS LONG, kh AS LONG, index AS LONG
  90.     DIM clrStr AS STRING, b AS STRING
  91.  
  92.     'save old settings to restore at end ofsub
  93.     curRow = CSRLIN
  94.     curCol = POS(0)
  95.     fg = _DEFAULTCOLOR
  96.     bg = _BACKGROUNDCOLOR
  97.     _KEYCLEAR
  98.  
  99.     maxWidth = boxWidth '       number of characters in box
  100.     maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
  101.     lba = LBOUND(arr)
  102.     uba = UBOUND(arr)
  103.     page = 0
  104.     hlite = 0 '                 line in display ready for selection by spacebar or if no number is started, enter
  105.     clrStr$ = SPACE$(maxWidth) 'clearing a display line
  106.  
  107.     GOSUB update '              show the beginning of the array items for selection
  108.  
  109.     'signal cancel selection process, exit sub with this unlikely index to signal canel
  110.     choice = -1719 'primes 7 and 8, not likely to be a select index of an array
  111.  
  112.     DO 'until get a selection or demand exit
  113.  
  114.         'handle the key stuff
  115.         kh& = _KEYHIT
  116.         IF kh& THEN
  117.             IF kh& > 0 AND kh& < 255 THEN
  118.                 IF INSTR("0123456789", CHR$(kh&)) > 0 THEN b$ = b$ + CHR$(kh&): GOSUB update
  119.                 'IF CHR$(kh&) = "h" THEN HELP: _KEYCLEAR
  120.  
  121.                 IF CHR$(kh&) = "c" THEN b$ = "": GOSUB update
  122.                 IF kh& = 13 THEN 'enter pressed check if number is being entered?
  123.                     IF LEN(b$) THEN
  124.                         IF VAL(b$) >= lba AND VAL(b$) <= uba THEN 'we have number started
  125.                             choice = VAL(b$): EXIT DO
  126.                         ELSE 'clear b$ to show some response to enter
  127.                             b$ = "": GOSUB update 'clear the value that doesn't work
  128.                         END IF
  129.                     ELSE
  130.                         choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
  131.                     END IF
  132.                 END IF
  133.                 IF kh& = 27 THEN EXIT DO 'escape clause offered to Cancel selection process
  134.                 IF kh& = 32 THEN choice = hlite + page * maxHeight + lba 'best way to choose highlighted selection
  135.                 IF kh& = 8 THEN 'backspace to edit number
  136.                     IF LEN(b$) THEN b$ = LEFT$(b$, LEN(b$) - 1): GOSUB update
  137.                 END IF
  138.             ELSE
  139.                 SELECT CASE kh& 'choosing sections of array to display and highlighted item
  140.                     CASE 20736 'pg dn
  141.                         IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  142.                     CASE 18688 'pg up
  143.                         IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  144.                     CASE 18432 'up
  145.                         IF hlite - 1 < 0 THEN
  146.                             IF page > 0 THEN
  147.                                 page = page - 1: hlite = maxHeight - 1: GOSUB update
  148.                             END IF
  149.                         ELSE
  150.                             hlite = hlite - 1: GOSUB update
  151.                         END IF
  152.                     CASE 20480 'down
  153.                         IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  154.                             IF hlite + 1 > maxHeight - 1 THEN
  155.                                 page = page + 1: hlite = 0: GOSUB update
  156.                             ELSE
  157.                                 hlite = hlite + 1: GOSUB update
  158.                             END IF
  159.                         END IF
  160.                     CASE 18176 'home
  161.                         page = 0: hlite = 0: GOSUB update
  162.                     CASE 20224 ' end
  163.                         page = INT((uba - lba) / maxHeight): hlite = maxHeight - 1: GOSUB update
  164.                 END SELECT
  165.             END IF
  166.         END IF
  167.  
  168.         'handle the mouse stuff
  169.         WHILE _MOUSEINPUT
  170.             IF _MOUSEWHEEL = -1 THEN 'up?
  171.                 IF hlite - 1 < 0 THEN
  172.                     IF page > 0 THEN
  173.                         page = page - 1: hlite = maxHeight - 1: GOSUB update
  174.                     END IF
  175.                 ELSE
  176.                     hlite = hlite - 1: GOSUB update
  177.                 END IF
  178.             ELSEIF _MOUSEWHEEL = 1 THEN 'down?
  179.                 IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  180.                     IF hlite + 1 > maxHeight - 1 THEN
  181.                         page = page + 1: hlite = 0: GOSUB update
  182.                     ELSE
  183.                         hlite = hlite + 1: GOSUB update
  184.                     END IF
  185.                 END IF
  186.             END IF
  187.         WEND
  188.         mx = INT((_MOUSEX - locateColumn * 8) / 8) + 2: my = INT((_MOUSEY - locateRow * 16) / 16) + 2
  189.         IF _MOUSEBUTTON(1) THEN 'click contols or select array item
  190.             'clear mouse clicks
  191.             mb = _MOUSEBUTTON(1)
  192.             IF mb THEN 'clear it
  193.                 WHILE mb 'OK!
  194.                     IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  195.                     _LIMIT 100
  196.                 WEND
  197.             END IF
  198.  
  199.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  200.                 choice = my + page * maxHeight + lba - 1 'select item clicked
  201.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = 0 THEN 'page up or exit
  202.                 IF my = 0 AND (mx <= maxWidth AND mx >= maxWidth - 2) THEN 'exit sign
  203.                     EXIT DO 'escape plan for mouse click top right corner of display box
  204.                 ELSE 'PgUp bar clicked
  205.                     IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  206.                 END IF
  207.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = maxHeight + 1 THEN 'page down bar clicked
  208.                 IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  209.             END IF
  210.         ELSE '   mouse over highlighting, only if mouse has moved!
  211.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  212.                 IF mx <> lastMX OR my <> lastMY THEN
  213.                     IF my - 1 <> hlite AND (my - 1 + page * maxHeight + lba <= uba) THEN
  214.                         hlite = my - 1
  215.                         lastMX = mx: lastMY = my
  216.                         GOSUB update
  217.                     END IF
  218.                 END IF
  219.             END IF
  220.         END IF
  221.         _LIMIT 200
  222.     LOOP UNTIL choice >= lba AND choice <= uba
  223.     getArrayItemNumber& = choice
  224.     COLOR fg, bg
  225.     'clear key presses
  226.     _KEYCLEAR
  227.     LOCATE curRow, curCol
  228.     'clear mouse clicks
  229.     mb = _MOUSEBUTTON(1)
  230.     IF mb THEN 'clear it
  231.         WHILE mb 'OK!
  232.             IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  233.             _LIMIT 100
  234.         WEND
  235.     END IF
  236.     EXIT SUB
  237.  
  238.     'display of array sections and controls on screen
  239.     update:
  240.  
  241.     'fix hlite if it has dropped below last array item
  242.     WHILE hlite + page * maxHeight + lba > uba
  243.         hlite = hlite - 1
  244.     WEND
  245.  
  246.     'main display of array items at page * maxHeight (lines high)
  247.     FOR row = 0 TO maxHeight - 1
  248.         IF hlite = row THEN COLOR _RGB(200, 200, 255), _RGB32(0, 0, 88) ELSE COLOR _RGB32(0, 0, 88), _RGB(200, 200, 255)
  249.         LOCATE locateRow + row, locateColumn: PRINT clrStr$
  250.         index = row + page * maxHeight + lba
  251.         IF index >= lba AND index <= uba THEN
  252.             LOCATE locateRow + row, locateColumn
  253.             PRINT LEFT$(LTRIM$(STR$(index)) + ") " + arr(index), maxWidth)
  254.         END IF
  255.     NEXT
  256.  
  257.     'make page up and down bars to click, print PgUp / PgDn if available
  258.     COLOR _RGB32(200, 200, 255), _RGB32(0, 100, 50)
  259.     LOCATE locateRow - 1, locateColumn: PRINT SPACE$(maxWidth)
  260.     IF page <> 0 THEN LOCATE locateRow - 1, locateColumn: PRINT LEFT$(" Pg Up" + SPACE$(maxWidth), maxWidth)
  261.     LOCATE locateRow + maxHeight, locateColumn: PRINT SPACE$(maxWidth)
  262.     IF page <> INT(uba / maxHeight) THEN
  263.         LOCATE locateRow + maxHeight, locateColumn: PRINT LEFT$(" Pg Dn" + SPACE$(maxWidth), maxWidth)
  264.     END IF
  265.     'make exit sign for mouse click
  266.     COLOR _RGB32(255, 255, 255), _RGB32(200, 100, 0)
  267.     LOCATE locateRow - 1, locateColumn + maxWidth - 3
  268.     PRINT " X "
  269.  
  270.     'if a number selection has been started show it's build = b$
  271.     IF LEN(b$) THEN
  272.         COLOR _RGB(255, 255, 0), _RGB32(0, 0, 0)
  273.         LOCATE locateRow + maxHeight, locateColumn + maxWidth - LEN(b$) - 1
  274.         PRINT b$;
  275.     END IF
  276.     _DISPLAY
  277.     _LIMIT 100
  278.     RETURN
  279.  

The code is still quite messy and I hope to add a select files box.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
Re: Tiny Navigator
« Reply #1 on: August 23, 2019, 01:55:50 pm »
Try this little two-line demo out:
Code: QB64: [Select]

It should be safe to get the users temp directory, without having to make one of your own.
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Tiny Navigator
« Reply #2 on: August 23, 2019, 02:36:35 pm »
Thanks Steve, looks to be working well.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Tiny Navigator
« Reply #3 on: August 23, 2019, 07:33:07 pm »
This is awesome B+! Thank you! But I did run into 1 big problem, it starts playing the music of that folder but it won't go to the music info screen, until you press Esc for some reason. Esc ends the program but it also shows that music info screen. There's also a Warning saying 1 variable is unused on line 186, which is in your code. Here is the music player so far, maybe you or someone can help me fix this. I added another SCREEN command right before the songs play and music info comes up, but that doesn't seem to help. It must have to do with a conflict between your SCREEN and my SCREEN. Another problem is that there's a Subscript Out of Range in line 176, sometimes. I think when I got too deep in the folders, about 3 in. But this is nice so far. The area where it plays the folder is line 95 at playdir: The area where it changes directory, I just GOSUB to it from line 45. Your code is the last part of this program, which starts at line 146. I commented out your OPTION _EXPLICIT so I wouldn't have to dig through the entire program to make DIM commands for every variable. I'm not sure what that command does myself.
The Subscript Out Of Range on line 176 happens when I click X to shut your window off to go back to my main menu. Maybe we need to DIM myFiles ?

Code: QB64: [Select]
  1. 'This program was made on August 21, 2019 by Ken G. with some help by Petr from the QB64.org forum.
  2. 'This program will make a temporary file called MyMusicFiles-Temp000.temp
  3. 'which is just a text file and can be opened by Notepad. It shows a list of
  4. 'the mp3 songs in that directory. The file is deleted once the music starts.
  5.  
  6. DECLARE LIBRARY 'Directory Information using KERNEL32 provided by Dav
  7.     FUNCTION CURDirectory ALIAS GetCurrentDirectoryA (BYVAL nBufferLen AS LONG, lpBuffer AS STRING)
  8.  
  9.  
  10. _TITLE "Mini MP3 Player"
  11. SCREEN _NEWIMAGE(400, 400, 32)
  12. begin:
  13. DIM f$(100000)
  14. record = 0
  15. rec = 0
  16. oldp = 0
  17. p = 0
  18. PRINT "                Mini MP3 Player"
  19. PRINT "                  By Ken G."
  20. '=== SHOW CURRENT DIRECTORY
  21. CurDir$ = SPACE$(255)
  22. Result = CURDirectory(LEN(CurDir$), CurDir$)
  23. IF Result THEN LOCATE 11, 1: PRINT "Directory: "; LEFT$(CurDir$, Result)
  24. PRINT "            (1) Change Directory"
  25. PRINT "            (2) Play Song"
  26. PRINT "            (3) Play Directory"
  27. PRINT "            (4) Quit"
  28. INPUT "      ->", a
  29. IF a = 1 THEN GOTO directory:
  30. IF a = 2 THEN GOTO song:
  31. IF a = 3 THEN GOTO playdir:
  32. IF a = 4 THEN END
  33. IF a > 4 OR a < 1 OR a <> INT(a) THEN GOTO begin:
  34. directory:
  35.  
  36. 'Here is B+'s File Navigator
  37.  
  38. GOSUB changedirectory:
  39.  
  40. 'again:
  41. 'PRINT: PRINT: PRINT
  42. 'INPUT "Directory: ", d$
  43. 'IF d$ = "" THEN GOTO begin:
  44. 'r% = _DIREXISTS(d$)
  45. 'IF r% <> -1 THEN
  46. 'PRINT "Directory doesn't exist."
  47. 'PRINT "Try again, or Enter for Menu."
  48. 'GOTO again:
  49. 'END IF
  50. 'CHDIR d$
  51. GOTO begin:
  52. song:
  53. FILES "*.mp3"
  54. again2:
  55. INPUT "Song: ", song$
  56. IF song$ = "" THEN GOTO begin:
  57. fe% = _FILEEXISTS(song$)
  58. IF fe% <> -1 THEN
  59.     PRINT "Filename doesn't exist."
  60.     PRINT "Try again, or Enter for Menu."
  61.     GOTO again2:
  62. s& = _SNDOPEN(song$)
  63. LOCATE 1, 1: PRINT song$
  64. LOCATE 2, 1: PRINT "Sound Rate: "; _SNDRATE
  65. LOCATE 4, 1: PRINT "Length: "; INT(_SNDLEN(s&))
  66. LOCATE 6, 1: PRINT "Space Bar = Pause (P)lay (S)top (M)enu"
  67.  
  68.     a$ = INKEY$
  69.     IF a$ = CHR$(27) THEN _SNDSTOP s&: END
  70.     IF a$ = " " THEN _SNDPAUSE s&
  71.     IF a$ = "S" OR a$ = "s" THEN _SNDSTOP s&
  72.     IF a$ = "P" OR a$ = "p" THEN _SNDPLAY s&
  73.     IF a$ = "M" OR a$ = "m" THEN _SNDSTOP s&: GOTO begin:
  74.     oldp = p
  75.     p = _SNDGETPOS(s&)
  76.     LOCATE 3, 1: PRINT "Position: "; INT(p)
  77.     IF INT(oldp) > INT(p) AND INT(p) = 0 THEN GOTO begin:
  78. GOTO begin:
  79. playdir:
  80. SCREEN _NEWIMAGE(400, 400, 32)
  81. REDIM file(0) AS STRING 'create empty text array. 0 is record nr. 1!
  82. SHELL _HIDE "dir *.mp3 /B > MyMusicFiles-Temp000.temp" 'create mp3 files list.
  83. OPEN "MyMusicFiles-Temp000.temp" FOR INPUT AS #1
  84.     CLOSE #1
  85.     SHELL _HIDE "DEL MyMusicFiles-Temp000.temp"
  86.     CLS
  87.     PRINT "No mp3 songs on this folder."
  88.     PRINT
  89.     INPUT "Press Enter to go back to Menu.", menu$
  90.     GOTO begin:
  91.     LINE INPUT #1, file$
  92.     file(record) = file$
  93.     f$(record) = file$
  94.     PRINT f$(record)
  95.     record = record + 1 'for next loop we needed array higher up to one
  96.     REDIM _PRESERVE file(record) AS STRING 'this do array bigger without deleting content
  97. SHELL _HIDE "DEL MyMusicFiles-Temp000.temp"
  98. 'so now file(0) is first file from disk. file(3) is 4th file from disk. Try it:
  99. ready:
  100. s& = _SNDOPEN(file(rec))
  101. LOCATE 1, 1: PRINT f$(rec)
  102. LOCATE 2, 1: PRINT "Sound Rate: "; _SNDRATE
  103. LOCATE 4, 1: PRINT "Length: "; INT(_SNDLEN(s&))
  104. LOCATE 6, 1: PRINT "Space Bar = Pause (P)lay (N)ext Song (M)enu"
  105.  
  106.     a$ = INKEY$
  107.     IF a$ = CHR$(27) THEN _SNDSTOP s&: END
  108.     IF a$ = " " THEN _SNDPAUSE s&
  109.     IF a$ = "N" OR a$ = "n" THEN _SNDSTOP s&
  110.     IF a$ = "P" OR a$ = "p" THEN _SNDPLAY s&
  111.     IF a$ = "M" OR a$ = "m" THEN _SNDSTOP s&: rec = 0: GOTO begin:
  112.     oldp = p
  113.     p = _SNDGETPOS(s&)
  114.     LOCATE 3, 1: PRINT "Position: "; INT(p)
  115.     IF INT(oldp) > INT(p) AND INT(p) = 0 THEN GOTO more:
  116. more:
  117. IF rec = record - 1 THEN GOTO begin:
  118. rec = rec + 1
  119. GOTO ready:
  120. 'OPTION _EXPLICIT
  121. '_TITLE "Tiny Navigator mod orig post with perm tmpfile" 'B+
  122. ' 2019-08-22 orig post at https://www.qb64.org/forum/index.php?topic=1646.msg108682#msg108682
  123. ' 2019-08-23 try fix (to nav all directories) with one place for tmpFile, theory can't write files in some dir's
  124. ' For some reason Windows won't write to a fully pathed file in my user folder???
  125. ' Try testing if dir exists "C:\temp" exists and making one if not, yes! and I can write my temp files there
  126. ' and now I can chDir anywhere!
  127.  
  128. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  129.  
  130. ' Attention!!!  this creates a temp directory "C:\temp", do not run this program if you forbid this.
  131.  
  132. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  133.  
  134. changedirectory:
  135. SCREEN _NEWIMAGE(1200, 600, 32)
  136. _SCREENMOVE 100, 50
  137.  
  138.  
  139. IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp"
  140.  
  141. DIM mySelection&, done$
  142.  
  143.     PRINT "Current Directory: " + _CWD$
  144.     REDIM myFiles(0) AS STRING
  145.     loadFA "*.*", myFiles()
  146.     mySelection& = getArrayItemNumber&(5, 5, 90, 30, myFiles())
  147.     CLS
  148.     IF mySelection& <> -1719 THEN
  149.         CHDIR myFiles(mySelection&)
  150.     ELSE
  151.         PRINT "No Directory selected."
  152.         INPUT "Press enter to continue navigator, any + enter to quit... "; done$
  153.     END IF
  154.     _LIMIT 60
  155. LOOP UNTIL done$ <> ""
  156.  
  157.  
  158. SUB loadFA (spec$, fa() AS STRING)
  159.     DIM tmpFile$, Index%, fline$, d$
  160.     tmpFile$ = "C:\temp\DIR$INF0.INF"
  161.     'PRINT tmpFile$
  162.     'END
  163.     SHELL _HIDE "DIR /a:d >" + tmpFile$ 'get directories  but have to do a little pruning
  164.     'SHELL _HIDE "DIR " + spec$ + " /b > " + TmpFile$
  165.     'SHELL _HIDE "DIR " + spec$ + " /b /s /o:gen> " + TmpFile$
  166.     OPEN tmpFile$ FOR INPUT AS #1
  167.     Index% = -1
  168.     DO WHILE NOT EOF(1)
  169.         LINE INPUT #1, fline$
  170.         IF INSTR(fline$, "<DIR>") THEN
  171.             d$ = _TRIM$(rightOf$(fline$, "<DIR>"))
  172.             Index% = Index% + 1
  173.             REDIM _PRESERVE fa(Index%)
  174.             fa(Index%) = d$
  175.         END IF
  176.     LOOP
  177.     CLOSE #1
  178.     KILL tmpFile$
  179.  
  180. FUNCTION rightOf$ (source$, of$)
  181.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
  182.  
  183. 'attempting use this 4 things (2018-12-30)
  184. ' 1. expects HELP sub that uses message and message box but easy to comment out
  185. ' 2. expects to be in graphics mode
  186. ' 3. chages color of screen
  187. ' 4. needs _KEYCLEAR 2 before calling of previous keyhits will interfere!!!
  188. '
  189. ' Future Help Message Box for the function.
  190. ' "*** Mouse and Key Instructions ***"
  191. '
  192. ' "Mouse, mouse wheel, and arrow keys should work as expected for item selection."
  193. ' "Press spacebar to select a highlighted item or just click it."
  194. ' "Use number(s) + enter to select an array item by it's index number,"
  195. ' "backspace will remove last number pressed, c will clear a number started."
  196. ' "Numbers started are shown in bottom right PgDn bar."
  197. ' "Enter will also select the highlighted item, if no number has been started."
  198. ' "Home starts you at lowest array index, End highlights then highest index."
  199. ' "Use PgUp and PgDn keys to flip through pages of array items."
  200. '
  201. ' "Escape returns -1719 to allow a Cancel function and signal no slection."
  202. FUNCTION getArrayItemNumber& (locateRow, locateColumn, boxWidth, boxHeight, arr() AS STRING)
  203.     'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
  204.     'boxWidth and boxHeight are in character units, again for locate and print at correct places.
  205.     'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.
  206.  
  207.     DIM curRow AS INTEGER, curCol AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
  208.     DIM maxWidth AS INTEGER, maxHeight AS INTEGER, page AS INTEGER, hlite AS INTEGER, mx AS INTEGER, my AS INTEGER
  209.     DIM lastMX AS INTEGER, lastMY AS INTEGER, row AS INTEGER, mb AS INTEGER
  210.     DIM lba AS LONG, uba AS LONG, choice AS LONG, kh AS LONG, index AS LONG
  211.     DIM clrStr AS STRING, b AS STRING
  212.  
  213.     'save old settings to restore at end ofsub
  214.     curRow = CSRLIN
  215.     curCol = POS(0)
  216.     fg = _DEFAULTCOLOR
  217.     bg = _BACKGROUNDCOLOR
  218.     _KEYCLEAR
  219.  
  220.     maxWidth = boxWidth '       number of characters in box
  221.     maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
  222.     lba = LBOUND(arr)
  223.     uba = UBOUND(arr)
  224.     page = 0
  225.     hlite = 0 '                 line in display ready for selection by spacebar or if no number is started, enter
  226.     clrStr$ = SPACE$(maxWidth) 'clearing a display line
  227.  
  228.     GOSUB update '              show the beginning of the array items for selection
  229.  
  230.     'signal cancel selection process, exit sub with this unlikely index to signal canel
  231.     choice = -1719 'primes 7 and 8, not likely to be a select index of an array
  232.  
  233.     DO 'until get a selection or demand exit
  234.  
  235.         'handle the key stuff
  236.         kh& = _KEYHIT
  237.         IF kh& THEN
  238.             IF kh& > 0 AND kh& < 255 THEN
  239.                 IF INSTR("0123456789", CHR$(kh&)) > 0 THEN b$ = b$ + CHR$(kh&): GOSUB update
  240.                 'IF CHR$(kh&) = "h" THEN HELP: _KEYCLEAR
  241.  
  242.                 IF CHR$(kh&) = "c" THEN b$ = "": GOSUB update
  243.                 IF kh& = 13 THEN 'enter pressed check if number is being entered?
  244.                     IF LEN(b$) THEN
  245.                         IF VAL(b$) >= lba AND VAL(b$) <= uba THEN 'we have number started
  246.                             choice = VAL(b$): EXIT DO
  247.                         ELSE 'clear b$ to show some response to enter
  248.                             b$ = "": GOSUB update 'clear the value that doesn't work
  249.                         END IF
  250.                     ELSE
  251.                         choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
  252.                     END IF
  253.                 END IF
  254.                 IF kh& = 27 THEN EXIT DO 'escape clause offered to Cancel selection process
  255.                 IF kh& = 32 THEN choice = hlite + page * maxHeight + lba 'best way to choose highlighted selection
  256.                 IF kh& = 8 THEN 'backspace to edit number
  257.                     IF LEN(b$) THEN b$ = LEFT$(b$, LEN(b$) - 1): GOSUB update
  258.                 END IF
  259.             ELSE
  260.                 SELECT CASE kh& 'choosing sections of array to display and highlighted item
  261.                     CASE 20736 'pg dn
  262.                         IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  263.                     CASE 18688 'pg up
  264.                         IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  265.                     CASE 18432 'up
  266.                         IF hlite - 1 < 0 THEN
  267.                             IF page > 0 THEN
  268.                                 page = page - 1: hlite = maxHeight - 1: GOSUB update
  269.                             END IF
  270.                         ELSE
  271.                             hlite = hlite - 1: GOSUB update
  272.                         END IF
  273.                     CASE 20480 'down
  274.                         IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  275.                             IF hlite + 1 > maxHeight - 1 THEN
  276.                                 page = page + 1: hlite = 0: GOSUB update
  277.                             ELSE
  278.                                 hlite = hlite + 1: GOSUB update
  279.                             END IF
  280.                         END IF
  281.                     CASE 18176 'home
  282.                         page = 0: hlite = 0: GOSUB update
  283.                     CASE 20224 ' end
  284.                         page = INT((uba - lba) / maxHeight): hlite = maxHeight - 1: GOSUB update
  285.                 END SELECT
  286.             END IF
  287.         END IF
  288.  
  289.         'handle the mouse stuff
  290.         WHILE _MOUSEINPUT
  291.             IF _MOUSEWHEEL = -1 THEN 'up?
  292.                 IF hlite - 1 < 0 THEN
  293.                     IF page > 0 THEN
  294.                         page = page - 1: hlite = maxHeight - 1: GOSUB update
  295.                     END IF
  296.                 ELSE
  297.                     hlite = hlite - 1: GOSUB update
  298.                 END IF
  299.             ELSEIF _MOUSEWHEEL = 1 THEN 'down?
  300.                 IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  301.                     IF hlite + 1 > maxHeight - 1 THEN
  302.                         page = page + 1: hlite = 0: GOSUB update
  303.                     ELSE
  304.                         hlite = hlite + 1: GOSUB update
  305.                     END IF
  306.                 END IF
  307.             END IF
  308.         WEND
  309.         mx = INT((_MOUSEX - locateColumn * 8) / 8) + 2: my = INT((_MOUSEY - locateRow * 16) / 16) + 2
  310.         IF _MOUSEBUTTON(1) THEN 'click contols or select array item
  311.             'clear mouse clicks
  312.             mb = _MOUSEBUTTON(1)
  313.             IF mb THEN 'clear it
  314.                 WHILE mb 'OK!
  315.                     IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  316.                     _LIMIT 100
  317.                 WEND
  318.             END IF
  319.  
  320.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  321.                 choice = my + page * maxHeight + lba - 1 'select item clicked
  322.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = 0 THEN 'page up or exit
  323.                 IF my = 0 AND (mx <= maxWidth AND mx >= maxWidth - 2) THEN 'exit sign
  324.                     EXIT DO 'escape plan for mouse click top right corner of display box
  325.                 ELSE 'PgUp bar clicked
  326.                     IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  327.                 END IF
  328.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = maxHeight + 1 THEN 'page down bar clicked
  329.                 IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  330.             END IF
  331.         ELSE '   mouse over highlighting, only if mouse has moved!
  332.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  333.                 IF mx <> lastMX OR my <> lastMY THEN
  334.                     IF my - 1 <> hlite AND (my - 1 + page * maxHeight + lba <= uba) THEN
  335.                         hlite = my - 1
  336.                         lastMX = mx: lastMY = my
  337.                         GOSUB update
  338.                     END IF
  339.                 END IF
  340.             END IF
  341.         END IF
  342.         _LIMIT 200
  343.     LOOP UNTIL choice >= lba AND choice <= uba
  344.     getArrayItemNumber& = choice
  345.     COLOR fg, bg
  346.     'clear key presses
  347.     _KEYCLEAR
  348.     LOCATE curRow, curCol
  349.     'clear mouse clicks
  350.     mb = _MOUSEBUTTON(1)
  351.     IF mb THEN 'clear it
  352.         WHILE mb 'OK!
  353.             IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  354.             _LIMIT 100
  355.         WEND
  356.     END IF
  357.     EXIT SUB
  358.  
  359.     'display of array sections and controls on screen
  360.     update:
  361.  
  362.     'fix hlite if it has dropped below last array item
  363.     WHILE hlite + page * maxHeight + lba > uba
  364.         hlite = hlite - 1
  365.     WEND
  366.  
  367.     'main display of array items at page * maxHeight (lines high)
  368.     FOR row = 0 TO maxHeight - 1
  369.         IF hlite = row THEN COLOR _RGB(200, 200, 255), _RGB32(0, 0, 88) ELSE COLOR _RGB32(0, 0, 88), _RGB(200, 200, 255)
  370.         LOCATE locateRow + row, locateColumn: PRINT clrStr$
  371.         index = row + page * maxHeight + lba
  372.         IF index >= lba AND index <= uba THEN
  373.             LOCATE locateRow + row, locateColumn
  374.             PRINT LEFT$(LTRIM$(STR$(index)) + ") " + arr(index), maxWidth)
  375.         END IF
  376.     NEXT
  377.  
  378.     'make page up and down bars to click, print PgUp / PgDn if available
  379.     COLOR _RGB32(200, 200, 255), _RGB32(0, 100, 50)
  380.     LOCATE locateRow - 1, locateColumn: PRINT SPACE$(maxWidth)
  381.     IF page <> 0 THEN LOCATE locateRow - 1, locateColumn: PRINT LEFT$(" Pg Up" + SPACE$(maxWidth), maxWidth)
  382.     LOCATE locateRow + maxHeight, locateColumn: PRINT SPACE$(maxWidth)
  383.     IF page <> INT(uba / maxHeight) THEN
  384.         LOCATE locateRow + maxHeight, locateColumn: PRINT LEFT$(" Pg Dn" + SPACE$(maxWidth), maxWidth)
  385.     END IF
  386.     'make exit sign for mouse click
  387.     COLOR _RGB32(255, 255, 255), _RGB32(200, 100, 0)
  388.     LOCATE locateRow - 1, locateColumn + maxWidth - 3
  389.     PRINT " X "
  390.  
  391.     'if a number selection has been started show it's build = b$
  392.     IF LEN(b$) THEN
  393.         COLOR _RGB(255, 255, 0), _RGB32(0, 0, 0)
  394.         LOCATE locateRow + maxHeight, locateColumn + maxWidth - LEN(b$) - 1
  395.         PRINT b$;
  396.     END IF
  397.     _DISPLAY
  398.     _LIMIT 100
  399.     RETURN
  400.  
  401.  
« Last Edit: August 23, 2019, 07:48:53 pm by SierraKen »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Tiny Navigator
« Reply #4 on: August 23, 2019, 09:39:14 pm »
RE: Navigator in Ken's application

I changed the navigator part to fit your screen, when you click X or escape you are done with navigator so I send you to return to where ever it was called. I used _KEYCLEAR in case that was interfering with other code.

You loose me with all your goto's so that's on to you to get straight.

Here navigator part reworked to fit your screen:
Code: QB64: [Select]
  1. changedirectory:
  2. 'SCREEN _NEWIMAGE(1200, 600, 32)
  3. '_SCREENMOVE 100, 50
  4.  
  5.  
  6. IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp"
  7.  
  8. DIM mySelection&, done$
  9.  
  10.     PRINT "Current Directory: " + _CWD$
  11.     REDIM myFiles(0) AS STRING
  12.     loadFA "*.*", myFiles()
  13.     mySelection& = getArrayItemNumber&(5, 2, 48, 20, myFiles())
  14.     CLS
  15.     IF mySelection& <> -1719 THEN
  16.         CHDIR myFiles(mySelection&)
  17.     ELSE
  18.         _KEYCLEAR
  19.         EXIT DO
  20.         'PRINT "No Directory selected."
  21.         'INPUT "Press enter to continue navigator, any + enter to quit... "; done$
  22.     END IF
  23.     _LIMIT 60
  24. LOOP 'UNTIL done$ <> ""
  25.  
  26.  
  27.  

The warning just says we didn't use the variable passed to the sub, it's old leftovers code that hasn't been cleaned out yet, not to worry.

QB64 has _CWD$ that will give you the current directory without the library code at the start of your program.

CurrentWorkingDirectory$ = _CWD$

OPTION _EXPLICIT makes you dimension all your variables, it catches typo's, not needed when code is working OK.
« Last Edit: August 24, 2019, 09:31:02 am by bplus »

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Tiny Navigator
« Reply #5 on: August 23, 2019, 10:58:26 pm »
Thanks B+, we are getting closer! But half of it still freezes up after I choose "(3) Play Directory". It still plays the music of the directory, but the screen doesn't CLS to the next page, it just sits there as it plays the music. And it doesn't do this when I don't change the directory first with your directory code. Something really bizarre is going on. Another strange thing is, just to test it, I added an INPUT a$ after it was supposed to do CLS just to see if it got to that point, and it does! So the only logical reasoning would be that the program flies through the rest of the code and goes straight back to the front menu. The only problem is, I also removed all the GOTO's that make it go back to it, and it still does the same thing. LOL But I know it plays the music, which makes some of that area work, just not the CLS or the PRINT or LOCATE statements. I know this sounds almost like a newbie, but I've looked into this a lot and cannot find anything. But I know it has something to do with your code because like I said, if I don't change a directory, it displays everything normally. Here is the code again if you want to take a crack at it. No pressure though, this is just something I do in my spare time so if you want to move on, I understand. I'll just remove your code if you want me to and go with the original. I really wish this would work though. :) Hmm, maybe a SUB is still running in the background on a LOOP even after your menu is X'ed out?

Here is what I have:

Code: QB64: [Select]
  1. 'This program was made on August 21, 2019 by Ken G. with some help by Petr from the QB64.org forum.
  2. 'This program will make a temporary file called MyMusicFiles-Temp000.temp
  3. 'which is just a text file and can be opened by Notepad. It shows a list of
  4. 'the mp3 songs in that directory. The file is deleted once the music starts.
  5.  
  6. DECLARE LIBRARY 'Directory Information using KERNEL32 provided by Dav
  7.     FUNCTION CURDirectory ALIAS GetCurrentDirectoryA (BYVAL nBufferLen AS LONG, lpBuffer AS STRING)
  8.  
  9.  
  10. _TITLE "Mini MP3 Player"
  11. SCREEN _NEWIMAGE(400, 400, 32)
  12. begin:
  13. DIM f$(100000)
  14. record = 0
  15. rec = 0
  16. oldp = 0
  17. p = 0
  18. PRINT "                Mini MP3 Player"
  19. PRINT "                  By Ken G."
  20. '=== SHOW CURRENT DIRECTORY
  21. LOCATE 11, 1: PRINT "Directory: "; _CWD$
  22. PRINT "            (1) Change Directory"
  23. PRINT "            (2) Play Song"
  24. PRINT "            (3) Play Directory"
  25. PRINT "            (4) Quit"
  26. INPUT "      ->", a
  27. IF a = 1 THEN GOTO directory:
  28. IF a = 2 THEN GOTO song:
  29. IF a = 3 THEN GOTO playdir:
  30. IF a = 4 THEN END
  31. IF a > 4 OR a < 1 OR a <> INT(a) THEN GOTO begin:
  32. directory:
  33.  
  34. 'Here is B+'s File Navigator
  35.  
  36. GOSUB changedirectory:
  37.  
  38. 'again:
  39. 'PRINT: PRINT: PRINT
  40. 'INPUT "Directory: ", d$
  41. 'IF d$ = "" THEN GOTO begin:
  42. 'r% = _DIREXISTS(d$)
  43. 'IF r% <> -1 THEN
  44. 'PRINT "Directory doesn't exist."
  45. 'PRINT "Try again, or Enter for Menu."
  46. 'GOTO again:
  47. 'END IF
  48. 'CHDIR d$
  49.  
  50. GOTO begin:
  51. song:
  52. FILES "*.mp3"
  53. again2:
  54. INPUT "Song: ", song$
  55. IF song$ = "" THEN GOTO begin:
  56. fe% = _FILEEXISTS(song$)
  57. IF fe% <> -1 THEN
  58.     PRINT "Filename doesn't exist."
  59.     PRINT "Try again, or Enter for Menu."
  60.     GOTO again2:
  61. s& = _SNDOPEN(song$)
  62. LOCATE 1, 1: PRINT song$
  63. LOCATE 2, 1: PRINT "Sound Rate: "; _SNDRATE
  64. LOCATE 4, 1: PRINT "Length: "; INT(_SNDLEN(s&))
  65. LOCATE 6, 1: PRINT "Space Bar = Pause (P)lay (S)top (M)enu"
  66.  
  67.     a$ = INKEY$
  68.     IF a$ = CHR$(27) THEN _SNDSTOP s&: END
  69.     IF a$ = " " THEN _SNDPAUSE s&
  70.     IF a$ = "S" OR a$ = "s" THEN _SNDSTOP s&
  71.     IF a$ = "P" OR a$ = "p" THEN _SNDPLAY s&
  72.     IF a$ = "M" OR a$ = "m" THEN _SNDSTOP s&: GOTO begin:
  73.     oldp = p
  74.     p = _SNDGETPOS(s&)
  75.     LOCATE 3, 1: PRINT "Position: "; INT(p)
  76.     IF INT(oldp) > INT(p) AND INT(p) = 0 THEN GOTO begin:
  77. GOTO begin:
  78.  
  79. playdir:
  80. REDIM file(0) AS STRING 'create empty text array. 0 is record nr. 1!
  81. SHELL _HIDE "dir *.mp3 /B > MyMusicFiles-Temp000.temp" 'create mp3 files list.
  82. OPEN "MyMusicFiles-Temp000.temp" FOR INPUT AS #1
  83.     CLOSE #1
  84.     SHELL _HIDE "DEL MyMusicFiles-Temp000.temp"
  85.     CLS
  86.     PRINT "No mp3 songs on this folder."
  87.     PRINT
  88.     INPUT "Press Enter to go back to Menu.", menu$
  89.     GOTO begin:
  90.     LINE INPUT #1, file$
  91.     file(record) = file$
  92.     f$(record) = file$
  93.     PRINT f$(record)
  94.     record = record + 1 'for next loop we needed array higher up to one
  95.     REDIM _PRESERVE file(record) AS STRING 'this do array bigger without deleting content
  96. SHELL _HIDE "DEL MyMusicFiles-Temp000.temp"
  97. 'so now file(0) is first file from disk. file(3) is 4th file from disk. Try it:
  98. ready:
  99. a$ = ""
  100. p = 0
  101. oldp = 0
  102. s& = _SNDOPEN(file(rec))
  103. LOCATE 1, 1: PRINT f$(rec)
  104. LOCATE 2, 1: PRINT "Sound Rate: "; _SNDRATE
  105. LOCATE 4, 1: PRINT "Length: "; INT(_SNDLEN(s&))
  106. LOCATE 6, 1: PRINT "Space Bar = Pause (P)lay (N)ext Song (M)enu"
  107.     a$ = INKEY$
  108.     IF a$ = CHR$(27) THEN _SNDSTOP s&: END
  109.     IF a$ = " " THEN _SNDPAUSE s&
  110.     IF a$ = "N" OR a$ = "n" THEN _SNDSTOP s&
  111.     IF a$ = "P" OR a$ = "p" THEN _SNDPLAY s&
  112.     IF a$ = "M" OR a$ = "m" THEN _SNDSTOP s&: rec = 0: GOTO begin:
  113.     oldp = p
  114.     p = _SNDGETPOS(s&)
  115.     LOCATE 3, 1: PRINT "Position: "; INT(p)
  116.     IF INT(oldp) > INT(p) AND INT(p) = 0 THEN GOTO more:
  117. more:
  118. IF rec = record - 1 THEN GOTO begin:
  119. rec = rec + 1
  120. GOTO ready:
  121. 'OPTION _EXPLICIT
  122. '_TITLE "Tiny Navigator mod orig post with perm tmpfile" 'B+
  123. ' 2019-08-22 orig post at https://www.qb64.org/forum/index.php?topic=1646.msg108682#msg108682
  124. ' 2019-08-23 try fix (to nav all directories) with one place for tmpFile, theory can't write files in some dir's
  125. ' For some reason Windows won't write to a fully pathed file in my user folder???
  126. ' Try testing if dir exists "C:\temp" exists and making one if not, yes! and I can write my temp files there
  127. ' and now I can chDir anywhere!
  128.  
  129. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  130.  
  131. ' Attention!!!  this creates a temp directory "C:\temp", do not run this program if you forbid this.
  132.  
  133. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  134.  
  135. changedirectory:
  136. 'SCREEN _NEWIMAGE(1200, 600, 32)
  137. '_SCREENMOVE 100, 50
  138.  
  139.  
  140. IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp"
  141.  
  142. DIM mySelection&, done$
  143.  
  144.     PRINT "Current Directory: " + _CWD$
  145.     REDIM myFiles(0) AS STRING
  146.     loadFA "*.*", myFiles()
  147.     mySelection& = getArrayItemNumber&(5, 2, 48, 20, myFiles())
  148.     CLS
  149.     IF mySelection& <> -1719 THEN
  150.         CHDIR myFiles(mySelection&)
  151.     ELSE
  152.         _KEYCLEAR
  153.         EXIT DO
  154.     END IF
  155.     _LIMIT 60
  156. LOOP 'UNTIL done$ <> ""
  157.  
  158.  
  159. SUB loadFA (spec$, fa() AS STRING)
  160.     DIM tmpFile$, Index%, fline$, d$
  161.     tmpFile$ = "C:\temp\DIR$INF0.INF"
  162.     'PRINT tmpFile$
  163.     'END
  164.     SHELL _HIDE "DIR /a:d >" + tmpFile$ 'get directories  but have to do a little pruning
  165.     'SHELL _HIDE "DIR " + spec$ + " /b > " + TmpFile$
  166.     'SHELL _HIDE "DIR " + spec$ + " /b /s /o:gen> " + TmpFile$
  167.     OPEN tmpFile$ FOR INPUT AS #1
  168.     Index% = -1
  169.     DO WHILE NOT EOF(1)
  170.         LINE INPUT #1, fline$
  171.         IF INSTR(fline$, "<DIR>") THEN
  172.             d$ = _TRIM$(rightOf$(fline$, "<DIR>"))
  173.             Index% = Index% + 1
  174.             REDIM _PRESERVE fa(Index%)
  175.             fa(Index%) = d$
  176.         END IF
  177.     LOOP
  178.     CLOSE #1
  179.     KILL tmpFile$
  180.  
  181. FUNCTION rightOf$ (source$, of$)
  182.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
  183.  
  184. 'attempting use this 4 things (2018-12-30)
  185. ' 1. expects HELP sub that uses message and message box but easy to comment out
  186. ' 2. expects to be in graphics mode
  187. ' 3. chages color of screen
  188. ' 4. needs _KEYCLEAR 2 before calling of previous keyhits will interfere!!!
  189. '
  190. ' Future Help Message Box for the function.
  191. ' "*** Mouse and Key Instructions ***"
  192. '
  193. ' "Mouse, mouse wheel, and arrow keys should work as expected for item selection."
  194. ' "Press spacebar to select a highlighted item or just click it."
  195. ' "Use number(s) + enter to select an array item by it's index number,"
  196. ' "backspace will remove last number pressed, c will clear a number started."
  197. ' "Numbers started are shown in bottom right PgDn bar."
  198. ' "Enter will also select the highlighted item, if no number has been started."
  199. ' "Home starts you at lowest array index, End highlights then highest index."
  200. ' "Use PgUp and PgDn keys to flip through pages of array items."
  201. '
  202. ' "Escape returns -1719 to allow a Cancel function and signal no slection."
  203. FUNCTION getArrayItemNumber& (locateRow, locateColumn, boxWidth, boxHeight, arr() AS STRING)
  204.     'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
  205.     'boxWidth and boxHeight are in character units, again for locate and print at correct places.
  206.     'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.
  207.  
  208.     DIM curRow AS INTEGER, curCol AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
  209.     DIM maxWidth AS INTEGER, maxHeight AS INTEGER, page AS INTEGER, hlite AS INTEGER, mx AS INTEGER, my AS INTEGER
  210.     DIM lastMX AS INTEGER, lastMY AS INTEGER, row AS INTEGER, mb AS INTEGER
  211.     DIM lba AS LONG, uba AS LONG, choice AS LONG, kh AS LONG, index AS LONG
  212.     DIM clrStr AS STRING, b AS STRING
  213.  
  214.     'save old settings to restore at end ofsub
  215.     curRow = CSRLIN
  216.     curCol = POS(0)
  217.     fg = _DEFAULTCOLOR
  218.     bg = _BACKGROUNDCOLOR
  219.     _KEYCLEAR
  220.  
  221.     maxWidth = boxWidth '       number of characters in box
  222.     maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
  223.     lba = LBOUND(arr)
  224.     uba = UBOUND(arr)
  225.     page = 0
  226.     hlite = 0 '                 line in display ready for selection by spacebar or if no number is started, enter
  227.     clrStr$ = SPACE$(maxWidth) 'clearing a display line
  228.  
  229.     GOSUB update '              show the beginning of the array items for selection
  230.  
  231.     'signal cancel selection process, exit sub with this unlikely index to signal canel
  232.     choice = -1719 'primes 7 and 8, not likely to be a select index of an array
  233.  
  234.     DO 'until get a selection or demand exit
  235.  
  236.         'handle the key stuff
  237.         kh& = _KEYHIT
  238.         IF kh& THEN
  239.             IF kh& > 0 AND kh& < 255 THEN
  240.                 IF INSTR("0123456789", CHR$(kh&)) > 0 THEN b$ = b$ + CHR$(kh&): GOSUB update
  241.                 'IF CHR$(kh&) = "h" THEN HELP: _KEYCLEAR
  242.  
  243.                 IF CHR$(kh&) = "c" THEN b$ = "": GOSUB update
  244.                 IF kh& = 13 THEN 'enter pressed check if number is being entered?
  245.                     IF LEN(b$) THEN
  246.                         IF VAL(b$) >= lba AND VAL(b$) <= uba THEN 'we have number started
  247.                             choice = VAL(b$): EXIT DO
  248.                         ELSE 'clear b$ to show some response to enter
  249.                             b$ = "": GOSUB update 'clear the value that doesn't work
  250.                         END IF
  251.                     ELSE
  252.                         choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
  253.                     END IF
  254.                 END IF
  255.                 IF kh& = 27 THEN EXIT DO 'escape clause offered to Cancel selection process
  256.                 IF kh& = 32 THEN choice = hlite + page * maxHeight + lba 'best way to choose highlighted selection
  257.                 IF kh& = 8 THEN 'backspace to edit number
  258.                     IF LEN(b$) THEN b$ = LEFT$(b$, LEN(b$) - 1): GOSUB update
  259.                 END IF
  260.             ELSE
  261.                 SELECT CASE kh& 'choosing sections of array to display and highlighted item
  262.                     CASE 20736 'pg dn
  263.                         IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  264.                     CASE 18688 'pg up
  265.                         IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  266.                     CASE 18432 'up
  267.                         IF hlite - 1 < 0 THEN
  268.                             IF page > 0 THEN
  269.                                 page = page - 1: hlite = maxHeight - 1: GOSUB update
  270.                             END IF
  271.                         ELSE
  272.                             hlite = hlite - 1: GOSUB update
  273.                         END IF
  274.                     CASE 20480 'down
  275.                         IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  276.                             IF hlite + 1 > maxHeight - 1 THEN
  277.                                 page = page + 1: hlite = 0: GOSUB update
  278.                             ELSE
  279.                                 hlite = hlite + 1: GOSUB update
  280.                             END IF
  281.                         END IF
  282.                     CASE 18176 'home
  283.                         page = 0: hlite = 0: GOSUB update
  284.                     CASE 20224 ' end
  285.                         page = INT((uba - lba) / maxHeight): hlite = maxHeight - 1: GOSUB update
  286.                 END SELECT
  287.             END IF
  288.         END IF
  289.  
  290.         'handle the mouse stuff
  291.         WHILE _MOUSEINPUT
  292.             IF _MOUSEWHEEL = -1 THEN 'up?
  293.                 IF hlite - 1 < 0 THEN
  294.                     IF page > 0 THEN
  295.                         page = page - 1: hlite = maxHeight - 1: GOSUB update
  296.                     END IF
  297.                 ELSE
  298.                     hlite = hlite - 1: GOSUB update
  299.                 END IF
  300.             ELSEIF _MOUSEWHEEL = 1 THEN 'down?
  301.                 IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  302.                     IF hlite + 1 > maxHeight - 1 THEN
  303.                         page = page + 1: hlite = 0: GOSUB update
  304.                     ELSE
  305.                         hlite = hlite + 1: GOSUB update
  306.                     END IF
  307.                 END IF
  308.             END IF
  309.         WEND
  310.         mx = INT((_MOUSEX - locateColumn * 8) / 8) + 2: my = INT((_MOUSEY - locateRow * 16) / 16) + 2
  311.         IF _MOUSEBUTTON(1) THEN 'click contols or select array item
  312.             'clear mouse clicks
  313.             mb = _MOUSEBUTTON(1)
  314.             IF mb THEN 'clear it
  315.                 WHILE mb 'OK!
  316.                     IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  317.                     _LIMIT 100
  318.                 WEND
  319.             END IF
  320.  
  321.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  322.                 choice = my + page * maxHeight + lba - 1 'select item clicked
  323.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = 0 THEN 'page up or exit
  324.                 IF my = 0 AND (mx <= maxWidth AND mx >= maxWidth - 2) THEN 'exit sign
  325.                     EXIT DO 'escape plan for mouse click top right corner of display box
  326.                 ELSE 'PgUp bar clicked
  327.                     IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  328.                 END IF
  329.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = maxHeight + 1 THEN 'page down bar clicked
  330.                 IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  331.             END IF
  332.         ELSE '   mouse over highlighting, only if mouse has moved!
  333.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  334.                 IF mx <> lastMX OR my <> lastMY THEN
  335.                     IF my - 1 <> hlite AND (my - 1 + page * maxHeight + lba <= uba) THEN
  336.                         hlite = my - 1
  337.                         lastMX = mx: lastMY = my
  338.                         GOSUB update
  339.                     END IF
  340.                 END IF
  341.             END IF
  342.         END IF
  343.         _LIMIT 200
  344.     LOOP UNTIL choice >= lba AND choice <= uba
  345.     getArrayItemNumber& = choice
  346.     COLOR fg, bg
  347.     'clear key presses
  348.     _KEYCLEAR
  349.     LOCATE curRow, curCol
  350.     'clear mouse clicks
  351.     mb = _MOUSEBUTTON(1)
  352.     IF mb THEN 'clear it
  353.         WHILE mb 'OK!
  354.             IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  355.             _LIMIT 100
  356.         WEND
  357.     END IF
  358.     EXIT SUB
  359.  
  360.     'display of array sections and controls on screen
  361.     update:
  362.  
  363.     'fix hlite if it has dropped below last array item
  364.     WHILE hlite + page * maxHeight + lba > uba
  365.         hlite = hlite - 1
  366.     WEND
  367.  
  368.     'main display of array items at page * maxHeight (lines high)
  369.     FOR row = 0 TO maxHeight - 1
  370.         IF hlite = row THEN COLOR _RGB(200, 200, 255), _RGB32(0, 0, 88) ELSE COLOR _RGB32(0, 0, 88), _RGB(200, 200, 255)
  371.         LOCATE locateRow + row, locateColumn: PRINT clrStr$
  372.         index = row + page * maxHeight + lba
  373.         IF index >= lba AND index <= uba THEN
  374.             LOCATE locateRow + row, locateColumn
  375.             PRINT LEFT$(LTRIM$(STR$(index)) + ") " + arr(index), maxWidth)
  376.         END IF
  377.     NEXT
  378.  
  379.     'make page up and down bars to click, print PgUp / PgDn if available
  380.     COLOR _RGB32(200, 200, 255), _RGB32(0, 100, 50)
  381.     LOCATE locateRow - 1, locateColumn: PRINT SPACE$(maxWidth)
  382.     IF page <> 0 THEN LOCATE locateRow - 1, locateColumn: PRINT LEFT$(" Pg Up" + SPACE$(maxWidth), maxWidth)
  383.     LOCATE locateRow + maxHeight, locateColumn: PRINT SPACE$(maxWidth)
  384.     IF page <> INT(uba / maxHeight) THEN
  385.         LOCATE locateRow + maxHeight, locateColumn: PRINT LEFT$(" Pg Dn" + SPACE$(maxWidth), maxWidth)
  386.     END IF
  387.     'make exit sign for mouse click
  388.     COLOR _RGB32(255, 255, 255), _RGB32(200, 100, 0)
  389.     LOCATE locateRow - 1, locateColumn + maxWidth - 3
  390.     PRINT " X "
  391.  
  392.     'if a number selection has been started show it's build = b$
  393.     IF LEN(b$) THEN
  394.         COLOR _RGB(255, 255, 0), _RGB32(0, 0, 0)
  395.         LOCATE locateRow + maxHeight, locateColumn + maxWidth - LEN(b$) - 1
  396.         PRINT b$;
  397.     END IF
  398.     _DISPLAY
  399.     _LIMIT 100
  400.     RETURN
  401.  
  402.  
« Last Edit: August 23, 2019, 11:02:19 pm by SierraKen »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Tiny Navigator
« Reply #6 on: August 23, 2019, 11:33:09 pm »
Hi Ken,

For simplicity sake, why not make each menu item that does something a gosub you select a menu item do the sub and you cycle back to the menu which should be in a loop:

Do
    cls
    print menu
    get a choice
    gosub the choice '<<< it returns here to loop back around to show menu again
loop

if the choice is not on menu, it would cycle back automatic.

Now all you have to do is make sure all your GOSUBs are tight and not leaking goto's to goodness knows where...

I will look at code again tomorrow when fresh but right now I suspect one of your goto's is leaking, I am pretty sure the navigator sub does not leak, but I've certainly been wrong before! I have to say, I don't like that library sub routine when you already have _CWD$.

PS when I say leak I mean the execution falls through down to the last code in program, namely my Navigator. Oh say, try putting an END statement before the Gosub label of Navigator, that will catch anything falling through and end program. Oh and put an end before the silly goto that tells execution to gosub the navigator too.

Update: Yes put an end between 39 and 40, because the execution could fall through there but it does look like all bases covered??
« Last Edit: August 23, 2019, 11:55:27 pm by bplus »

Marked as best answer by bplus on August 24, 2019, 04:44:07 am

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Tiny Navigator
« Reply #7 on: August 23, 2019, 11:46:12 pm »
I have Tiny Navigator working with 2nd Files window for selecting files, just press f when you are in the desired directory, f will also get you the full files report for the directory you can scroll through and browse.

Code: QB64: [Select]
  1. _TITLE "Tiny Navigator: press f to window and select a file" 'B+ started 2019-08-22
  2. SCREEN _NEWIMAGE(1000, 600, 32)
  3. _SCREENMOVE 100, 50
  4. ' 2019-08-22 orig post at https://www.qb64.org/forum/index.php?topic=1646.msg108682#msg108682
  5. ' 2019-08-23_13-25 try fix (to nav all directories) with one place for tmpFile, theory can't write files in some dir's
  6. ' For some reason Windows won't write to a fully pathed file in my user folder???from a SHELL command
  7. ' Try testing if dir exists "C:\temp" exists and making one if not, yes! and I can write my temp files there
  8. ' and now I can chDir anywhere!!!!
  9. ' 2019-08-23_14-25 Take Steve's Advice to use users tmp directory for temp files
  10. ' 2019-08-23_23+ Have files window working for file selection
  11.  
  12. DIM SHARED selectedFile AS STRING
  13. DIM SHARED tmpDir AS STRING '  establish a permanent spot for temp files
  14. IF ENVIRON$("TEMP") <> "" THEN 'Thanks to Steve McNeill use user temp files directory
  15.     tmpDir = ENVIRON$("TEMP")
  16. ELSEIF ENVIRON$("TMP") <> "" THEN
  17.     tmpDir = ENVIRON$("TMP")
  18. ELSE 'Thanks to Steve McNeill this should be very unlikely
  19.     IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp"
  20.     tmpDir = "C:\temp"
  21.  
  22. DIM mySelection&, done$, i, t$
  23.     COLOR _RGB32(180, 180, 255)
  24.     CLS
  25.     t$ = "Current Directory: " + _CWD$
  26.     LOCATE 2, (_WIDTH / 8 - LEN(t$)) / 2: PRINT t$
  27.     REDIM DIRs(0) AS STRING
  28.     loadDIR DIRs()
  29.     REDIM FILs(0) AS STRING
  30.     loadFiles FILs()
  31.     FOR i = 0 TO UBOUND(FILs)
  32.         IF i < 30 THEN LOCATE i + 4, 60: PRINT FILs(i) ELSE EXIT FOR
  33.     NEXT
  34.     mySelection& = getArrayItemNumber&(5, 5, 50, 30, DIRs())
  35.     CLS
  36.     IF selectedFile <> "" THEN
  37.         PRINT "You selected a file: "; selectedFile
  38.         INPUT "Press enter to continue navigator, any + enter to quit... "; done$
  39.         selectedFile = ""
  40.     ELSEIF mySelection& <> -1719 THEN
  41.         CHDIR DIRs(mySelection&)
  42.     ELSE
  43.         PRINT "Nothing selected."
  44.         INPUT "Press enter to continue navigator, any + enter to quit... "; done$
  45.     END IF
  46.     _LIMIT 60
  47. LOOP UNTIL done$ <> ""
  48.  
  49. SUB loadDIR (fa() AS STRING)
  50.     DIM tmpFile AS STRING, Index%, fline$, d$
  51.     tmpFile = tmpDir + "\DIR$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
  52.     SHELL _HIDE "DIR /a:d >" + tmpFile 'get directories  but have to do a little pruning
  53.     OPEN tmpFile FOR INPUT AS #1
  54.     Index% = -1
  55.     DO WHILE NOT EOF(1)
  56.         LINE INPUT #1, fline$
  57.         IF INSTR(fline$, "<DIR>") THEN
  58.             d$ = _TRIM$(rightOf$(fline$, "<DIR>"))
  59.             Index% = Index% + 1
  60.             REDIM _PRESERVE fa(Index%)
  61.             fa(Index%) = d$
  62.         END IF
  63.     LOOP
  64.     CLOSE #1
  65.     KILL tmpFile
  66.  
  67. SUB loadFiles (fa() AS STRING)
  68.     DIM tmpFile AS STRING, Index%
  69.     tmpFile = tmpDir + "\FILE$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
  70.     SHELL _HIDE "DIR *.* /a:-d /b /o:-gen > " + tmpFile
  71.     OPEN tmpFile$ FOR INPUT AS #1
  72.     Index% = -1
  73.     DO WHILE NOT EOF(1)
  74.         Index% = Index% + 1
  75.         REDIM _PRESERVE fa(Index%) AS STRING
  76.         LINE INPUT #1, fa(Index%)
  77.     LOOP
  78.     CLOSE #1
  79.     KILL tmpFile$
  80.  
  81. FUNCTION rightOf$ (source$, of$)
  82.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
  83.  
  84. ' "Escape returns -1719 to allow a Cancel function and signal no slection."
  85. FUNCTION getArrayItemNumber& (locateRow, locateColumn, boxWidth, boxHeight, arr() AS STRING)
  86.     'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
  87.     'boxWidth and boxHeight are in character units, again for locate and print at correct places.
  88.     'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.
  89.  
  90.     DIM curRow AS INTEGER, curCol AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
  91.     DIM maxWidth AS INTEGER, maxHeight AS INTEGER, page AS INTEGER, hlite AS INTEGER, mx AS INTEGER, my AS INTEGER
  92.     DIM lastMX AS INTEGER, lastMY AS INTEGER, row AS INTEGER, mb AS INTEGER
  93.     DIM lba AS LONG, uba AS LONG, choice AS LONG, kh AS LONG, index AS LONG
  94.     DIM clrStr AS STRING, b AS STRING, selNum&
  95.  
  96.     'save old settings to restore at end ofsub
  97.     curRow = CSRLIN
  98.     curCol = POS(0)
  99.     fg = _DEFAULTCOLOR
  100.     bg = _BACKGROUNDCOLOR
  101.     _KEYCLEAR
  102.  
  103.     maxWidth = boxWidth '       number of characters in box
  104.     maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
  105.     lba = LBOUND(arr)
  106.     uba = UBOUND(arr)
  107.     page = 0
  108.     hlite = 0 '                 line in display ready for selection by spacebar or if no number is started, enter
  109.     clrStr$ = SPACE$(maxWidth) 'clearing a display line
  110.  
  111.     GOSUB update '              show the beginning of the array items for selection
  112.  
  113.     'signal cancel selection process, exit sub with this unlikely index to signal canel
  114.     choice = -1719 'primes 7 and 8, not likely to be a select index of an array
  115.  
  116.     DO 'until get a selection or demand exit
  117.  
  118.         'handle the key stuff
  119.         kh& = _KEYHIT
  120.         IF kh& THEN
  121.             IF kh& > 0 AND kh& < 255 THEN
  122.                 IF INSTR("0123456789", CHR$(kh&)) > 0 THEN b$ = b$ + CHR$(kh&): GOSUB update
  123.                 IF CHR$(kh&) = "f" THEN
  124.                     REDIM FILs(0) AS STRING
  125.                     loadFiles FILs()
  126.                     selNum& = getArrayItemNumber&(5, 60, 60, 30, FILs())
  127.                     COLOR _RGB32(180, 180, 255)
  128.                     CLS 'need to signal out of file selection
  129.                     IF selNum& >= LBOUND(FILs) AND selNum& <= UBOUND(FILs) THEN selectedFile = FILs(selNum&)
  130.                     EXIT DO
  131.                     'back to directory select
  132.                 END IF
  133.  
  134.                 IF CHR$(kh&) = "c" THEN b$ = "": GOSUB update
  135.                 IF kh& = 13 THEN 'enter pressed check if number is being entered?
  136.                     IF LEN(b$) THEN
  137.                         IF VAL(b$) >= lba AND VAL(b$) <= uba THEN 'we have number started
  138.                             choice = VAL(b$): EXIT DO
  139.                         ELSE 'clear b$ to show some response to enter
  140.                             b$ = "": GOSUB update 'clear the value that doesn't work
  141.                         END IF
  142.                     ELSE
  143.                         choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
  144.                     END IF
  145.                 END IF
  146.                 IF kh& = 27 THEN EXIT DO 'escape clause offered to Cancel selection process
  147.                 IF kh& = 32 THEN choice = hlite + page * maxHeight + lba 'best way to choose highlighted selection
  148.                 IF kh& = 8 THEN 'backspace to edit number
  149.                     IF LEN(b$) THEN b$ = LEFT$(b$, LEN(b$) - 1): GOSUB update
  150.                 END IF
  151.             ELSE
  152.                 SELECT CASE kh& 'choosing sections of array to display and highlighted item
  153.                     CASE 20736 'pg dn
  154.                         IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  155.                     CASE 18688 'pg up
  156.                         IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  157.                     CASE 18432 'up
  158.                         IF hlite - 1 < 0 THEN
  159.                             IF page > 0 THEN
  160.                                 page = page - 1: hlite = maxHeight - 1: GOSUB update
  161.                             END IF
  162.                         ELSE
  163.                             hlite = hlite - 1: GOSUB update
  164.                         END IF
  165.                     CASE 20480 'down
  166.                         IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  167.                             IF hlite + 1 > maxHeight - 1 THEN
  168.                                 page = page + 1: hlite = 0: GOSUB update
  169.                             ELSE
  170.                                 hlite = hlite + 1: GOSUB update
  171.                             END IF
  172.                         END IF
  173.                     CASE 18176 'home
  174.                         page = 0: hlite = 0: GOSUB update
  175.                     CASE 20224 ' end
  176.                         page = INT((uba - lba) / maxHeight): hlite = maxHeight - 1: GOSUB update
  177.                 END SELECT
  178.             END IF
  179.         END IF
  180.  
  181.         'handle the mouse stuff
  182.         WHILE _MOUSEINPUT
  183.             IF _MOUSEWHEEL = -1 THEN 'up?
  184.                 IF hlite - 1 < 0 THEN
  185.                     IF page > 0 THEN
  186.                         page = page - 1: hlite = maxHeight - 1: GOSUB update
  187.                     END IF
  188.                 ELSE
  189.                     hlite = hlite - 1: GOSUB update
  190.                 END IF
  191.             ELSEIF _MOUSEWHEEL = 1 THEN 'down?
  192.                 IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  193.                     IF hlite + 1 > maxHeight - 1 THEN
  194.                         page = page + 1: hlite = 0: GOSUB update
  195.                     ELSE
  196.                         hlite = hlite + 1: GOSUB update
  197.                     END IF
  198.                 END IF
  199.             END IF
  200.         WEND
  201.         mx = INT((_MOUSEX - locateColumn * 8) / 8) + 2: my = INT((_MOUSEY - locateRow * 16) / 16) + 2
  202.         IF _MOUSEBUTTON(1) THEN 'click contols or select array item
  203.             'clear mouse clicks
  204.             mb = _MOUSEBUTTON(1)
  205.             IF mb THEN 'clear it
  206.                 WHILE mb 'OK!
  207.                     IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  208.                     _LIMIT 100
  209.                 WEND
  210.             END IF
  211.  
  212.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  213.                 choice = my + page * maxHeight + lba - 1 'select item clicked
  214.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = 0 THEN 'page up or exit
  215.                 IF my = 0 AND (mx <= maxWidth AND mx >= maxWidth - 2) THEN 'exit sign
  216.                     EXIT DO 'escape plan for mouse click top right corner of display box
  217.                 ELSE 'PgUp bar clicked
  218.                     IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  219.                 END IF
  220.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = maxHeight + 1 THEN 'page down bar clicked
  221.                 IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  222.             END IF
  223.         ELSE '   mouse over highlighting, only if mouse has moved!
  224.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  225.                 IF mx <> lastMX OR my <> lastMY THEN
  226.                     IF my - 1 <> hlite AND (my - 1 + page * maxHeight + lba <= uba) THEN
  227.                         hlite = my - 1
  228.                         lastMX = mx: lastMY = my
  229.                         GOSUB update
  230.                     END IF
  231.                 END IF
  232.             END IF
  233.         END IF
  234.         _LIMIT 200
  235.     LOOP UNTIL choice >= lba AND choice <= uba
  236.     getArrayItemNumber& = choice
  237.     COLOR fg, bg
  238.     'clear key presses
  239.     _KEYCLEAR
  240.     LOCATE curRow, curCol
  241.     'clear mouse clicks
  242.     mb = _MOUSEBUTTON(1)
  243.     IF mb THEN 'clear it
  244.         WHILE mb 'OK!
  245.             IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  246.             _LIMIT 100
  247.         WEND
  248.     END IF
  249.     EXIT SUB
  250.  
  251.  
  252.     update: '--------------- display of array sections and controls on screen
  253.  
  254.     'fix hlite if it has dropped below last array item
  255.     WHILE hlite + page * maxHeight + lba > uba
  256.         hlite = hlite - 1
  257.     WEND
  258.  
  259.     'main display of array items at page * maxHeight (lines high)
  260.     FOR row = 0 TO maxHeight - 1
  261.         IF hlite = row THEN COLOR _RGB(200, 200, 255), _RGB32(0, 0, 88) ELSE COLOR _RGB32(0, 0, 88), _RGB(200, 200, 255)
  262.         LOCATE locateRow + row, locateColumn: PRINT clrStr$
  263.         index = row + page * maxHeight + lba
  264.         IF index >= lba AND index <= uba THEN
  265.             LOCATE locateRow + row, locateColumn
  266.             PRINT LEFT$(LTRIM$(STR$(index)) + ") " + arr(index), maxWidth)
  267.         END IF
  268.     NEXT
  269.  
  270.     'make page up and down bars to click, print PgUp / PgDn if available
  271.     COLOR _RGB32(200, 200, 255), _RGB32(0, 100, 50)
  272.     LOCATE locateRow - 1, locateColumn: PRINT SPACE$(maxWidth)
  273.     IF page <> 0 THEN LOCATE locateRow - 1, locateColumn: PRINT LEFT$(" Pg Up" + SPACE$(maxWidth), maxWidth)
  274.     LOCATE locateRow + maxHeight, locateColumn: PRINT SPACE$(maxWidth)
  275.     IF page <> INT(uba / maxHeight) THEN
  276.         LOCATE locateRow + maxHeight, locateColumn: PRINT LEFT$(" Pg Dn" + SPACE$(maxWidth), maxWidth)
  277.     END IF
  278.     'make exit sign for mouse click
  279.     COLOR _RGB32(255, 255, 255), _RGB32(200, 100, 0)
  280.     LOCATE locateRow - 1, locateColumn + maxWidth - 3
  281.     PRINT " X "
  282.  
  283.     'if a number selection has been started show it's build = b$
  284.     IF LEN(b$) THEN
  285.         COLOR _RGB(255, 255, 0), _RGB32(0, 0, 0)
  286.         LOCATE locateRow + maxHeight, locateColumn + maxWidth - LEN(b$) - 1
  287.         PRINT b$;
  288.     END IF
  289.     _DISPLAY
  290.     _LIMIT 100
  291.     RETURN
  292.  
  293.  

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Tiny Navigator
« Reply #8 on: August 24, 2019, 12:05:49 am »
That's cool about the Files one! I'll look into that one after I get the directory one fixed. I changed the code like I said, to use DO/LOOP for the main menu and GOSUB/RETURN for each selection. Still doesn't work. I tried END at the end of the code you gave me (before the RETURN back to the main menu) and it just ends the program after I select a directory. I already know the program can get to the area of the program I want it to be at, and it still plays the music there. But for some reason it doesn't CLS and go to another screen to PRINT things I want people to see about the songs it plays. It just sits there at the main menu playing the songs. lol And like I said, without changing the directory with the change directory code, and just playing the default directory, everything shows up fine as the sounds play. So there must be something in a SUB somewhere freezing up the flow of the program. That's all I can imagine, but you know more than I do. Oh, thanks for telling me about that library, I deleted it. This version should be easier for you to follow:

(Note, a little bit of a better one is after this one.)

Code: QB64: [Select]
  1. 'This program was made on August 23, 2019 by Ken G. with lots of help by B+ and Petr from the QB64.org forum.
  2. 'This program will make a temporary file called MyMusicFiles-Temp000.temp
  3. 'which is just a text file and can be opened by Notepad. It shows a list of
  4. 'the mp3 songs in that directory. The file is deleted once the music starts.
  5.  
  6. _TITLE "Mini MP3 Player"
  7. SCREEN _NEWIMAGE(400, 400, 32)
  8. begin:
  9.     DIM f$(100000)
  10.     record = 0
  11.     rec = 0
  12.     oldp = 0
  13.     p = 0
  14.     CLS
  15.     PRINT: PRINT: PRINT
  16.     PRINT "                Mini MP3 Player"
  17.     PRINT: PRINT: PRINT
  18.     PRINT "                  By Ken G."
  19.     PRINT
  20.     LOCATE 11, 1: PRINT "Directory: "; _CWD$
  21.     PRINT: PRINT
  22.     PRINT "            (1) Change Directory"
  23.     PRINT "            (2) Play Song"
  24.     PRINT "            (3) Play Directory"
  25.     PRINT "            (4) Quit"
  26.     PRINT
  27.     PRINT
  28.     INPUT "      ->", a
  29.     IF a = 1 THEN GOSUB changedirectory:
  30.     IF a = 2 THEN GOSUB song:
  31.     IF a = 3 THEN GOSUB playdir:
  32.     IF a = 4 THEN END
  33.  
  34. 'Play One Song Here
  35.  
  36. song:
  37. FILES "*.mp3"
  38. again2:
  39. INPUT "Song: ", song$
  40. IF song$ = "" THEN GOTO begin:
  41. fe% = _FILEEXISTS(song$)
  42. IF fe% <> -1 THEN
  43.     PRINT "Filename doesn't exist."
  44.     PRINT "Try again, or Enter for Menu."
  45.     GOTO again2:
  46. s& = _SNDOPEN(song$)
  47. LOCATE 1, 1: PRINT song$
  48. LOCATE 2, 1: PRINT "Sound Rate: "; _SNDRATE
  49. LOCATE 4, 1: PRINT "Length: "; INT(_SNDLEN(s&))
  50. LOCATE 6, 1: PRINT "Space Bar = Pause (P)lay (S)top (M)enu"
  51.  
  52.     a$ = INKEY$
  53.     IF a$ = CHR$(27) THEN _SNDSTOP s&: END
  54.     IF a$ = " " THEN _SNDPAUSE s&
  55.     IF a$ = "S" OR a$ = "s" THEN _SNDSTOP s&
  56.     IF a$ = "P" OR a$ = "p" THEN _SNDPLAY s&
  57.     IF a$ = "M" OR a$ = "m" THEN _SNDSTOP s&: GOTO begin:
  58.     oldp = p
  59.     p = _SNDGETPOS(s&)
  60.     LOCATE 3, 1: PRINT "Position: "; INT(p)
  61.     IF INT(oldp) > INT(p) AND INT(p) = 0 THEN GOTO begin:
  62.  
  63. 'Play Directory Here
  64.  
  65. playdir:
  66. REDIM file(0) AS STRING 'create empty text array. 0 is record nr. 1!
  67. SHELL _HIDE "dir *.mp3 /B > MyMusicFiles-Temp000.temp" 'create mp3 files list.
  68. OPEN "MyMusicFiles-Temp000.temp" FOR INPUT AS #1
  69.     CLOSE #1
  70.     SHELL _HIDE "DEL MyMusicFiles-Temp000.temp"
  71.     CLS
  72.     PRINT "No mp3 songs on this folder."
  73.     PRINT
  74.     INPUT "Press Enter to go back to Menu.", menu$
  75.     GOTO begin:
  76.     LINE INPUT #1, file$
  77.     file(record) = file$
  78.     f$(record) = file$
  79.     PRINT f$(record)
  80.     record = record + 1 'for next loop we needed array higher up to one
  81.     REDIM _PRESERVE file(record) AS STRING 'this do array bigger without deleting content
  82. SHELL _HIDE "DEL MyMusicFiles-Temp000.temp"
  83. 'so now file(0) is first file from disk. file(3) is 4th file from disk. Try it:
  84. ready:
  85. a$ = ""
  86. p = 0
  87. oldp = 0
  88. s& = _SNDOPEN(file(rec))
  89. LOCATE 1, 1: PRINT f$(rec)
  90. LOCATE 2, 1: PRINT "Sound Rate: "; _SNDRATE
  91. LOCATE 4, 1: PRINT "Length: "; INT(_SNDLEN(s&))
  92. LOCATE 6, 1: PRINT "Space Bar = Pause (P)lay (N)ext Song (M)enu"
  93.     a$ = INKEY$
  94.     IF a$ = CHR$(27) THEN _SNDSTOP s&: END
  95.     IF a$ = " " THEN _SNDPAUSE s&
  96.     IF a$ = "N" OR a$ = "n" THEN _SNDSTOP s&
  97.     IF a$ = "P" OR a$ = "p" THEN _SNDPLAY s&
  98.     IF a$ = "M" OR a$ = "m" THEN _SNDSTOP s&: rec = 0: RETURN
  99.     oldp = p
  100.     p = _SNDGETPOS(s&)
  101.     LOCATE 3, 1: PRINT "Position: "; INT(p)
  102.     IF INT(oldp) > INT(p) AND INT(p) = 0 THEN GOTO more:
  103. more:
  104. IF rec = record - 1 THEN RETURN
  105. rec = rec + 1
  106. GOTO ready:
  107. 'OPTION _EXPLICIT
  108. '_TITLE "Tiny Navigator mod orig post with perm tmpfile" 'B+
  109. ' 2019-08-22 orig post at https://www.qb64.org/forum/index.php?topic=1646.msg108682#msg108682
  110. ' 2019-08-23 try fix (to nav all directories) with one place for tmpFile, theory can't write files in some dir's
  111. ' For some reason Windows won't write to a fully pathed file in my user folder???
  112. ' Try testing if dir exists "C:\temp" exists and making one if not, yes! and I can write my temp files there
  113. ' and now I can chDir anywhere!
  114.  
  115. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  116.  
  117. ' Attention!!!  this creates a temp directory "C:\temp", do not run this program if you forbid this.
  118.  
  119. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  120.  
  121. 'Change Directory Here
  122.  
  123. changedirectory:
  124. 'SCREEN _NEWIMAGE(1200, 600, 32)
  125. '_SCREENMOVE 100, 50
  126.  
  127.  
  128. IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp"
  129.  
  130. DIM mySelection&, done$
  131.  
  132.     PRINT "Current Directory: " + _CWD$
  133.     REDIM myFiles(0) AS STRING
  134.     loadFA "*.*", myFiles()
  135.     mySelection& = getArrayItemNumber&(5, 2, 48, 20, myFiles())
  136.     CLS
  137.     IF mySelection& <> -1719 THEN
  138.         CHDIR myFiles(mySelection&)
  139.     ELSE
  140.         _KEYCLEAR
  141.         EXIT DO
  142.     END IF
  143.     _LIMIT 60
  144. LOOP 'UNTIL done$ <> ""
  145.  
  146.  
  147. SUB loadFA (spec$, fa() AS STRING)
  148.     DIM tmpFile$, Index%, fline$, d$
  149.     tmpFile$ = "C:\temp\DIR$INF0.INF"
  150.     'PRINT tmpFile$
  151.     'END
  152.     SHELL _HIDE "DIR /a:d >" + tmpFile$ 'get directories  but have to do a little pruning
  153.     'SHELL _HIDE "DIR " + spec$ + " /b > " + TmpFile$
  154.     'SHELL _HIDE "DIR " + spec$ + " /b /s /o:gen> " + TmpFile$
  155.     OPEN tmpFile$ FOR INPUT AS #1
  156.     Index% = -1
  157.     DO WHILE NOT EOF(1)
  158.         LINE INPUT #1, fline$
  159.         IF INSTR(fline$, "<DIR>") THEN
  160.             d$ = _TRIM$(rightOf$(fline$, "<DIR>"))
  161.             Index% = Index% + 1
  162.             REDIM _PRESERVE fa(Index%)
  163.             fa(Index%) = d$
  164.         END IF
  165.     LOOP
  166.     CLOSE #1
  167.     KILL tmpFile$
  168.  
  169. FUNCTION rightOf$ (source$, of$)
  170.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
  171.  
  172. 'attempting use this 4 things (2018-12-30)
  173. ' 1. expects HELP sub that uses message and message box but easy to comment out
  174. ' 2. expects to be in graphics mode
  175. ' 3. chages color of screen
  176. ' 4. needs _KEYCLEAR 2 before calling of previous keyhits will interfere!!!
  177. '
  178. ' Future Help Message Box for the function.
  179. ' "*** Mouse and Key Instructions ***"
  180. '
  181. ' "Mouse, mouse wheel, and arrow keys should work as expected for item selection."
  182. ' "Press spacebar to select a highlighted item or just click it."
  183. ' "Use number(s) + enter to select an array item by it's index number,"
  184. ' "backspace will remove last number pressed, c will clear a number started."
  185. ' "Numbers started are shown in bottom right PgDn bar."
  186. ' "Enter will also select the highlighted item, if no number has been started."
  187. ' "Home starts you at lowest array index, End highlights then highest index."
  188. ' "Use PgUp and PgDn keys to flip through pages of array items."
  189. '
  190. ' "Escape returns -1719 to allow a Cancel function and signal no slection."
  191. FUNCTION getArrayItemNumber& (locateRow, locateColumn, boxWidth, boxHeight, arr() AS STRING)
  192.     'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
  193.     'boxWidth and boxHeight are in character units, again for locate and print at correct places.
  194.     'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.
  195.  
  196.     DIM curRow AS INTEGER, curCol AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
  197.     DIM maxWidth AS INTEGER, maxHeight AS INTEGER, page AS INTEGER, hlite AS INTEGER, mx AS INTEGER, my AS INTEGER
  198.     DIM lastMX AS INTEGER, lastMY AS INTEGER, row AS INTEGER, mb AS INTEGER
  199.     DIM lba AS LONG, uba AS LONG, choice AS LONG, kh AS LONG, index AS LONG
  200.     DIM clrStr AS STRING, b AS STRING
  201.  
  202.     'save old settings to restore at end ofsub
  203.     curRow = CSRLIN
  204.     curCol = POS(0)
  205.     fg = _DEFAULTCOLOR
  206.     bg = _BACKGROUNDCOLOR
  207.     _KEYCLEAR
  208.  
  209.     maxWidth = boxWidth '       number of characters in box
  210.     maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
  211.     lba = LBOUND(arr)
  212.     uba = UBOUND(arr)
  213.     page = 0
  214.     hlite = 0 '                 line in display ready for selection by spacebar or if no number is started, enter
  215.     clrStr$ = SPACE$(maxWidth) 'clearing a display line
  216.  
  217.     GOSUB update '              show the beginning of the array items for selection
  218.  
  219.     'signal cancel selection process, exit sub with this unlikely index to signal canel
  220.     choice = -1719 'primes 7 and 8, not likely to be a select index of an array
  221.  
  222.     DO 'until get a selection or demand exit
  223.  
  224.         'handle the key stuff
  225.         kh& = _KEYHIT
  226.         IF kh& THEN
  227.             IF kh& > 0 AND kh& < 255 THEN
  228.                 IF INSTR("0123456789", CHR$(kh&)) > 0 THEN b$ = b$ + CHR$(kh&): GOSUB update
  229.                 'IF CHR$(kh&) = "h" THEN HELP: _KEYCLEAR
  230.  
  231.                 IF CHR$(kh&) = "c" THEN b$ = "": GOSUB update
  232.                 IF kh& = 13 THEN 'enter pressed check if number is being entered?
  233.                     IF LEN(b$) THEN
  234.                         IF VAL(b$) >= lba AND VAL(b$) <= uba THEN 'we have number started
  235.                             choice = VAL(b$): EXIT DO
  236.                         ELSE 'clear b$ to show some response to enter
  237.                             b$ = "": GOSUB update 'clear the value that doesn't work
  238.                         END IF
  239.                     ELSE
  240.                         choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
  241.                     END IF
  242.                 END IF
  243.                 IF kh& = 27 THEN EXIT DO 'escape clause offered to Cancel selection process
  244.                 IF kh& = 32 THEN choice = hlite + page * maxHeight + lba 'best way to choose highlighted selection
  245.                 IF kh& = 8 THEN 'backspace to edit number
  246.                     IF LEN(b$) THEN b$ = LEFT$(b$, LEN(b$) - 1): GOSUB update
  247.                 END IF
  248.             ELSE
  249.                 SELECT CASE kh& 'choosing sections of array to display and highlighted item
  250.                     CASE 20736 'pg dn
  251.                         IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  252.                     CASE 18688 'pg up
  253.                         IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  254.                     CASE 18432 'up
  255.                         IF hlite - 1 < 0 THEN
  256.                             IF page > 0 THEN
  257.                                 page = page - 1: hlite = maxHeight - 1: GOSUB update
  258.                             END IF
  259.                         ELSE
  260.                             hlite = hlite - 1: GOSUB update
  261.                         END IF
  262.                     CASE 20480 'down
  263.                         IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  264.                             IF hlite + 1 > maxHeight - 1 THEN
  265.                                 page = page + 1: hlite = 0: GOSUB update
  266.                             ELSE
  267.                                 hlite = hlite + 1: GOSUB update
  268.                             END IF
  269.                         END IF
  270.                     CASE 18176 'home
  271.                         page = 0: hlite = 0: GOSUB update
  272.                     CASE 20224 ' end
  273.                         page = INT((uba - lba) / maxHeight): hlite = maxHeight - 1: GOSUB update
  274.                 END SELECT
  275.             END IF
  276.         END IF
  277.  
  278.         'handle the mouse stuff
  279.         WHILE _MOUSEINPUT
  280.             IF _MOUSEWHEEL = -1 THEN 'up?
  281.                 IF hlite - 1 < 0 THEN
  282.                     IF page > 0 THEN
  283.                         page = page - 1: hlite = maxHeight - 1: GOSUB update
  284.                     END IF
  285.                 ELSE
  286.                     hlite = hlite - 1: GOSUB update
  287.                 END IF
  288.             ELSEIF _MOUSEWHEEL = 1 THEN 'down?
  289.                 IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  290.                     IF hlite + 1 > maxHeight - 1 THEN
  291.                         page = page + 1: hlite = 0: GOSUB update
  292.                     ELSE
  293.                         hlite = hlite + 1: GOSUB update
  294.                     END IF
  295.                 END IF
  296.             END IF
  297.         WEND
  298.         mx = INT((_MOUSEX - locateColumn * 8) / 8) + 2: my = INT((_MOUSEY - locateRow * 16) / 16) + 2
  299.         IF _MOUSEBUTTON(1) THEN 'click contols or select array item
  300.             'clear mouse clicks
  301.             mb = _MOUSEBUTTON(1)
  302.             IF mb THEN 'clear it
  303.                 WHILE mb 'OK!
  304.                     IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  305.                     _LIMIT 100
  306.                 WEND
  307.             END IF
  308.  
  309.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  310.                 choice = my + page * maxHeight + lba - 1 'select item clicked
  311.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = 0 THEN 'page up or exit
  312.                 IF my = 0 AND (mx <= maxWidth AND mx >= maxWidth - 2) THEN 'exit sign
  313.                     EXIT DO 'escape plan for mouse click top right corner of display box
  314.                 ELSE 'PgUp bar clicked
  315.                     IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  316.                 END IF
  317.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = maxHeight + 1 THEN 'page down bar clicked
  318.                 IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  319.             END IF
  320.         ELSE '   mouse over highlighting, only if mouse has moved!
  321.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  322.                 IF mx <> lastMX OR my <> lastMY THEN
  323.                     IF my - 1 <> hlite AND (my - 1 + page * maxHeight + lba <= uba) THEN
  324.                         hlite = my - 1
  325.                         lastMX = mx: lastMY = my
  326.                         GOSUB update
  327.                     END IF
  328.                 END IF
  329.             END IF
  330.         END IF
  331.         _LIMIT 200
  332.     LOOP UNTIL choice >= lba AND choice <= uba
  333.     getArrayItemNumber& = choice
  334.     COLOR fg, bg
  335.     'clear key presses
  336.     _KEYCLEAR
  337.     LOCATE curRow, curCol
  338.     'clear mouse clicks
  339.     mb = _MOUSEBUTTON(1)
  340.     IF mb THEN 'clear it
  341.         WHILE mb 'OK!
  342.             IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  343.             _LIMIT 100
  344.         WEND
  345.     END IF
  346.     EXIT SUB
  347.  
  348.     'display of array sections and controls on screen
  349.     update:
  350.  
  351.     'fix hlite if it has dropped below last array item
  352.     WHILE hlite + page * maxHeight + lba > uba
  353.         hlite = hlite - 1
  354.     WEND
  355.  
  356.     'main display of array items at page * maxHeight (lines high)
  357.     FOR row = 0 TO maxHeight - 1
  358.         IF hlite = row THEN COLOR _RGB(200, 200, 255), _RGB32(0, 0, 88) ELSE COLOR _RGB32(0, 0, 88), _RGB(200, 200, 255)
  359.         LOCATE locateRow + row, locateColumn: PRINT clrStr$
  360.         index = row + page * maxHeight + lba
  361.         IF index >= lba AND index <= uba THEN
  362.             LOCATE locateRow + row, locateColumn
  363.             PRINT LEFT$(LTRIM$(STR$(index)) + ") " + arr(index), maxWidth)
  364.         END IF
  365.     NEXT
  366.  
  367.     'make page up and down bars to click, print PgUp / PgDn if available
  368.     COLOR _RGB32(200, 200, 255), _RGB32(0, 100, 50)
  369.     LOCATE locateRow - 1, locateColumn: PRINT SPACE$(maxWidth)
  370.     IF page <> 0 THEN LOCATE locateRow - 1, locateColumn: PRINT LEFT$(" Pg Up" + SPACE$(maxWidth), maxWidth)
  371.     LOCATE locateRow + maxHeight, locateColumn: PRINT SPACE$(maxWidth)
  372.     IF page <> INT(uba / maxHeight) THEN
  373.         LOCATE locateRow + maxHeight, locateColumn: PRINT LEFT$(" Pg Dn" + SPACE$(maxWidth), maxWidth)
  374.     END IF
  375.     'make exit sign for mouse click
  376.     COLOR _RGB32(255, 255, 255), _RGB32(200, 100, 0)
  377.     LOCATE locateRow - 1, locateColumn + maxWidth - 3
  378.     PRINT " X "
  379.  
  380.     'if a number selection has been started show it's build = b$
  381.     IF LEN(b$) THEN
  382.         COLOR _RGB(255, 255, 0), _RGB32(0, 0, 0)
  383.         LOCATE locateRow + maxHeight, locateColumn + maxWidth - LEN(b$) - 1
  384.         PRINT b$;
  385.     END IF
  386.     _DISPLAY
  387.     _LIMIT 100
  388.     RETURN
  389.  

« Last Edit: August 24, 2019, 12:27:07 am by SierraKen »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Tiny Navigator
« Reply #9 on: August 24, 2019, 12:12:53 am »
RE: Navigator in Ken's application

OK, I have to take dog out and I will check right after that...
« Last Edit: August 24, 2019, 09:31:52 am by bplus »

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Tiny Navigator
« Reply #10 on: August 24, 2019, 12:26:35 am »
I made the program a little better by shortening my temp file name (not yours) and put mine in the same c:\temp directory as yours. That wasn't the problem but I will try anything at this point just about. LOL I also added your name and updated info on the top comments.

Code: QB64: [Select]
  1. 'This program was made on August 23, 2019 by Ken G. with lots of help by B+ and Petr from the QB64.org forum.
  2. 'This program makes 2 temporary files called MyMusicFiles.temp and DIR$INF0.INF in a directory called c:\temp
  3. 'If for some reason these files exist after this program is shut down, you are free to delete them.
  4.  
  5. _TITLE "Mini MP3 Player"
  6. SCREEN _NEWIMAGE(400, 400, 32)
  7. begin:
  8.     DIM f$(10000)
  9.     record = 0
  10.     rec = 0
  11.     oldp = 0
  12.     p = 0
  13.     CLS
  14.     PRINT: PRINT: PRINT
  15.     PRINT "                Mini MP3 Player"
  16.     PRINT: PRINT: PRINT
  17.     PRINT "                  By Ken G."
  18.     PRINT
  19.     LOCATE 11, 1: PRINT "Directory: "; _CWD$
  20.     PRINT: PRINT
  21.     PRINT "            (1) Change Directory"
  22.     PRINT "            (2) Play Song"
  23.     PRINT "            (3) Play Directory"
  24.     PRINT "            (4) Quit"
  25.     PRINT
  26.     PRINT
  27.     INPUT "      ->", a
  28.     IF a = 1 THEN GOSUB changedirectory:
  29.     IF a = 2 THEN GOSUB song:
  30.     IF a = 3 THEN GOSUB playdir:
  31.     IF a = 4 THEN END
  32.  
  33. 'Play One Song Here
  34.  
  35. song:
  36. FILES "*.mp3"
  37. again2:
  38. INPUT "Song: ", song$
  39. IF song$ = "" THEN GOTO begin:
  40. fe% = _FILEEXISTS(song$)
  41. IF fe% <> -1 THEN
  42.     PRINT "Filename doesn't exist."
  43.     PRINT "Try again, or Enter for Menu."
  44.     GOTO again2:
  45. s& = _SNDOPEN(song$)
  46. LOCATE 1, 1: PRINT song$
  47. LOCATE 2, 1: PRINT "Sound Rate: "; _SNDRATE
  48. LOCATE 4, 1: PRINT "Length: "; INT(_SNDLEN(s&))
  49. LOCATE 6, 1: PRINT "Space Bar = Pause (P)lay (S)top (M)enu"
  50.  
  51.     a$ = INKEY$
  52.     IF a$ = CHR$(27) THEN _SNDSTOP s&: END
  53.     IF a$ = " " THEN _SNDPAUSE s&
  54.     IF a$ = "S" OR a$ = "s" THEN _SNDSTOP s&
  55.     IF a$ = "P" OR a$ = "p" THEN _SNDPLAY s&
  56.     IF a$ = "M" OR a$ = "m" THEN _SNDSTOP s&: GOTO begin:
  57.     oldp = p
  58.     p = _SNDGETPOS(s&)
  59.     LOCATE 3, 1: PRINT "Position: "; INT(p)
  60.     IF INT(oldp) > INT(p) AND INT(p) = 0 THEN GOTO begin:
  61.  
  62. 'Play Directory Here
  63.  
  64. playdir:
  65. REDIM file(0) AS STRING 'create empty text array. 0 is record nr. 1!
  66. IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp"
  67. SHELL _HIDE "dir *.mp3 /B > C:\temp\MyMusicFiles.temp" 'create mp3 files list.
  68. OPEN "C:\temp\MyMusicFiles.temp" FOR INPUT AS #1
  69.     CLOSE #1
  70.     SHELL _HIDE "DEL C:\temp\MyMusicFiles.temp"
  71.     CLS
  72.     PRINT "No mp3 songs on this folder."
  73.     PRINT
  74.     INPUT "Press Enter to go back to Menu.", menu$
  75.     GOTO begin:
  76.     LINE INPUT #1, file$
  77.     file(record) = file$
  78.     f$(record) = file$
  79.     PRINT f$(record)
  80.     record = record + 1 'for next loop we needed array higher up to one
  81.     REDIM _PRESERVE file(record) AS STRING 'this do array bigger without deleting content
  82. SHELL _HIDE "DEL C:\temp\MyMusicFiles.temp"
  83. 'so now file(0) is first file from disk. file(3) is 4th file from disk. Try it:
  84. ready:
  85. a$ = ""
  86. p = 0
  87. oldp = 0
  88. s& = _SNDOPEN(file(rec))
  89. LOCATE 1, 1: PRINT f$(rec)
  90. LOCATE 2, 1: PRINT "Sound Rate: "; _SNDRATE
  91. LOCATE 4, 1: PRINT "Length: "; INT(_SNDLEN(s&))
  92. LOCATE 6, 1: PRINT "Space Bar = Pause (P)lay (N)ext Song (M)enu"
  93.     a$ = INKEY$
  94.     IF a$ = CHR$(27) THEN _SNDSTOP s&: END
  95.     IF a$ = " " THEN _SNDPAUSE s&
  96.     IF a$ = "N" OR a$ = "n" THEN _SNDSTOP s&
  97.     IF a$ = "P" OR a$ = "p" THEN _SNDPLAY s&
  98.     IF a$ = "M" OR a$ = "m" THEN _SNDSTOP s&: rec = 0: RETURN
  99.     oldp = p
  100.     p = _SNDGETPOS(s&)
  101.     LOCATE 3, 1: PRINT "Position: "; INT(p)
  102.     IF INT(oldp) > INT(p) AND INT(p) = 0 THEN GOTO more:
  103. more:
  104. IF rec = record - 1 THEN RETURN
  105. rec = rec + 1
  106. GOTO ready:
  107. 'OPTION _EXPLICIT
  108. '_TITLE "Tiny Navigator mod orig post with perm tmpfile" 'B+
  109. ' 2019-08-22 orig post at https://www.qb64.org/forum/index.php?topic=1646.msg108682#msg108682
  110. ' 2019-08-23 try fix (to nav all directories) with one place for tmpFile, theory can't write files in some dir's
  111. ' For some reason Windows won't write to a fully pathed file in my user folder???
  112. ' Try testing if dir exists "C:\temp" exists and making one if not, yes! and I can write my temp files there
  113. ' and now I can chDir anywhere!
  114.  
  115. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  116.  
  117. ' Attention!!!  this creates a temp directory "C:\temp", do not run this program if you forbid this.
  118.  
  119. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  120.  
  121. 'Change Directory Here
  122.  
  123. changedirectory:
  124. 'SCREEN _NEWIMAGE(1200, 600, 32)
  125. '_SCREENMOVE 100, 50
  126.  
  127.  
  128. IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp"
  129.  
  130. DIM mySelection&, done$
  131.  
  132.     PRINT "Current Directory: " + _CWD$
  133.     REDIM myFiles(0) AS STRING
  134.     loadFA "*.*", myFiles()
  135.     mySelection& = getArrayItemNumber&(5, 2, 48, 20, myFiles())
  136.     CLS
  137.     IF mySelection& <> -1719 THEN
  138.         CHDIR myFiles(mySelection&)
  139.     ELSE
  140.         _KEYCLEAR
  141.         EXIT DO
  142.     END IF
  143.     _LIMIT 60
  144. LOOP 'UNTIL done$ <> ""
  145.  
  146.  
  147. SUB loadFA (spec$, fa() AS STRING)
  148.     DIM tmpFile$, Index%, fline$, d$
  149.     tmpFile$ = "C:\temp\DIR$INF0.INF"
  150.     'PRINT tmpFile$
  151.     'END
  152.     SHELL _HIDE "DIR /a:d >" + tmpFile$ 'get directories  but have to do a little pruning
  153.     'SHELL _HIDE "DIR " + spec$ + " /b > " + TmpFile$
  154.     'SHELL _HIDE "DIR " + spec$ + " /b /s /o:gen> " + TmpFile$
  155.     OPEN tmpFile$ FOR INPUT AS #1
  156.     Index% = -1
  157.     DO WHILE NOT EOF(1)
  158.         LINE INPUT #1, fline$
  159.         IF INSTR(fline$, "<DIR>") THEN
  160.             d$ = _TRIM$(rightOf$(fline$, "<DIR>"))
  161.             Index% = Index% + 1
  162.             REDIM _PRESERVE fa(Index%)
  163.             fa(Index%) = d$
  164.         END IF
  165.     LOOP
  166.     CLOSE #1
  167.     KILL tmpFile$
  168.  
  169. FUNCTION rightOf$ (source$, of$)
  170.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
  171.  
  172. 'attempting use this 4 things (2018-12-30)
  173. ' 1. expects HELP sub that uses message and message box but easy to comment out
  174. ' 2. expects to be in graphics mode
  175. ' 3. chages color of screen
  176. ' 4. needs _KEYCLEAR 2 before calling of previous keyhits will interfere!!!
  177. '
  178. ' Future Help Message Box for the function.
  179. ' "*** Mouse and Key Instructions ***"
  180. '
  181. ' "Mouse, mouse wheel, and arrow keys should work as expected for item selection."
  182. ' "Press spacebar to select a highlighted item or just click it."
  183. ' "Use number(s) + enter to select an array item by it's index number,"
  184. ' "backspace will remove last number pressed, c will clear a number started."
  185. ' "Numbers started are shown in bottom right PgDn bar."
  186. ' "Enter will also select the highlighted item, if no number has been started."
  187. ' "Home starts you at lowest array index, End highlights then highest index."
  188. ' "Use PgUp and PgDn keys to flip through pages of array items."
  189. '
  190. ' "Escape returns -1719 to allow a Cancel function and signal no slection."
  191. FUNCTION getArrayItemNumber& (locateRow, locateColumn, boxWidth, boxHeight, arr() AS STRING)
  192.     'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
  193.     'boxWidth and boxHeight are in character units, again for locate and print at correct places.
  194.     'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.
  195.  
  196.     DIM curRow AS INTEGER, curCol AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
  197.     DIM maxWidth AS INTEGER, maxHeight AS INTEGER, page AS INTEGER, hlite AS INTEGER, mx AS INTEGER, my AS INTEGER
  198.     DIM lastMX AS INTEGER, lastMY AS INTEGER, row AS INTEGER, mb AS INTEGER
  199.     DIM lba AS LONG, uba AS LONG, choice AS LONG, kh AS LONG, index AS LONG
  200.     DIM clrStr AS STRING, b AS STRING
  201.  
  202.     'save old settings to restore at end ofsub
  203.     curRow = CSRLIN
  204.     curCol = POS(0)
  205.     fg = _DEFAULTCOLOR
  206.     bg = _BACKGROUNDCOLOR
  207.     _KEYCLEAR
  208.  
  209.     maxWidth = boxWidth '       number of characters in box
  210.     maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
  211.     lba = LBOUND(arr)
  212.     uba = UBOUND(arr)
  213.     page = 0
  214.     hlite = 0 '                 line in display ready for selection by spacebar or if no number is started, enter
  215.     clrStr$ = SPACE$(maxWidth) 'clearing a display line
  216.  
  217.     GOSUB update '              show the beginning of the array items for selection
  218.  
  219.     'signal cancel selection process, exit sub with this unlikely index to signal canel
  220.     choice = -1719 'primes 7 and 8, not likely to be a select index of an array
  221.  
  222.     DO 'until get a selection or demand exit
  223.  
  224.         'handle the key stuff
  225.         kh& = _KEYHIT
  226.         IF kh& THEN
  227.             IF kh& > 0 AND kh& < 255 THEN
  228.                 IF INSTR("0123456789", CHR$(kh&)) > 0 THEN b$ = b$ + CHR$(kh&): GOSUB update
  229.                 'IF CHR$(kh&) = "h" THEN HELP: _KEYCLEAR
  230.  
  231.                 IF CHR$(kh&) = "c" THEN b$ = "": GOSUB update
  232.                 IF kh& = 13 THEN 'enter pressed check if number is being entered?
  233.                     IF LEN(b$) THEN
  234.                         IF VAL(b$) >= lba AND VAL(b$) <= uba THEN 'we have number started
  235.                             choice = VAL(b$): EXIT DO
  236.                         ELSE 'clear b$ to show some response to enter
  237.                             b$ = "": GOSUB update 'clear the value that doesn't work
  238.                         END IF
  239.                     ELSE
  240.                         choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
  241.                     END IF
  242.                 END IF
  243.                 IF kh& = 27 THEN EXIT DO 'escape clause offered to Cancel selection process
  244.                 IF kh& = 32 THEN choice = hlite + page * maxHeight + lba 'best way to choose highlighted selection
  245.                 IF kh& = 8 THEN 'backspace to edit number
  246.                     IF LEN(b$) THEN b$ = LEFT$(b$, LEN(b$) - 1): GOSUB update
  247.                 END IF
  248.             ELSE
  249.                 SELECT CASE kh& 'choosing sections of array to display and highlighted item
  250.                     CASE 20736 'pg dn
  251.                         IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  252.                     CASE 18688 'pg up
  253.                         IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  254.                     CASE 18432 'up
  255.                         IF hlite - 1 < 0 THEN
  256.                             IF page > 0 THEN
  257.                                 page = page - 1: hlite = maxHeight - 1: GOSUB update
  258.                             END IF
  259.                         ELSE
  260.                             hlite = hlite - 1: GOSUB update
  261.                         END IF
  262.                     CASE 20480 'down
  263.                         IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  264.                             IF hlite + 1 > maxHeight - 1 THEN
  265.                                 page = page + 1: hlite = 0: GOSUB update
  266.                             ELSE
  267.                                 hlite = hlite + 1: GOSUB update
  268.                             END IF
  269.                         END IF
  270.                     CASE 18176 'home
  271.                         page = 0: hlite = 0: GOSUB update
  272.                     CASE 20224 ' end
  273.                         page = INT((uba - lba) / maxHeight): hlite = maxHeight - 1: GOSUB update
  274.                 END SELECT
  275.             END IF
  276.         END IF
  277.  
  278.         'handle the mouse stuff
  279.         WHILE _MOUSEINPUT
  280.             IF _MOUSEWHEEL = -1 THEN 'up?
  281.                 IF hlite - 1 < 0 THEN
  282.                     IF page > 0 THEN
  283.                         page = page - 1: hlite = maxHeight - 1: GOSUB update
  284.                     END IF
  285.                 ELSE
  286.                     hlite = hlite - 1: GOSUB update
  287.                 END IF
  288.             ELSEIF _MOUSEWHEEL = 1 THEN 'down?
  289.                 IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  290.                     IF hlite + 1 > maxHeight - 1 THEN
  291.                         page = page + 1: hlite = 0: GOSUB update
  292.                     ELSE
  293.                         hlite = hlite + 1: GOSUB update
  294.                     END IF
  295.                 END IF
  296.             END IF
  297.         WEND
  298.         mx = INT((_MOUSEX - locateColumn * 8) / 8) + 2: my = INT((_MOUSEY - locateRow * 16) / 16) + 2
  299.         IF _MOUSEBUTTON(1) THEN 'click contols or select array item
  300.             'clear mouse clicks
  301.             mb = _MOUSEBUTTON(1)
  302.             IF mb THEN 'clear it
  303.                 WHILE mb 'OK!
  304.                     IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  305.                     _LIMIT 100
  306.                 WEND
  307.             END IF
  308.  
  309.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  310.                 choice = my + page * maxHeight + lba - 1 'select item clicked
  311.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = 0 THEN 'page up or exit
  312.                 IF my = 0 AND (mx <= maxWidth AND mx >= maxWidth - 2) THEN 'exit sign
  313.                     EXIT DO 'escape plan for mouse click top right corner of display box
  314.                 ELSE 'PgUp bar clicked
  315.                     IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  316.                 END IF
  317.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = maxHeight + 1 THEN 'page down bar clicked
  318.                 IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  319.             END IF
  320.         ELSE '   mouse over highlighting, only if mouse has moved!
  321.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  322.                 IF mx <> lastMX OR my <> lastMY THEN
  323.                     IF my - 1 <> hlite AND (my - 1 + page * maxHeight + lba <= uba) THEN
  324.                         hlite = my - 1
  325.                         lastMX = mx: lastMY = my
  326.                         GOSUB update
  327.                     END IF
  328.                 END IF
  329.             END IF
  330.         END IF
  331.         _LIMIT 200
  332.     LOOP UNTIL choice >= lba AND choice <= uba
  333.     getArrayItemNumber& = choice
  334.     COLOR fg, bg
  335.     'clear key presses
  336.     _KEYCLEAR
  337.     LOCATE curRow, curCol
  338.     'clear mouse clicks
  339.     mb = _MOUSEBUTTON(1)
  340.     IF mb THEN 'clear it
  341.         WHILE mb 'OK!
  342.             IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  343.             _LIMIT 100
  344.         WEND
  345.     END IF
  346.     EXIT SUB
  347.  
  348.     'display of array sections and controls on screen
  349.     update:
  350.  
  351.     'fix hlite if it has dropped below last array item
  352.     WHILE hlite + page * maxHeight + lba > uba
  353.         hlite = hlite - 1
  354.     WEND
  355.  
  356.     'main display of array items at page * maxHeight (lines high)
  357.     FOR row = 0 TO maxHeight - 1
  358.         IF hlite = row THEN COLOR _RGB(200, 200, 255), _RGB32(0, 0, 88) ELSE COLOR _RGB32(0, 0, 88), _RGB(200, 200, 255)
  359.         LOCATE locateRow + row, locateColumn: PRINT clrStr$
  360.         index = row + page * maxHeight + lba
  361.         IF index >= lba AND index <= uba THEN
  362.             LOCATE locateRow + row, locateColumn
  363.             PRINT LEFT$(LTRIM$(STR$(index)) + ") " + arr(index), maxWidth)
  364.         END IF
  365.     NEXT
  366.  
  367.     'make page up and down bars to click, print PgUp / PgDn if available
  368.     COLOR _RGB32(200, 200, 255), _RGB32(0, 100, 50)
  369.     LOCATE locateRow - 1, locateColumn: PRINT SPACE$(maxWidth)
  370.     IF page <> 0 THEN LOCATE locateRow - 1, locateColumn: PRINT LEFT$(" Pg Up" + SPACE$(maxWidth), maxWidth)
  371.     LOCATE locateRow + maxHeight, locateColumn: PRINT SPACE$(maxWidth)
  372.     IF page <> INT(uba / maxHeight) THEN
  373.         LOCATE locateRow + maxHeight, locateColumn: PRINT LEFT$(" Pg Dn" + SPACE$(maxWidth), maxWidth)
  374.     END IF
  375.     'make exit sign for mouse click
  376.     COLOR _RGB32(255, 255, 255), _RGB32(200, 100, 0)
  377.     LOCATE locateRow - 1, locateColumn + maxWidth - 3
  378.     PRINT " X "
  379.  
  380.     'if a number selection has been started show it's build = b$
  381.     IF LEN(b$) THEN
  382.         COLOR _RGB(255, 255, 0), _RGB32(0, 0, 0)
  383.         LOCATE locateRow + maxHeight, locateColumn + maxWidth - LEN(b$) - 1
  384.         PRINT b$;
  385.     END IF
  386.     _DISPLAY
  387.     _LIMIT 100
  388.     RETURN
  389.  
  390.  

« Last Edit: August 24, 2019, 12:29:47 am by SierraKen »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Tiny Navigator
« Reply #11 on: August 24, 2019, 12:54:22 am »
RE: Navigator in Ken's application

While walking the dog, I remembered you had allot of things going back to Begin: label, but not Navigator (as I remember) could something need to be reinitialized or zero'd out after change directory?

A thought for you while I go over your latest revision.

This line needs to be done once right at beginning:
Code: QB64: [Select]
  1. IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp"
  2.  
just once is enough!

Your main menu loop is beautiful to my eye.

Code: QB64: [Select]
  1. IF song$ = "" THEN GOTO begin:
Instead of GOTO begin, RETURN is much better form, should not jump out of GOSUBs with GOTOs always RETURN because the interpreter or compiler needs to see RETURN for closure, like for every ( open parenthesis there should be a ) close parenthesis.

I think RETURNS are put in a stack of goto lines, if return is never reached in one sub, the next return found is likely to return to where the first sub was suppose to return to. You can use GOTO's that stay completely inside a GOSUB like your goto again2: 3 places in GOSUB Song: you are GOTOing to Begin: just RETURN should do it.

Not a biggy but it is nicer form to EXIT DO rather a GOTO jump.
Code: QB64: [Select]
  1.     IF INT(oldp) > INT(p) AND INT(p) = 0 THEN GOTO more: '<<<  just EXIT DO
  2. more:

The GOTO Begin: in Song GOSUB could be causing weird results. That's best I could find at this late hour.
« Last Edit: August 24, 2019, 09:30:33 am by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Tiny Navigator
« Reply #12 on: August 24, 2019, 09:19:59 am »
RE: Navigator in Ken's application
Code: QB64: [Select]
  1.  
  2. changedirectory:
  3. 'SCREEN _NEWIMAGE(1200, 600, 32)
  4. '_SCREENMOVE 100, 50
  5.  
  6. 'VVVVVVVVVVVVV Yuck! I have note about this line in comments VVVVVVVVVVVVVVVVVVVV
  7.  
  8. IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp"
  9. ' Replace at start of program to do only once then use SHARED variable tmpDir for writing
  10. ' temp files in a good spot for user, updated sub that uses tmpDir.
  11.  
  12. '^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  13.  
  14.  
  15. DIM mySelection&, done$
  16.  
  17.     PRINT "Current Directory: " + _CWD$
  18.     REDIM myFiles(0) AS STRING
  19.     loadFA "*.*", myFiles()
  20.     mySelection& = getArrayItemNumber&(5, 2, 48, 20, myFiles())
  21.     IF mySelection& <> -1719 THEN
  22.         CLS  '<<<<<<<<<<<<<<   moved from right after mySelection& = getA....
  23.         CHDIR myFiles(mySelection&)
  24.     ELSE
  25.         _KEYCLEAR
  26.        ' >>>>>>>>>>>>>>>>>>>>>>>>>> OK now CLS is NOT clearing if eXiting
  27. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  28. 'Ken, insert here what ever you want to see the screen display do, that is not happening now.
  29. ' It will / should other wise cycle back to your Menu.
  30. ' Maybe it should GOSUB Song or GOSUB PlayDirectory before RETURN to Menu???
  31. ' This is where the navigator is signaled by escape press or X click in to right corner of screen to eXit
  32. ' Perfect place to get screen ready for return to the business of playing music.
  33. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  34.  
  35.         EXIT DO
  36.     END IF
  37.     _LIMIT 60
  38. LOOP 'UNTIL done$ <> ""
  39.  
  40.  
  41.  

Ken, the Navigator code is improved (but more to go) since you grabbed roughed out version.
Mainly, the DIM SHARED TmpDir as string, fix Steve suggested would be good to add to start of your program but then the LoadFA code needs to be changed (that would get rid of warning too.)

LoadFA changed to this: ( to use TmpDir and drop the spec$ in call to sub )
Code: QB64: [Select]
  1. SUB loadDIR (fa() AS STRING)
  2.     DIM tmpFile AS STRING, Index%, fline$, d$
  3.     tmpFile = tmpDir + "\DIR$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
  4.     SHELL _HIDE "DIR /a:d >" + tmpFile 'get directories  but have to do a little pruning
  5.     OPEN tmpFile FOR INPUT AS #1
  6.     Index% = -1
  7.     DO WHILE NOT EOF(1)
  8.         LINE INPUT #1, fline$
  9.         IF INSTR(fline$, "<DIR>") THEN
  10.             d$ = _TRIM$(rightOf$(fline$, "<DIR>"))
  11.             Index% = Index% + 1
  12.             REDIM _PRESERVE fa(Index%)
  13.             fa(Index%) = d$
  14.         END IF
  15.     LOOP
  16.     CLOSE #1
  17.     KILL tmpFile
  18.  

Then the call to it in your app should be:
Code: QB64: [Select]
  1.     PRINT "Current Directory: " + _CWD$
  2.     REDIM myFiles(0) AS STRING   ' >>>>>>>>>>>>>> you could change this name to myDIRs(0)
  3.  
  4.     'loadFA "*.*", myFiles()  ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  5.     loadDIR myFiles()  ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> myFiles to myDIRS()
  6.  
  7.     mySelection& = getArrayItemNumber&(5, 2, 48, 20, myFiles())
  8.     CLS
  9.     IF mySelection& <> -1719 THEN
  10.         CHDIR myFiles(mySelection&) ' >>>>>>>>>>>>>>> myFiles(mySelection&) to myDIRS(mySelection&)
  11.     ELSE
  12.         _KEYCLEAR
  13.         EXIT DO
  14.     END IF
  15.     _LIMIT 60
  16. LOOP 'UNTIL done$ <> ""
  17.  

Dang! I have 2 sets of changes, one modifies code to updated version of Navigator code involving the tmpDir for temp files, the other moves a CLS and advises where to insert code with the old (current) state of Ken app to play nicely with the music and Ken's vision of the player.
« Last Edit: August 24, 2019, 10:37:04 am by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Tiny Navigator
« Reply #13 on: August 24, 2019, 10:45:44 am »
I guess the next logical step is to turn this into a Modal Dialog for Retrieving File or Directory names. :)

I hope to get the idea of screen state worked in, that I use for mBox and inputBox, maybe put the whole set in a library, maybe change Function getArrayItemNumber to SUB ListBox.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Tiny Navigator
« Reply #14 on: August 24, 2019, 01:16:13 pm »
Your SUB has an error that won't make it work, on this line:
tmpFile = tmpDir + "\DIR$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!   

The error says: Cannot convert number to string.

Do I need any of Steve's code for this windows temp directory?

But thanks for the rest, I changed everything to what you said.

Code: QB64: [Select]
  1. 'This program was made on August 23, 2019 by Ken G. with lots of help by B+ and Petr from the QB64.org forum.
  2. 'This program makes 2 temporary files called MyMusicFiles.temp and DIR$INF0.INF in a directory called c:\temp
  3. 'If for some reason these files exist after this program is shut down, you are free to delete them.
  4.  
  5. _TITLE "Mini MP3 Player"
  6. SCREEN _NEWIMAGE(400, 400, 32)
  7. IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp"
  8. begin:
  9.     DIM f$(10000)
  10.     record = 0
  11.     rec = 0
  12.     oldp = 0
  13.     p = 0
  14.     CLS
  15.     PRINT: PRINT: PRINT
  16.     PRINT "                Mini MP3 Player"
  17.     PRINT: PRINT: PRINT
  18.     PRINT "                  By Ken G."
  19.     PRINT
  20.     LOCATE 11, 1: PRINT "Directory: "; _CWD$
  21.     PRINT: PRINT
  22.     PRINT "            (1) Change Directory"
  23.     PRINT "            (2) Play Song"
  24.     PRINT "            (3) Play Directory"
  25.     PRINT "            (4) Quit"
  26.     PRINT
  27.     PRINT
  28.     INPUT "      ->", a
  29.     IF a = 1 THEN GOSUB changedirectory:
  30.     IF a = 2 THEN GOSUB song:
  31.     IF a = 3 THEN GOSUB playdir:
  32.     IF a = 4 THEN END
  33.  
  34. 'Play One Song Here
  35.  
  36. song:
  37. FILES "*.mp3"
  38. again2:
  39. INPUT "Song: ", song$
  40. IF song$ = "" THEN RETURN
  41. fe% = _FILEEXISTS(song$)
  42. IF fe% <> -1 THEN
  43.     PRINT "Filename doesn't exist."
  44.     PRINT "Try again, or Enter for Menu."
  45.     GOTO again2:
  46. s& = _SNDOPEN(song$)
  47. LOCATE 1, 1: PRINT song$
  48. LOCATE 2, 1: PRINT "Sound Rate: "; _SNDRATE
  49. LOCATE 4, 1: PRINT "Length: "; INT(_SNDLEN(s&))
  50. LOCATE 6, 1: PRINT "Space Bar = Pause (P)lay (S)top (M)enu"
  51.  
  52.     a$ = INKEY$
  53.     IF a$ = CHR$(27) THEN _SNDSTOP s&: END
  54.     IF a$ = " " THEN _SNDPAUSE s&
  55.     IF a$ = "S" OR a$ = "s" THEN _SNDSTOP s&
  56.     IF a$ = "P" OR a$ = "p" THEN _SNDPLAY s&
  57.     IF a$ = "M" OR a$ = "m" THEN _SNDSTOP s&: RETURN
  58.     oldp = p
  59.     p = _SNDGETPOS(s&)
  60.     LOCATE 3, 1: PRINT "Position: "; INT(p)
  61.     IF INT(oldp) > INT(p) AND INT(p) = 0 THEN RETURN
  62.  
  63. 'Play Directory Here
  64.  
  65. playdir:
  66. REDIM file(0) AS STRING 'create empty text array. 0 is record nr. 1!
  67. SHELL _HIDE "dir *.mp3 /B > C:\temp\MyMusicFiles.temp" 'create mp3 files list.
  68. OPEN "C:\temp\MyMusicFiles.temp" FOR INPUT AS #1
  69.     CLOSE #1
  70.     SHELL _HIDE "DEL C:\temp\MyMusicFiles.temp"
  71.     CLS
  72.     PRINT "No mp3 songs on this folder."
  73.     PRINT
  74.     INPUT "Press Enter to go back to Menu.", menu$
  75.     RETURN
  76.     LINE INPUT #1, file$
  77.     file(record) = file$
  78.     f$(record) = file$
  79.     PRINT f$(record)
  80.     record = record + 1 'for next loop we needed array higher up to one
  81.     REDIM _PRESERVE file(record) AS STRING 'this do array bigger without deleting content
  82. SHELL _HIDE "DEL C:\temp\MyMusicFiles.temp"
  83. 'so now file(0) is first file from disk. file(3) is 4th file from disk. Try it:
  84. ready:
  85. a$ = ""
  86. p = 0
  87. oldp = 0
  88. s& = _SNDOPEN(file(rec))
  89. LOCATE 1, 1: PRINT f$(rec)
  90. LOCATE 2, 1: PRINT "Sound Rate: "; _SNDRATE
  91. LOCATE 4, 1: PRINT "Length: "; INT(_SNDLEN(s&))
  92. LOCATE 6, 1: PRINT "Space Bar = Pause (P)lay (N)ext Song (M)enu"
  93.     a$ = INKEY$
  94.     IF a$ = CHR$(27) THEN _SNDSTOP s&: END
  95.     IF a$ = " " THEN _SNDPAUSE s&
  96.     IF a$ = "N" OR a$ = "n" THEN _SNDSTOP s&
  97.     IF a$ = "P" OR a$ = "p" THEN _SNDPLAY s&
  98.     IF a$ = "M" OR a$ = "m" THEN _SNDSTOP s&: rec = 0: RETURN
  99.     oldp = p
  100.     p = _SNDGETPOS(s&)
  101.     LOCATE 3, 1: PRINT "Position: "; INT(p)
  102.     IF INT(oldp) > INT(p) AND INT(p) = 0 THEN EXIT DO
  103. more:
  104. IF rec = record - 1 THEN RETURN
  105. rec = rec + 1
  106. GOTO ready:
  107. 'OPTION _EXPLICIT
  108. '_TITLE "Tiny Navigator mod orig post with perm tmpfile" 'B+
  109. ' 2019-08-22 orig post at https://www.qb64.org/forum/index.php?topic=1646.msg108682#msg108682
  110. ' 2019-08-23 try fix (to nav all directories) with one place for tmpFile, theory can't write files in some dir's
  111. ' For some reason Windows won't write to a fully pathed file in my user folder???
  112. ' Try testing if dir exists "C:\temp" exists and making one if not, yes! and I can write my temp files there
  113. ' and now I can chDir anywhere!
  114.  
  115. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  116.  
  117. ' Attention!!!  this creates a temp directory "C:\temp", do not run this program if you forbid this.
  118.  
  119. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  120.  
  121. 'Change Directory Here
  122.  
  123.  
  124. changedirectory:
  125. 'SCREEN _NEWIMAGE(1200, 600, 32)
  126. '_SCREENMOVE 100, 50
  127.  
  128.  
  129. DIM mySelection&, done$
  130.  
  131.     PRINT "Current Directory: " + _CWD$
  132.     REDIM myFiles(0) AS STRING ' >>>>>>>>>>>>>> you could change this name to myDIRs(0)
  133.  
  134.     'loadFA "*.*", myFiles()  ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  135.     loadDIR myFiles() ' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> myFiles to myDIRS()
  136.  
  137.     mySelection& = getArrayItemNumber&(5, 2, 48, 20, myFiles())
  138.     CLS
  139.     IF mySelection& <> -1719 THEN
  140.         CHDIR myFiles(mySelection&) ' >>>>>>>>>>>>>>> myFiles(mySelection&) to myDIRS(mySelection&)
  141.     ELSE
  142.         _KEYCLEAR
  143.         EXIT DO
  144.     END IF
  145.     _LIMIT 60
  146. LOOP 'UNTIL done$ <> ""
  147.  
  148.  
  149.  
  150.  
  151. SUB loadDIR (fa() AS STRING)
  152.     DIM tmpFile AS STRING, Index%, fline$, d$
  153.     tmpFile = tmpDir + "\DIR$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
  154.     SHELL _HIDE "DIR /a:d >" + tmpFile 'get directories  but have to do a little pruning
  155.     OPEN tmpFile FOR INPUT AS #1
  156.     Index% = -1
  157.     DO WHILE NOT EOF(1)
  158.         LINE INPUT #1, fline$
  159.         IF INSTR(fline$, "<DIR>") THEN
  160.             d$ = _TRIM$(rightOf$(fline$, "<DIR>"))
  161.             Index% = Index% + 1
  162.             REDIM _PRESERVE fa(Index%)
  163.             fa(Index%) = d$
  164.         END IF
  165.     LOOP
  166.     CLOSE #1
  167.     KILL tmpFile
  168.  
  169. FUNCTION rightOf$ (source$, of$)
  170.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
  171.  
  172. 'attempting use this 4 things (2018-12-30)
  173. ' 1. expects HELP sub that uses message and message box but easy to comment out
  174. ' 2. expects to be in graphics mode
  175. ' 3. chages color of screen
  176. ' 4. needs _KEYCLEAR 2 before calling of previous keyhits will interfere!!!
  177. '
  178. ' Future Help Message Box for the function.
  179. ' "*** Mouse and Key Instructions ***"
  180. '
  181. ' "Mouse, mouse wheel, and arrow keys should work as expected for item selection."
  182. ' "Press spacebar to select a highlighted item or just click it."
  183. ' "Use number(s) + enter to select an array item by it's index number,"
  184. ' "backspace will remove last number pressed, c will clear a number started."
  185. ' "Numbers started are shown in bottom right PgDn bar."
  186. ' "Enter will also select the highlighted item, if no number has been started."
  187. ' "Home starts you at lowest array index, End highlights then highest index."
  188. ' "Use PgUp and PgDn keys to flip through pages of array items."
  189. '
  190. ' "Escape returns -1719 to allow a Cancel function and signal no slection."
  191. FUNCTION getArrayItemNumber& (locateRow, locateColumn, boxWidth, boxHeight, arr() AS STRING)
  192.     'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
  193.     'boxWidth and boxHeight are in character units, again for locate and print at correct places.
  194.     'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.
  195.  
  196.     DIM curRow AS INTEGER, curCol AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
  197.     DIM maxWidth AS INTEGER, maxHeight AS INTEGER, page AS INTEGER, hlite AS INTEGER, mx AS INTEGER, my AS INTEGER
  198.     DIM lastMX AS INTEGER, lastMY AS INTEGER, row AS INTEGER, mb AS INTEGER
  199.     DIM lba AS LONG, uba AS LONG, choice AS LONG, kh AS LONG, index AS LONG
  200.     DIM clrStr AS STRING, b AS STRING
  201.  
  202.     'save old settings to restore at end ofsub
  203.     curRow = CSRLIN
  204.     curCol = POS(0)
  205.     fg = _DEFAULTCOLOR
  206.     bg = _BACKGROUNDCOLOR
  207.     _KEYCLEAR
  208.  
  209.     maxWidth = boxWidth '       number of characters in box
  210.     maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
  211.     lba = LBOUND(arr)
  212.     uba = UBOUND(arr)
  213.     page = 0
  214.     hlite = 0 '                 line in display ready for selection by spacebar or if no number is started, enter
  215.     clrStr$ = SPACE$(maxWidth) 'clearing a display line
  216.  
  217.     GOSUB update '              show the beginning of the array items for selection
  218.  
  219.     'signal cancel selection process, exit sub with this unlikely index to signal canel
  220.     choice = -1719 'primes 7 and 8, not likely to be a select index of an array
  221.  
  222.     DO 'until get a selection or demand exit
  223.  
  224.         'handle the key stuff
  225.         kh& = _KEYHIT
  226.         IF kh& THEN
  227.             IF kh& > 0 AND kh& < 255 THEN
  228.                 IF INSTR("0123456789", CHR$(kh&)) > 0 THEN b$ = b$ + CHR$(kh&): GOSUB update
  229.                 'IF CHR$(kh&) = "h" THEN HELP: _KEYCLEAR
  230.  
  231.                 IF CHR$(kh&) = "c" THEN b$ = "": GOSUB update
  232.                 IF kh& = 13 THEN 'enter pressed check if number is being entered?
  233.                     IF LEN(b$) THEN
  234.                         IF VAL(b$) >= lba AND VAL(b$) <= uba THEN 'we have number started
  235.                             choice = VAL(b$): EXIT DO
  236.                         ELSE 'clear b$ to show some response to enter
  237.                             b$ = "": GOSUB update 'clear the value that doesn't work
  238.                         END IF
  239.                     ELSE
  240.                         choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
  241.                     END IF
  242.                 END IF
  243.                 IF kh& = 27 THEN EXIT DO 'escape clause offered to Cancel selection process
  244.                 IF kh& = 32 THEN choice = hlite + page * maxHeight + lba 'best way to choose highlighted selection
  245.                 IF kh& = 8 THEN 'backspace to edit number
  246.                     IF LEN(b$) THEN b$ = LEFT$(b$, LEN(b$) - 1): GOSUB update
  247.                 END IF
  248.             ELSE
  249.                 SELECT CASE kh& 'choosing sections of array to display and highlighted item
  250.                     CASE 20736 'pg dn
  251.                         IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  252.                     CASE 18688 'pg up
  253.                         IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  254.                     CASE 18432 'up
  255.                         IF hlite - 1 < 0 THEN
  256.                             IF page > 0 THEN
  257.                                 page = page - 1: hlite = maxHeight - 1: GOSUB update
  258.                             END IF
  259.                         ELSE
  260.                             hlite = hlite - 1: GOSUB update
  261.                         END IF
  262.                     CASE 20480 'down
  263.                         IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  264.                             IF hlite + 1 > maxHeight - 1 THEN
  265.                                 page = page + 1: hlite = 0: GOSUB update
  266.                             ELSE
  267.                                 hlite = hlite + 1: GOSUB update
  268.                             END IF
  269.                         END IF
  270.                     CASE 18176 'home
  271.                         page = 0: hlite = 0: GOSUB update
  272.                     CASE 20224 ' end
  273.                         page = INT((uba - lba) / maxHeight): hlite = maxHeight - 1: GOSUB update
  274.                 END SELECT
  275.             END IF
  276.         END IF
  277.  
  278.         'handle the mouse stuff
  279.         WHILE _MOUSEINPUT
  280.             IF _MOUSEWHEEL = -1 THEN 'up?
  281.                 IF hlite - 1 < 0 THEN
  282.                     IF page > 0 THEN
  283.                         page = page - 1: hlite = maxHeight - 1: GOSUB update
  284.                     END IF
  285.                 ELSE
  286.                     hlite = hlite - 1: GOSUB update
  287.                 END IF
  288.             ELSEIF _MOUSEWHEEL = 1 THEN 'down?
  289.                 IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
  290.                     IF hlite + 1 > maxHeight - 1 THEN
  291.                         page = page + 1: hlite = 0: GOSUB update
  292.                     ELSE
  293.                         hlite = hlite + 1: GOSUB update
  294.                     END IF
  295.                 END IF
  296.             END IF
  297.         WEND
  298.         mx = INT((_MOUSEX - locateColumn * 8) / 8) + 2: my = INT((_MOUSEY - locateRow * 16) / 16) + 2
  299.         IF _MOUSEBUTTON(1) THEN 'click contols or select array item
  300.             'clear mouse clicks
  301.             mb = _MOUSEBUTTON(1)
  302.             IF mb THEN 'clear it
  303.                 WHILE mb 'OK!
  304.                     IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  305.                     _LIMIT 100
  306.                 WEND
  307.             END IF
  308.  
  309.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  310.                 choice = my + page * maxHeight + lba - 1 'select item clicked
  311.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = 0 THEN 'page up or exit
  312.                 IF my = 0 AND (mx <= maxWidth AND mx >= maxWidth - 2) THEN 'exit sign
  313.                     EXIT DO 'escape plan for mouse click top right corner of display box
  314.                 ELSE 'PgUp bar clicked
  315.                     IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
  316.                 END IF
  317.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = maxHeight + 1 THEN 'page down bar clicked
  318.                 IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
  319.             END IF
  320.         ELSE '   mouse over highlighting, only if mouse has moved!
  321.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
  322.                 IF mx <> lastMX OR my <> lastMY THEN
  323.                     IF my - 1 <> hlite AND (my - 1 + page * maxHeight + lba <= uba) THEN
  324.                         hlite = my - 1
  325.                         lastMX = mx: lastMY = my
  326.                         GOSUB update
  327.                     END IF
  328.                 END IF
  329.             END IF
  330.         END IF
  331.         _LIMIT 200
  332.     LOOP UNTIL choice >= lba AND choice <= uba
  333.     getArrayItemNumber& = choice
  334.     COLOR fg, bg
  335.     'clear key presses
  336.     _KEYCLEAR
  337.     LOCATE curRow, curCol
  338.     'clear mouse clicks
  339.     mb = _MOUSEBUTTON(1)
  340.     IF mb THEN 'clear it
  341.         WHILE mb 'OK!
  342.             IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
  343.             _LIMIT 100
  344.         WEND
  345.     END IF
  346.     EXIT SUB
  347.  
  348.     'display of array sections and controls on screen
  349.     update:
  350.  
  351.     'fix hlite if it has dropped below last array item
  352.     WHILE hlite + page * maxHeight + lba > uba
  353.         hlite = hlite - 1
  354.     WEND
  355.  
  356.     'main display of array items at page * maxHeight (lines high)
  357.     FOR row = 0 TO maxHeight - 1
  358.         IF hlite = row THEN COLOR _RGB(200, 200, 255), _RGB32(0, 0, 88) ELSE COLOR _RGB32(0, 0, 88), _RGB(200, 200, 255)
  359.         LOCATE locateRow + row, locateColumn: PRINT clrStr$
  360.         index = row + page * maxHeight + lba
  361.         IF index >= lba AND index <= uba THEN
  362.             LOCATE locateRow + row, locateColumn
  363.             PRINT LEFT$(LTRIM$(STR$(index)) + ") " + arr(index), maxWidth)
  364.         END IF
  365.     NEXT
  366.  
  367.     'make page up and down bars to click, print PgUp / PgDn if available
  368.     COLOR _RGB32(200, 200, 255), _RGB32(0, 100, 50)
  369.     LOCATE locateRow - 1, locateColumn: PRINT SPACE$(maxWidth)
  370.     IF page <> 0 THEN LOCATE locateRow - 1, locateColumn: PRINT LEFT$(" Pg Up" + SPACE$(maxWidth), maxWidth)
  371.     LOCATE locateRow + maxHeight, locateColumn: PRINT SPACE$(maxWidth)
  372.     IF page <> INT(uba / maxHeight) THEN
  373.         LOCATE locateRow + maxHeight, locateColumn: PRINT LEFT$(" Pg Dn" + SPACE$(maxWidth), maxWidth)
  374.     END IF
  375.     'make exit sign for mouse click
  376.     COLOR _RGB32(255, 255, 255), _RGB32(200, 100, 0)
  377.     LOCATE locateRow - 1, locateColumn + maxWidth - 3
  378.     PRINT " X "
  379.  
  380.     'if a number selection has been started show it's build = b$
  381.     IF LEN(b$) THEN
  382.         COLOR _RGB(255, 255, 0), _RGB32(0, 0, 0)
  383.         LOCATE locateRow + maxHeight, locateColumn + maxWidth - LEN(b$) - 1
  384.         PRINT b$;
  385.     END IF
  386.     _DISPLAY
  387.     _LIMIT 100
  388.     RETURN
  389.  
« Last Edit: August 24, 2019, 01:26:10 pm by SierraKen »