BMP picture viewer

[NOVARSEG]

Basic code for a BMP picture viewer.  Works with 24 bit per pixel BMP.

Does not use _LOADIMAGE.   To use the program, enter the name of the BMP file you want to look at. 

Code: QB64: [Select]

1. PRINT
2. PRINT
3.  
4. INPUT " Enter name of BMP file "; i$
5. OPEN i$ FOR BINARY AS #1
6.  
7. DIM L AS _UNSIGNED LONG
8. DIM I AS _UNSIGNED INTEGER
9. DIM C AS _UNSIGNED LONG
10. DIM H AS _UNSIGNED LONG
11. DIM W AS _UNSIGNED LONG
12. DIM R AS _UNSIGNED LONG
13. DIM OF AS _UNSIGNED LONG
14. DIM N AS _UNSIGNED LONG
15. DIM tt AS STRING * 4
16. DIM t AS STRING * 3
17. DIM handle AS LONG
18.  
19. GET #1, 11, OF
20. PRINT "Offset to picture data"; OF
21.  
22. GET #1, 15, L
23. PRINT "Header size "; L
24.  
25. GET #1, , W
26. PRINT "image width "; W
27.  
28. GET #1, , H
29. PRINT "image height "; H
30.  
31. GET #1, , I
32.  
33.  
34. GET #1, , I
35. PRINT "bits per pixel "; I
36.  
37. IF I = 32 THEN PRINT "Can't process 32 bit per pixel BMP": END
38.  
39. DIM a AS _MEM
40. handle = _NEWIMAGE(W, H, 32)
41. a = _MEMIMAGE(handle)
42.  
43. FOR R = H - 1 TO 0 STEP -1
44.  
45.     FOR C = 1 TO W * 3 STEP 3
46.         GET #1, R * W * 3 + C + OF, t
47.         tt = t + CHR$(255)
48.         _MEMPUT a, a.OFFSET + N, tt
49.         N = N + 4
50.     NEXT C
51.  
52. NEXT R
53.  
54. SCREEN _NEWIMAGE(W, H, 32)
55. _PUTIMAGE (0, 0), handle
56.  
57. CLOSE
58.  
59. END
60.  

[SMcNeill]

Will this work with compressed images?

And the only difference with 32-bit images is you just get 4 bytes instead of 3 and adding CHR$(255).

[SpriggsySpriggs]

Neat. I'll take a look at this sometime

[NOVARSEG]

Right now code works with normal uncompressed images .   

Yep adding that 4th byte is important with 24 bit per pixel BMPs 

[NOVARSEG]

Updated so code won't try to open other formats.

Code: QB64: [Select]

1. PRINT
2. PRINT
3.  
4. INPUT " Enter name of BMP file "; i$
5. OPEN i$ FOR BINARY AS #1
6.  
7. DIM L AS _UNSIGNED LONG
8. DIM I AS _UNSIGNED INTEGER
9. DIM C AS _UNSIGNED LONG
10. DIM H AS _UNSIGNED LONG
11. DIM W AS _UNSIGNED LONG
12. DIM R AS _UNSIGNED LONG
13. DIM OF AS _UNSIGNED LONG
14. DIM N AS _UNSIGNED LONG
15. DIM tt AS STRING * 4
16. DIM t AS STRING * 3
17. DIM handle AS LONG
18.  
19. GET #1, 11, OF
20. PRINT "Offset to picture data"; OF
21.  
22. GET #1, 15, L
23. PRINT "Header size "; L
24.  
25. GET #1, , W
26. PRINT "image width "; W
27.  
28. GET #1, , H
29. PRINT "image height "; H
30.  
31. GET #1, , I
32.  
33.  
34. GET #1, , I
35. PRINT "bits per pixel "; I
36. PRINT
37.  
38. IF I = 32 THEN: _FULLSCREEN: PRINT "Can't process 32 bit per pixel BMP": CLOSE: END
39. IF I <> 24 THEN: _FULLSCREEN: PRINT "Not a 24 bit per pixel BMP": CLOSE: END
40.  
41.  
42.  
43.  
44. DIM a AS _MEM
45. handle = _NEWIMAGE(W, H, 32)
46. a = _MEMIMAGE(handle)
47.  
48. FOR R = H - 1 TO 0 STEP -1
49.  
50.     FOR C = 1 TO W * 3 STEP 3
51.         GET #1, R * W * 3 + C + OF, t
52.         tt = t + CHR$(255)
53.         _MEMPUT a, a.OFFSET + N, tt
54.         N = N + 4
55.     NEXT C
56.  
57. NEXT R
58.  
59. SCREEN _NEWIMAGE(W, H, 32)
60. _PUTIMAGE (0, 0), handle
61.  
62. CLOSE
63.  
64. END
65.  

[NOVARSEG]

Update

used the FILELIST function to display BMP files in a folder

just click with mouse to display BMP

Code: QB64: [Select]

1. DIM filename AS STRING
2. _TITLE "Demo of FILELIST$ Function by Ted Weissgerber 2010 (modified)"
3. dst& = _NEWIMAGE(800, 600, 32) 'for console bitmap
4. SCREEN dst&
5.  
6. PAINT (799, 599), _RGB(180, 180, 180)
7. LINE (7, 15)-(648, 496), _RGB(0, 0, 80), BF
8.  
9. 'LOCATE 33, 10: PRINT "Do you want file display in a new window? (Y/N)"
10. 'DO
11. 'SLEEP
12. 'yesno$ = UCASE$(INKEY$)
13. 'LOOP UNTIL yesno$ <> ""
14.  
15. 'IF yesno$ = "Y" THEN x% = 0: y% = 0 ELSE x% = 8: y% = 16 'set parameters
16.  
17. x% = 8: y% = 16
18. LOCATE 33, 10
19. ' INPUT "Enter a File Type extension(*.BMP, *.TXT, etc): ", spec$
20. 'spec$ = UCASE$(spec$)
21. ''IF INSTR(spec$, "*.") = 0 THEN spec$ = "*." + spec$
22. spec$ = "*.bmp"
23. '<<<<<<< If x% and y% parameters are 0, the display is in separate window.>>>>>>
24. filename = FILELIST$(spec$, x%, y%) '<<<<<<<< added display position parameters
25.  
26.  
27. LOCATE 35, 10: PRINT filename$, LFN$
28. 'SLEEP
29.  
30.  
31.  
32.  
33. 'END
34.  
35. 'INPUT " Enter name of BMP file "; i$
36. OPEN filename FOR BINARY AS #1
37.  
38. DIM L AS _UNSIGNED LONG
39. DIM I AS _UNSIGNED INTEGER
40. DIM C AS _UNSIGNED LONG
41. DIM H AS _UNSIGNED LONG
42. DIM W AS _UNSIGNED LONG
43. DIM R AS _UNSIGNED LONG
44. DIM OF AS _UNSIGNED LONG
45. DIM N AS _UNSIGNED LONG
46. DIM tt AS STRING * 4
47. DIM t AS STRING * 3
48. DIM handle AS LONG
49.  
50. GET #1, 11, OF
51. PRINT "Offset to picture data"; OF
52.  
53. GET #1, 15, L
54. PRINT "Header size "; L
55.  
56. GET #1, , W
57. PRINT "image width "; W
58.  
59. GET #1, , H
60. PRINT "image height "; H
61.  
62. GET #1, , I
63.  
64.  
65. GET #1, , I
66. PRINT "bits per pixel "; I
67. PRINT
68.  
69. IF I = 32 THEN: _FULLSCREEN: PRINT "Can't process 32 bit per pixel BMP": CLOSE: END
70. IF I <> 24 THEN: _FULLSCREEN: PRINT "Not a 24 bit per pixel BMP": CLOSE: END
71.  
72.  
73.  
74.  
75. DIM a AS _MEM
76. handle = _NEWIMAGE(W, H, 32)
77. a = _MEMIMAGE(handle)
78.  
79. FOR R = H - 1 TO 0 STEP -1
80.  
81.     FOR C = 1 TO W * 3 STEP 3
82.         GET #1, R * W * 3 + C + OF, t
83.         tt = t + CHR$(255)
84.         _MEMPUT a, a.OFFSET + N, tt
85.         N = N + 4
86.     NEXT C
87.  
88. NEXT R
89.  
90. SCREEN _NEWIMAGE(W, H, 32)
91. _PUTIMAGE (0, 0), handle
92.  
93. CLOSE
94.  
95. END
96.  
97. FUNCTION FILELIST$ (Spec$, xpos%, ypos%)
98.     SHARED Path$, LFN$ 'values also accessable by program
99.     REDIM LGFN$(25), SHFN$(25), Last$(25), DIR$(25), Paths$(25) '<<<< $DYNAMIC only
100.     IF LEN(ENVIRON$("OS")) = 0 THEN EXIT FUNCTION 'DIR X cannot be used on Win 9X
101.     f% = FREEFILE
102.     IF xpos% + ypos% = 0 THEN '****************** Root path TITLE in separate window only
103.         SHELL _HIDE "CD > D0S-DATA.INF"
104.         OPEN "D0S-DATA.INF" FOR INPUT AS #f%
105.         LINE INPUT #f%, current$
106.         CLOSE #f%
107.     END IF ' ******************************************** END TITLE(see _TITLE below)
108.     Spec$ = UCASE$(LTRIM$(RTRIM$(Spec$)))
109.     IF INSTR(Spec$, "/A:D") OR INSTR(Spec$, "/O:G") THEN
110.         DL$ = "DIR": BS$ = "\" 'directory searches only
111.     ELSE: DL$ = SPACE$(3): BS$ = ""
112.     END IF
113.     mode& = _COPYIMAGE(0) 'save previous screen value to restore if files displayed.
114.     ' Get Specific file information if available
115.     SHELL _HIDE "cmd /c dir " + Spec$ + " /X > D0S-DATA.INF" 'get data
116.     Head$ = "      Short Name          Long Name                     Last Modified     "
117.     tmp$ = " \ \  \          \   \                              \ \                  \"
118.     OPEN "D0S-DATA.INF" FOR INPUT AS #f% 'read the data file
119.     DO UNTIL EOF(f%)
120.         LINE INPUT #f%, line$
121.         IF INSTR(line$, ":\") THEN
122.             Path$ = MID$(line$, INSTR(line$, ":\") - 1)
123.             IF RIGHT$(Path$, 1) <> "\" THEN Path$ = Path$ + "\"
124.             setcode% = 0: filecode% = 0
125.         END IF
126.         IF LEN(line$) > 25 AND MID$(line$, 1, 1) <> " " THEN 'don't read other info
127.             IF format% = 0 THEN
128.                 IF MID$(line$, 20, 1) = "M" OR INSTR(line$, "<") = 25 THEN
129.                     Sst% = 40: Lst% = 53: Dst% = 26: format% = 1 ' XP
130.                 ELSE: Sst% = 37: Lst% = 50: Dst% = 23: format% = 2 'VISTA
131.                 END IF
132.             END IF
133.             IF LEN(line$) >= Lst% THEN filecode% = ASC(UCASE$(MID$(line$, Lst%, 1))) ELSE filecode% = 0
134.             D1R$ = MID$(line$, Dst%, 3) 'returns directories only with Spec$ = "/A:D" or "/O:G"
135.             IF D1R$ <> "DIR" THEN D1R$ = SPACE$(3) 'change if anything else
136.             IF D1R$ = DL$ AND filecode% >= setcode% THEN
137.                 cnt% = cnt% + 1
138.                 DIR$(cnt%) = D1R$: Paths$(cnt%) = Path$
139.                 Last$(cnt%) = MID$(line$, 1, 20)
140.                 IF MID$(line$, Sst%, 1) <> SPACE$(1) THEN
141.                     SHFN$(cnt%) = MID$(line$, Sst%, INSTR(Sst%, line$, " ") - Sst%)
142.                     LGFN$(cnt%) = MID$(line$, Lst%)
143.                 ELSE: SHFN$(cnt%) = MID$(line$, Lst%): LGFN$(cnt%) = ""
144.                 END IF
145.                 IF LEN(Spec$) AND (Spec$ = UCASE$(SHFN$(cnt%)) OR Spec$ = UCASE$(LGFN$(cnt%))) THEN
146.                     Spec$ = SHFN$(cnt%) + BS$: FILELIST$ = Spec$: LFN$ = LGFN$(cnt%) + BS$
147.                     noshow = -1: GOSUB KILLdata ' verifies file exist query (no display)
148.                 END IF
149.                 IF page% > 0 THEN ' pages after first
150.                     IF cnt% = 1 THEN GOSUB NewScreen
151.                     COLOR 11: LOCATE , 3: PRINT USING tmp$; DIR$(cnt%); SHFN$(cnt%); LGFN$(cnt%); Last$(cnt%)
152.                     IF DIR$(cnt%) = "DIR" AND LEFT$(SHFN$(cnt%), 1) = "." THEN SHFN$(cnt%) = "": LGFN$(cnt%) = ""
153.                 ELSE 'first page = 0
154.                     IF cnt% = 2 THEN 'only display to screen if 2 or more files are found
155.                         FList& = _NEWIMAGE(640, 480, 256)
156.                         IF xpos% + ypos% > 0 THEN ' user wants display on program screen
157.                             Show& = _NEWIMAGE(640, 480, 256) '<<<<<< ONSCREEN program displays only
158.                             _DEST FList&
159.                         ELSE: SCREEN FList& ' <<<<<<<<< Separate Window
160.                             _TITLE current$ '<<<<<<<<<<<<<<<<<<<<<<<<<<< TITLE optional
161.                         END IF
162.                         GOSUB NewScreen '<<<< update function's screen with Putimage(see notes)
163.                         COLOR 11: LOCATE , 3: PRINT USING tmp$; DIR$(1); SHFN$(1); LGFN$(1); Last$(1)
164.                         IF DIR$(1) = "DIR" AND LEFT$(SHFN$(1), 1) = "." THEN SHFN$(1) = "": LGFN$(1) = ""
165.                     END IF
166.                     IF cnt% > 1 THEN
167.                         COLOR 11: LOCATE , 3: PRINT USING tmp$; DIR$(cnt%); SHFN$(cnt%); LGFN$(cnt%); Last$(cnt%)
168.                         IF DIR$(cnt%) = "DIR" AND LEFT$(SHFN$(cnt%), 1) = "." THEN SHFN$(cnt%) = "": LGFN$(cnt%) = ""
169.                     END IF
170.                 END IF 'page%
171.                 IF cnt% MOD 25 = 0 THEN 'each page holds 25 file names
172.                     COLOR 14: LOCATE 28, 24: PRINT "Select file or click here for next.";
173.                     GOSUB pickfile
174.                     page% = page% + 1: cnt% = 0
175.                     REDIM LGFN$(25), SHFN$(25), Last$(25), DIR$(25), Paths$(25) '<<<< $DYNAMIC only
176.                 END IF 'mod  25
177.             END IF 'DIR = DL$
178.         END IF 'len line$ > 25
179.     LOOP
180.     CLOSE #f%
181.     last = 1: total% = cnt% + (page% * 25)
182.     IF total% = 0 THEN FILELIST$ = "": Spec$ = "": LFN$ = "": noshow = -1: GOSUB KILLdata: 'no files(no display)
183.     IF total% = 1 THEN 'one file(no display)
184.         Spec$ = SHFN$(1) + BS$: FILELIST$ = Spec$: LFN$ = LGFN$(1) + BS$: noshow = -1: GOSUB KILLdata
185.     END IF
186.     IF DL$ = SPACE$(3) THEN
187.         COLOR 10: LOCATE 28, 65: PRINT total%; "Files"
188.     ELSE: COLOR 10: LOCATE 28, 65: PRINT total%; "Folders"
189.     END IF
190.     COLOR 14: LOCATE 28, 24: PRINT "Select file or click here to Exit. ";
191.     pickfile:
192.     _DEST FList&
193.     ShowPath$ = RIGHT$(Path$, 78)
194.     COLOR 15: LOCATE 29, 41 - (LEN(ShowPath$) \ 2): PRINT ShowPath$;
195.     GOSUB NewDisplay
196.     DO: Key$ = UCASE$(INKEY$): _LIMIT 30
197.         DO WHILE _MOUSEINPUT
198.             Tcol% = ((_MOUSEX - xpos%) \ 8) + 1 'mouse column with Putimage offset
199.             Trow% = ((_MOUSEY - ypos%) \ 16) + 1 'mouse row with offset
200.             Pick = _MOUSEBUTTON(1) ' get left button selection click
201.         LOOP
202.         IF Trow% > 2 AND Trow% < cnt% + 3 AND Tcol% > 0 AND Tcol% < 80 THEN 'when mouse in area
203.             R% = Trow% - 2
204.             IF P% = 0 OR P% > cnt% + 3 THEN P% = R%
205.             IF P% = R% THEN
206.                 COLOR 15: LOCATE R% + 2, 3: PRINT USING tmp$; DIR$(R%); SHFN$(R%); LGFN$(R%); Last$(R%)
207.             ELSE
208.                 COLOR 11: LOCATE P% + 2, 3: PRINT USING tmp$; DIR$(P%); SHFN$(P%); LGFN$(P%); Last$(P%)
209.             END IF
210.             GOSUB NewDisplay
211.             P% = R%
212.             IF Pick THEN
213.                 Spec$ = SHFN$(R%)
214.                 IF LEN(Spec$) THEN
215.                     COLOR 13: LOCATE R% + 2, 3: PRINT USING tmp$; DIR$(R%); SHFN$(R%); LGFN$(R%); Last$(R%)
216.                     GOSUB NewDisplay
217.                     Spec$ = Spec$ + BS$: FILELIST$ = Spec$: Path$ = Paths$(R%)
218.                     IF LEN(LGFN$(R%)) THEN LFN$ = LGFN$(R%) + BS$ ELSE LFN$ = ""
219.                     _DELAY 1.5: CLS: SCREEN mode&: GOSUB KILLdata 'exit if user selection
220.                 END IF
221.             END IF 'len spec
222.         END IF 'pick
223.         IF LEN(Key$) THEN usercode% = ASC(Key$) ELSE usercode% = 0
224.         IF usercode% > setcode% THEN setcode% = usercode% 'user can press letter to jump to
225.         IF Pick AND Trow% > 27 THEN EXIT DO
226.     LOOP UNTIL LEN(Key$)
227.     _DELAY .4 'adjust delay for page scroll speed
228.     DO: Key$ = INKEY$: LOOP UNTIL Key$ = ""
229.     IF last = 0 THEN RETURN 'exit if file no more data
230.     FILELIST$ = "": Spec$ = "": LFN$ = ""
231.     CLS: SCREEN mode& 'resets program screen to previous condition
232.     KILLdata:
233.     CLOSE #f%: KILL "D0S-DATA.INF" 'kill D0S-DATA.INF file and exit
234.     IF FList& < -1 THEN _FREEIMAGE FList&
235.     IF Show& < -1 THEN _FREEIMAGE Show&
236.     IF noshow = -1 AND mode& < -1 THEN _FREEIMAGE mode&
237.     _AUTODISPLAY 'reset default settings
238.     EXIT FUNCTION
239.     RETURN
240.     NewScreen: 'clear screen and set display format
241.     LINE (0, 0)-(639, 499), 0, BF
242.     COLOR 14: LOCATE 2, 3: PRINT Head$
243.     LINE (4, 4)-(636, 476), 13, B: LINE (5, 5)-(635, 475), 13, B
244.     GOSUB NewDisplay
245.     RETURN
246.     NewDisplay: 'show program or window displays
247.     IF xpos% + ypos% > 0 THEN
248.         _PUTIMAGE , FList&, Show&
249.         _DEST 0: _PUTIMAGE (xpos%, ypos%), Show&: _DISPLAY
250.         _DEST FList&
251.     ELSE: _DISPLAY
252.     END IF
253.     RETURN
254. END FUNCTION
255.  

[bplus]

@NOVARSEG

OK you fixed the first error on title but I am still getting path not found line 39

Code: QB64: [Select]

1. spec$ = "*.*"
2. '<<<<<<< If x% and y% parameters are 0, the display is in separate window.>>>>>>
3. filename = FILELIST$(spec$, x%, y%) '<<<<<<<< added display position parameters
4.  

so filename is missing, so maybe it's the spec$, changed to "*.*" takes care of that error (when no .bmp file is found) and what a lovely display Ted W! from 2010 but then I want to try another directory for bmp files I click where it says to change directory error again. I click current folder to change that and another error.
Not fun... :(

There is a tool to get Folders and Files that works cross platform from which you could work out file select or Folder change Best Answer here: https://www.qb64.org/forum/index.php?topic=1511.msg107143#msg107143

You would build your own filter for BMP files and the code for displaying the Directory Lists and File Lists, it's good exercise and you explain your code better to others and fix errors. There are also tools for displaying lists and selecting also probably harder to do than getting Folder and File lists.

Just trying to help, I don't save BMP's in this format but you are attempting a very common and useful task browsing for filename to load. It is important.

[NOVARSEG]

@bplus
The code is buggy

When I paste a single bmp into a folder  or no BMP in folder it crashes

When  I paste 2 bmp into a folder it works.

[bplus]

@NOVARSEG  buggy program is OK, just a little warning first please. Sorry I thought you were showing a demo.

I still recommend using someone else filename retriever, not Ted W from 2010. Someone here and now at forum that can help with code they wrote if you get stuck while using.

Steve has good filename retriever, Spriggsy, Dav... not just me to choose more current code from.

[NOVARSEG]

The code is a demo used with BMP viewer. 

 Followed that link  https://www.qb64.org/forum/index.php?topic=1511.msg107143#msg107143 and found the code with library functions.   I have also done the same thing with the DOS interrupts.

[bplus]

The code is a demo used with BMP viewer. 

 Followed that link  https://www.qb64.org/forum/index.php?topic=1511.msg107143#msg107143 and found the code with library functions.   I have also done the same thing with the DOS interrupts.

The advantage of using code from that link is that it is cross platform not Windows dependent so build a filename retriever from that and it can be used in Linux and Mac (so I hear). And reused for any app that needs to get a filename.

But maybe those other OS don't use that form of BMP. :)

[NOVARSEG]

The BMP format is cross platform. It's disadvantage is size of file.

Im trying to work with win API.  I'm trying to download  fileapi.h  not much luck so far.

https://docs.microsoft.com/en-us/windows/win32/api/fileapi/

Are you actually clicking the file name with mouse?

Microsoft recommends C++ when coding with WINAPI 
https://docs.microsoft.com/en-us/windows/win32/learnwin32/learn-to-program-for-windows

Can we do the same with QB64?

[bplus]

The BMP format is cross platform. It's disadvantage is size of file.

Im trying to work with win API.  I'm trying to download  fileapi.h  not much luck so far.

https://docs.microsoft.com/en-us/windows/win32/api/fileapi/

Are you actually clicking the file name with mouse?

Microsoft recommends C++ when coding with WINAPI 
https://docs.microsoft.com/en-us/windows/win32/learnwin32/learn-to-program-for-windows

Can we do the same with QB64?

Windows API isn't going to help you in Linux.

Here is Tiny Navigator for File Retrieval, you need direntry.h in the same folder as QB64.exe.

Tiny Navigator for File Retrieval the left side is directories, the right is a sample of files from the directory highlighted. When on the directory you want to select a file from press f then another scrollable window comes up on right for file selection.

You can scroll, arrow, pageup and down by clicking green bars home end for start of array and end, you can also select directories and files by typing the number then enter.

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. ' B+ started 2019-08-22  restart 2020-06-24
3. ' 2019-08-22 orig post at https://www.qb64.org/forum/index.php?topic=1646.msg108682#msg108682
4. ' 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
5. ' For some reason Windows won't write to a fully pathed file in my user folder???from a SHELL command
6. ' Try testing if dir exists "C:\temp" exists and making one if not, yes! and I can write my temp files there
7. ' and now I can chDir anywhere!!!!
8. ' 2019-08-23_14-25 Take Steve's Advice to use users tmp directory for temp files
9. ' 2019-08-23_23+ Have files window working for file selection
10.  
11. ' 2020-06-24 restart using DirEntry.h, wow looks like Steve's fix helped ALLOT! Thanks SMcNeill
12. ' I am hitting glitches where Windows wont let me access I think. So I am offering a c enter option
13. ' to restart at the root but this might not work cross platform.
14.  
15. ' 2020-06-26 another fix to DirEntry.h usage add CHR$(0) to string when calling a C program. This fixed a snag
16. ' between marka and next folder up when heading to root with .. calls.
17.  
18. ' 2020-07-04 Use this to Kill some pesky .ogg files
19.  
20. ' direntry.h needs to be in QB64 folder ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IMPORTANT
21. DECLARE CUSTOMTYPE LIBRARY ".\direntry"
22.     FUNCTION load_dir& (s AS STRING)
23.     FUNCTION has_next_entry& ()
24.     SUB close_dir ()
25.     SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
26. END DECLARE
27.  
28.  
29. _TITLE "Tiny Navigator File Name Retriever:  press f to start File Selection List of current directory"
30. SCREEN _NEWIMAGE(1000, 600, 32)
31. _SCREENMOVE 100, 50
32.  
33. ' for GetFileName$()
34. DIM SHARED selectedFile AS STRING
35. REDIM SHARED DIRs(0) AS STRING, FILs(0) AS STRING
36.  
37. DIM done, myFile$, again$
38. COLOR &HFF000000, &HFFFFFFFF
39. CLS
40. DO 'test our new function
41.     scnState 0
42.     myFile$ = GetFileName$
43.     scnState -1
44.     CLS
45.     PRINT "You selected: "; myFile$
46.     PRINT
47.     INPUT "Test another File Selection (y for yes) "; again$
48.     IF again$ <> "y" THEN done = -1
49. LOOP UNTIL done
50.  
51. FUNCTION GetFileName$ ()
52.  
53.     'you might try srnState before and after calling this function to restore conditions
54.     ' uses: SUB GetLists (SearchDirectory AS STRING, DirList() AS STRING, FileList() AS STRING)  for getting dirs a nd files
55.     ' uses: FUNCTION getArrayItemNumber& (locateRow, locateColumn, boxWidth, boxHeight, arr() AS STRING) for display large arrays and selecting
56.  
57.     ' share these with Main Code section:
58.     ' 'for GetFileName$() and GetLists
59.     'DIM SHARED selectedFile AS STRING
60.     'REDIM SHARED DIRs(0) AS STRING, FILs(0) AS STRING
61.  
62.     DIM mySelection&, done$, i, t$
63.  
64.     _TITLE "Tiny Navigator File Name Retriever:  press f to start File Selection List of current directory"
65.     DO
66.         COLOR _RGB32(180, 180, 255), &HFF000000
67.         CLS
68.         t$ = "Current Directory: " + _CWD$
69.         LOCATE 2, (_WIDTH / 8 - LEN(t$)) / 2: PRINT t$
70.         REDIM DIRs(0) AS STRING, FILs(0) AS STRING
71.         GetLists _CWD$, DIRs(), FILs()
72.         FOR i = 0 TO UBOUND(FILs) ' this just offers a sample listing of files
73.             IF i < 30 THEN LOCATE i + 4, 60: PRINT FILs(i) ELSE EXIT FOR
74.         NEXT
75.         mySelection& = getArrayItemNumber&(5, 5, 50, 30, DIRs())
76.  
77.         CLS
78.         IF selectedFile <> "" THEN
79.             GetFileName$ = selectedFile: done$ = "y"
80.         ELSEIF mySelection& <> -1719 THEN
81.             IF _TRIM$(DIRs(mySelection&)) <> "" THEN
82.                 CHDIR DIRs(mySelection&)
83.             END IF
84.         ELSE
85.             GetFileName$ = "": done$ = "y" ' cancelled or error
86.         END IF
87.         selectedFile = ""
88.         _LIMIT 60
89.     LOOP UNTIL done$ <> ""
90. END FUNCTION
91.  
92. SUB GetLists (SearchDirectory AS STRING, DirList() AS STRING, FileList() AS STRING)
93.  
94.     'put this block in main code section of your program close to top
95.     '' direntry.h needs to be in QB64 folder
96.     'DECLARE CUSTOMTYPE LIBRARY ".\direntry"
97.     '    FUNCTION load_dir& (s AS STRING)
98.     '    FUNCTION has_next_entry& ()
99.     '    SUB close_dir ()
100.     '    SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
101.     'END DECLARE
102.  
103.  
104.     CONST IS_DIR = 1
105.     CONST IS_FILE = 2
106.     DIM flags AS LONG, file_size AS LONG, DirCount AS INTEGER, FileCount AS INTEGER, length AS LONG
107.     DIM nam$
108.     REDIM _PRESERVE DirList(100), FileList(100)
109.     DirCount = 0: FileCount = 0
110.  
111.     IF load_dir(SearchDirectory + CHR$(0)) THEN
112.         DO
113.             length = has_next_entry
114.             IF length > -1 THEN
115.                 nam$ = SPACE$(length)
116.                 get_next_entry nam$, flags, file_size
117.                 IF (flags AND IS_DIR) THEN
118.                     DirCount = DirCount + 1
119.                     IF DirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(UBOUND(DirList) + 100)
120.                     DirList(DirCount) = nam$
121.                 ELSEIF (flags AND IS_FILE) THEN
122.                     FileCount = FileCount + 1
123.                     IF FileCount > UBOUND(filelist) THEN REDIM _PRESERVE FileList(UBOUND(filelist) + 100)
124.                     FileList(FileCount) = nam$
125.                 END IF
126.             END IF
127.         LOOP UNTIL length = -1
128.         'close_dir 'move to after end if  might correct the multi calls problem
129.     ELSE
130.     END IF
131.     close_dir 'this  might correct the multi calls problem
132.  
133.     REDIM _PRESERVE DirList(DirCount)
134.     REDIM _PRESERVE FileList(FileCount)
135. END SUB
136.  
137. FUNCTION rightOf$ (source$, of$)
138.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
139. END FUNCTION
140.  
141. ' "Escape or Red X box returns -1719 to allow a Cancel function and signal no slection."
142. FUNCTION getArrayItemNumber& (locateRow, locateColumn, boxWidth, boxHeight, arr() AS STRING)
143.     'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
144.     'boxWidth and boxHeight are in character units, again for locate and print at correct places.
145.     'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.
146.  
147.     DIM curRow AS INTEGER, curCol AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
148.     DIM maxWidth AS INTEGER, maxHeight AS INTEGER, page AS INTEGER, hlite AS INTEGER, mx AS INTEGER, my AS INTEGER
149.     DIM lastMX AS INTEGER, lastMY AS INTEGER, row AS INTEGER, mb AS INTEGER
150.     DIM lba AS LONG, uba AS LONG, choice AS LONG, kh AS LONG, index AS LONG
151.     DIM clrStr AS STRING, b AS STRING, selNum&
152.  
153.     'save old settings to restore at end ofsub
154.     curRow = CSRLIN
155.     curCol = POS(0)
156.     fg = _DEFAULTCOLOR
157.     bg = _BACKGROUNDCOLOR
158.     _KEYCLEAR
159.  
160.     maxWidth = boxWidth '       number of characters in box
161.     maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
162.     lba = LBOUND(arr)
163.     uba = UBOUND(arr)
164.     page = 0
165.     hlite = 0 '                 line in display ready for selection by spacebar or if no number is started, enter
166.     clrStr$ = SPACE$(maxWidth) 'clearing a display line
167.  
168.     GOSUB update '              show the beginning of the array items for selection
169.  
170.     'signal cancel selection process, exit sub with this unlikely index to signal canel
171.     choice = -1719 'primes 7 and 8, not likely to be a select index of an array
172.  
173.     DO 'until get a selection or demand exit
174.  
175.         'handle the key stuff
176.         kh& = _KEYHIT
177.         IF kh& THEN
178.             IF kh& > 0 AND kh& < 255 THEN
179.                 IF INSTR("0123456789", CHR$(kh&)) > 0 THEN b$ = b$ + CHR$(kh&): GOSUB update
180.                 IF CHR$(kh&) = "f" THEN
181.                     'REDIM FILs(0) AS STRING     'hopefully this is already ready
182.                     'loadFiles FILs()
183.                     selNum& = getArrayItemNumber&(5, 60, 60, 30, FILs())
184.                     COLOR _RGB32(180, 180, 255)
185.                     CLS 'need to signal out of file selection
186.                     IF selNum& >= LBOUND(FILs) AND selNum& <= UBOUND(FILs) THEN selectedFile = FILs(selNum&)
187.                     EXIT DO
188.                     'back to directory select
189.                 END IF
190.  
191.                 IF CHR$(kh&) = "c" THEN b$ = "": GOSUB update
192.                 IF kh& = 13 THEN 'enter pressed check if number is being entered?
193.                     IF LEN(b$) THEN
194.                         IF VAL(b$) >= lba AND VAL(b$) <= uba THEN 'we have number started
195.                             choice = VAL(b$): EXIT DO
196.                         ELSE 'clear b$ to show some response to enter
197.                             b$ = "": GOSUB update 'clear the value that doesn't work
198.                         END IF
199.                     ELSE
200.                         choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
201.                     END IF
202.                 END IF
203.                 IF kh& = 27 THEN EXIT DO 'escape clause offered to Cancel selection process
204.                 IF kh& = 32 THEN choice = hlite + page * maxHeight + lba 'best way to choose highlighted selection
205.                 IF kh& = 8 THEN 'backspace to edit number
206.                     IF LEN(b$) THEN b$ = LEFT$(b$, LEN(b$) - 1): GOSUB update
207.                 END IF
208.             ELSE
209.                 SELECT CASE kh& 'choosing sections of array to display and highlighted item
210.                     CASE 20736 'pg dn
211.                         IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
212.                     CASE 18688 'pg up
213.                         IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
214.                     CASE 18432 'up
215.                         IF hlite - 1 < 0 THEN
216.                             IF page > 0 THEN
217.                                 page = page - 1: hlite = maxHeight - 1: GOSUB update
218.                             END IF
219.                         ELSE
220.                             hlite = hlite - 1: GOSUB update
221.                         END IF
222.                     CASE 20480 'down
223.                         IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
224.                             IF hlite + 1 > maxHeight - 1 THEN
225.                                 page = page + 1: hlite = 0: GOSUB update
226.                             ELSE
227.                                 hlite = hlite + 1: GOSUB update
228.                             END IF
229.                         END IF
230.                     CASE 18176 'home
231.                         page = 0: hlite = 0: GOSUB update
232.                     CASE 20224 ' end
233.                         page = INT((uba - lba) / maxHeight): hlite = maxHeight - 1: GOSUB update
234.                 END SELECT
235.             END IF
236.         END IF
237.  
238.         'handle the mouse stuff
239.         WHILE _MOUSEINPUT
240.             IF _MOUSEWHEEL = -1 THEN 'up?
241.                 IF hlite - 1 < 0 THEN
242.                     IF page > 0 THEN
243.                         page = page - 1: hlite = maxHeight - 1: GOSUB update
244.                     END IF
245.                 ELSE
246.                     hlite = hlite - 1: GOSUB update
247.                 END IF
248.             ELSEIF _MOUSEWHEEL = 1 THEN 'down?
249.                 IF (hlite + 1) + page * maxHeight + lba <= uba THEN 'ok to move up
250.                     IF hlite + 1 > maxHeight - 1 THEN
251.                         page = page + 1: hlite = 0: GOSUB update
252.                     ELSE
253.                         hlite = hlite + 1: GOSUB update
254.                     END IF
255.                 END IF
256.             END IF
257.         WEND
258.         mx = INT((_MOUSEX - locateColumn * 8) / 8) + 2: my = INT((_MOUSEY - locateRow * 16) / 16) + 2
259.         IF _MOUSEBUTTON(1) THEN 'click contols or select array item
260.             'clear mouse clicks
261.             mb = _MOUSEBUTTON(1)
262.             IF mb THEN 'clear it
263.                 WHILE mb 'OK!
264.                     IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
265.                     _LIMIT 100
266.                 WEND
267.             END IF
268.  
269.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
270.                 choice = my + page * maxHeight + lba - 1 'select item clicked
271.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = 0 THEN 'page up or exit
272.                 IF my = 0 AND (mx <= maxWidth AND mx >= maxWidth - 2) THEN 'exit sign
273.                     EXIT DO 'escape plan for mouse click top right corner of display box
274.                 ELSE 'PgUp bar clicked
275.                     IF (page - 1) * maxHeight + lba >= lba THEN page = page - 1: GOSUB update
276.                 END IF
277.             ELSEIF mx >= 1 AND mx <= maxWidth AND my = maxHeight + 1 THEN 'page down bar clicked
278.                 IF (page + 1) * maxHeight + lba <= uba THEN page = page + 1: GOSUB update
279.             END IF
280.         ELSE '   mouse over highlighting, only if mouse has moved!
281.             IF mx >= 1 AND mx <= maxWidth AND my >= 1 AND my <= maxHeight THEN
282.                 IF mx <> lastMX OR my <> lastMY THEN
283.                     IF my - 1 <> hlite AND (my - 1 + page * maxHeight + lba <= uba) THEN
284.                         hlite = my - 1
285.                         lastMX = mx: lastMY = my
286.                         GOSUB update
287.                     END IF
288.                 END IF
289.             END IF
290.         END IF
291.         _LIMIT 200
292.     LOOP UNTIL choice >= lba AND choice <= uba
293.     getArrayItemNumber& = choice
294.     COLOR fg, bg
295.     'clear key presses
296.     _KEYCLEAR
297.     LOCATE curRow, curCol
298.     'clear mouse clicks
299.     mb = _MOUSEBUTTON(1)
300.     IF mb THEN 'clear it
301.         WHILE mb 'OK!
302.             IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
303.             _LIMIT 100
304.         WEND
305.     END IF
306.     EXIT SUB
307.  
308.     update: '--------------- display of array sections and controls on screen
309.  
310.     'fix hlite if it has dropped below last array item
311.     WHILE hlite + page * maxHeight + lba > uba
312.         hlite = hlite - 1
313.     WEND
314.  
315.     'main display of array items at page * maxHeight (lines high)
316.     FOR row = 0 TO maxHeight - 1
317.         IF hlite = row THEN COLOR _RGB(200, 200, 255), _RGB32(0, 0, 88) ELSE COLOR _RGB32(0, 0, 88), _RGB(200, 200, 255)
318.         LOCATE locateRow + row, locateColumn: PRINT clrStr$
319.         index = row + page * maxHeight + lba
320.         IF index >= lba AND index <= uba THEN
321.             LOCATE locateRow + row, locateColumn
322.             PRINT LEFT$(LTRIM$(STR$(index)) + ") " + arr(index), maxWidth)
323.         END IF
324.     NEXT
325.  
326.     'make page up and down bars to click, print PgUp / PgDn if available
327.     COLOR _RGB32(200, 200, 255), _RGB32(0, 100, 50)
328.     LOCATE locateRow - 1, locateColumn: PRINT SPACE$(maxWidth)
329.     IF page <> 0 THEN LOCATE locateRow - 1, locateColumn: PRINT LEFT$(" Pg Up" + SPACE$(maxWidth), maxWidth)
330.     LOCATE locateRow + maxHeight, locateColumn: PRINT SPACE$(maxWidth)
331.     IF page <> INT(uba / maxHeight) THEN
332.         LOCATE locateRow + maxHeight, locateColumn: PRINT LEFT$(" Pg Dn" + SPACE$(maxWidth), maxWidth)
333.     END IF
334.     'make exit sign for mouse click
335.     COLOR _RGB32(255, 255, 255), _RGB32(200, 100, 0)
336.     LOCATE locateRow - 1, locateColumn + maxWidth - 3
337.     PRINT " X "
338.  
339.     'if a number selection has been started show it's build = b$
340.     IF LEN(b$) THEN
341.         COLOR _RGB(255, 255, 0), _RGB32(0, 0, 0)
342.         LOCATE locateRow + maxHeight, locateColumn + maxWidth - LEN(b$) - 1
343.         PRINT b$;
344.     END IF
345.     _DISPLAY
346.     _LIMIT 100
347.     RETURN
348. END FUNCTION
349.  
350. ' for saving and restoring screen settins
351. SUB scnState (restoreTF AS INTEGER) 'Thanks Steve McNeill
352.     STATIC Font AS LONG, DefaultColor AS _UNSIGNED LONG, BackGroundColor AS _UNSIGNED LONG, Dest AS LONG, Source AS LONG
353.     STATIC row AS INTEGER, col AS INTEGER, autodisplay AS INTEGER, mb AS INTEGER
354.     IF restoreTF THEN
355.         _FONT Font
356.         COLOR DefaultColor, BackGroundColor
357.         _DEST Dest
358.         _SOURCE Source
359.         LOCATE row, col
360.         IF autodisplay THEN _AUTODISPLAY ELSE _DISPLAY
361.         _KEYCLEAR
362.         WHILE _MOUSEINPUT: WEND 'clear mouse clicks
363.         mb = _MOUSEBUTTON(1)
364.         IF mb THEN
365.             DO
366.                 WHILE _MOUSEINPUT: WEND
367.                 mb = _MOUSEBUTTON(1)
368.                 _LIMIT 100
369.             LOOP UNTIL mb = 0
370.         END IF
371.     ELSE
372.         Font = _FONT: DefaultColor = _DEFAULTCOLOR: BackGroundColor = _BACKGROUNDCOLOR
373.         Dest = _DEST: Source = _SOURCE
374.         row = CSRLIN: col = POS(0): autodisplay = _AUTODISPLAY
375.     END IF
376. END SUB
377.  
378.  

You will have to test the selected file for the proper extension.

[NOVARSEG]

BMP slide show.  Copy the 4 attached files into a folder to make this work. (3 BMP images and 1 EXE)

Here is the source code BAS file

Code: QB64: [Select]

1. _TITLE "BMP slide show.   Press ESC to exit"
2.  
3.  
4. DECLARE CUSTOMTYPE LIBRARY ".\direntry"
5.     FUNCTION load_dir& (s AS STRING)
6.     FUNCTION has_next_entry& ()
7.     SUB close_dir ()
8.     SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
9. END DECLARE
10.  
11. DIM flags AS LONG
12. DIM length AS LONG
13. DIM NAM AS STRING
14. DIM F(100) AS STRING
15. DIM Fcount AS INTEGER
16. DIM Fmax AS INTEGER
17. DIM L AS _UNSIGNED LONG
18. DIM I AS _UNSIGNED INTEGER
19. DIM C AS _UNSIGNED LONG
20. DIM H AS _UNSIGNED LONG
21. DIM W AS _UNSIGNED LONG
22. DIM R AS _UNSIGNED LONG
23. DIM OF AS _UNSIGNED LONG
24. DIM N AS _UNSIGNED LONG
25. DIM tt AS STRING * 4
26. DIM t AS STRING * 3
27. DIM handle AS LONG
28. DIM t1 AS SINGLE
29. DIM t2 AS SINGLE
30.  
31. IF load_dir("." + CHR$(0)) = -1 THEN 'found "." this is a folder  not a root drive
32.  
33.     DO
34.         length = has_next_entry
35.         IF length = -1 THEN
36.             '_FULLSCREEN
37.             PRINT "NO more files to process"
38.             EXIT DO
39.         END IF
40.  
41.         IF length > -1 THEN
42.             NAM$ = SPACE$(length)
43.             get_next_entry NAM, flags, file_size
44.  
45.             IF (flags XOR 2) = 0 AND UCASE$(RIGHT$(NAM, 3)) = "BMP" THEN
46.                 PRINT NAM + "                  "
47.                 Fcount = Fcount + 1
48.                 F(Fcount) = NAM
49.             END IF
50.  
51.         END IF
52.  
53.     LOOP
54.     Fmax = Fcount
55.  
56. END IF ''''IF load_dir("." + CHR$(0)) = -1 THEN
57.  
58. close_dir '
59.  
60.  
61. Fcount = 0
62.  
63. DO
64.     N = 0
65.  
66.     Fcount = Fcount + 1
67.     OPEN F(Fcount) FOR BINARY AS #1
68.     IF Fcount = Fmax THEN Fcount = 0
69.  
70.     GET #1, 11, OF
71.     'PRINT "Offset to picture data"; OF
72.  
73.     GET #1, 15, L
74.     ' PRINT "Header size "; L
75.  
76.     GET #1, , W
77.     ' PRINT "image width "; W
78.  
79.     GET #1, , H
80.     'PRINT "image height "; H
81.  
82.     GET #1, , I
83.  
84.  
85.     GET #1, , I
86.     ' PRINT "bits per pixel "; I
87.     'PRINT
88.  
89.     IF I = 32 THEN: _FULLSCREEN: PRINT "Can't process 32 bit per pixel BMP": CLOSE: GOTO LL1
90.     IF I <> 24 THEN PRINT "Not a 24 bit per pixel BMP": CLOSE: GOTO LL1
91.  
92.     DIM a AS _MEM
93.     handle = _NEWIMAGE(W, H, 32)
94.     a = _MEMIMAGE(handle)
95.  
96.  
97.  
98.     FOR R = H - 1 TO 0 STEP -1
99.  
100.         FOR C = 1 TO W * 3 STEP 3
101.             GET #1, R * W * 3 + C + OF, t
102.             tt = t + CHR$(255)
103.             _MEMPUT a, a.OFFSET + N, tt
104.             N = N + 4
105.         NEXT C
106.  
107.     NEXT R
108.  
109.     SCREEN _NEWIMAGE(W, H, 32)
110.     _PUTIMAGE (0, 0), handle
111.     _MEMFREE a
112.  
113.     LL1:
114.     t1 = TIMER
115.     DO
116.         _LIMIT 100
117.         t2 = TIMER
118.         IF t2 - t1 >= 2 THEN EXIT DO
119.         i$ = INKEY$
120.         IF i$ = CHR$(27) THEN END
121.     LOOP
122.     CLOSE
123.  
124. LOOP
125.  
126. END

OK there is the pics hmm not much use for the program if you can see the pics ????

[Dav]

Works for me here.  Nice to see someone latch onto an programming idea and not stop till it gets done.

- Dav