BMP picture viewer

[bplus]

@NOVARSEG

Wow nice job re-interpreting the library for files/folders and using direntry.h !

And those 3 photos are gorgeous!

Thanks for providing files to test, now working, I made some mods you might like for slide show app:

Code: QB64: [Select]

1. _TITLE "BMP slide show.   Press ESC to exit" ' got it to display can I get it to load
2.  
3. DECLARE CUSTOMTYPE LIBRARY ".\direntry"
4.     FUNCTION load_dir& (s AS STRING)
5.     FUNCTION has_next_entry& ()
6.     SUB close_dir ()
7.     SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
8. END DECLARE
9.  
10. DIM flags AS LONG
11. DIM length AS LONG
12. DIM NAM AS STRING
13. DIM F(100) AS STRING
14. DIM Fcount AS INTEGER
15. DIM Fmax AS INTEGER
16. IF load_dir("." + CHR$(0)) = -1 THEN 'found "." this is a folder  not a root drive
17.     DO
18.         length = has_next_entry
19.         IF length = -1 THEN
20.             EXIT DO
21.         END IF
22.         IF length > -1 THEN
23.             NAM$ = SPACE$(length)
24.             get_next_entry NAM, flags, file_size
25.             IF (flags XOR 2) = 0 AND UCASE$(RIGHT$(NAM, 3)) = "BMP" THEN
26.                 PRINT NAM + "                  "
27.                 Fcount = Fcount + 1
28.                 F(Fcount) = NAM
29.             END IF
30.         END IF
31.     LOOP
32.     Fmax = Fcount
33. END IF ''''IF load_dir("." + CHR$(0)) = -1 THEN
34. close_dir '
35.  
36. SCREEN _NEWIMAGE(1240, 740, 32) ' as big as I can go for my laptop
37. _DELAY .25
38. _SCREENMOVE _MIDDLE
39. COLOR , &HFF000033
40. CLS
41. Fcount = 0
42. DO
43.     Fcount = Fcount + 1
44.     image& = loadBMP24&(F(Fcount))
45.     IF image& <> 0 THEN
46.         _TITLE F(Fcount) + " press any for next image..."
47.         _PUTIMAGE ((_WIDTH - _WIDTH(image&)) / 2, (_HEIGHT - _HEIGHT(image&)) / 2)-STEP(_WIDTH(image&), _HEIGHT(image&)), image&, 0
48.         IF Fcount = Fmax THEN Fcount = 0
49.         SLEEP
50.         _FREEIMAGE image&
51.         CLS
52.     END IF
53. LOOP
54.  
55. FUNCTION loadBMP24& (Filename$)
56.     DIM OF AS _UNSIGNED LONG
57.     DIM L AS _UNSIGNED LONG
58.     DIM W AS _UNSIGNED LONG
59.     DIM H AS _UNSIGNED LONG
60.     DIM I AS _UNSIGNED INTEGER
61.     DIM R AS _UNSIGNED LONG
62.     DIM C AS _UNSIGNED LONG
63.     DIM N AS _UNSIGNED LONG
64.     DIM a AS _MEM
65.     DIM handle AS LONG
66.     DIM dh AS LONG
67.     DIM tt AS STRING * 4
68.     DIM t AS STRING * 3
69.     IF RIGHT$(UCASE$(Filename$), 4) <> ".BMP" THEN EXIT FUNCTION
70.     OPEN Filename$ FOR BINARY AS #1
71.     GET #1, 11, OF
72.     GET #1, 15, L
73.     GET #1, , W
74.     GET #1, , H
75.     GET #1, , I
76.     GET #1, , I 'get I twice ???
77.     IF I <> 24 THEN EXIT FUNCTION
78.     handle = _NEWIMAGE(W, H, 32)
79.     a = _MEMIMAGE(handle)
80.     FOR R = H - 1 TO 0 STEP -1
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.     NEXT R
88.     CLOSE
89.     dh = _NEWIMAGE(W, H, 32)
90.     _PUTIMAGE (0, 0), handle, dh
91.     loadBMP24& = dh
92.     _MEMFREE a
93. END SUB
94.  

My main purpose was to get that FUNCTION working so we can explore the whole hard disk with Tiny Navigator File Retriever and maybe other image displaying routines or file management things.

EDIT: Oh I am going to need a check last 4 chars = BMP in that function because I won't be screening for that first as you had. Fixed.

[SMcNeill]

I see you have a question about getting I twice in your code, @bplus.  Here’s basically what you’re fetching, in the header of all BMP files:

Code: QB64: [Select]

1. TYPE BMPEntry              ' Description                          Bytes    QB64 Function
2.    ID AS STRING * 2        ' File ID("BM" text or 19778 AS Integer) 2      CVI("BM")
3.    Size AS LONG            ' Total Size of the file                 4      LOF
4.    Res1 AS INTEGER         ' Reserved 1 always 0                    2
5.    Res2 AS INTEGER         ' Reserved 2 always 0                    2
6.    Offset AS LONG          ' Start offset of image pixel data       4      (add one for GET)
7. END TYPE                   '                                 Total 14
8.  
9. TYPE BMPHeader          'BMP header also used in Icon and Cursor files(.ICO and .CUR)
10.    Hsize AS LONG           ' Info header size (always 40)           4
11.    PWidth AS LONG          ' Image width                            4      _WIDTH(handle&)
12.    PDepth AS LONG          ' Image height (doubled in icons)        4      _HEIGHT(handle&)
13.    Planes AS INTEGER       ' Number of planes (normally 1)          2
14.    BPP AS INTEGER          ' Bits per pixel(palette 1, 4, 8, 24)    2      _PIXELSIZE(handle&)
15.    Compression AS LONG     ' Compression type(normally 0)           4
16.    ImageBytes AS LONG      ' (Width + padder) * Height              4
17.    Xres AS LONG            ' Width in PELS per metre(normally 0)    4
18.    Yres AS LONG            ' Depth in PELS per metre(normally 0)    4
19.    NumColors AS LONG       ' Number of Colors(normally 0)           4       2 ^ BPP
20.    SigColors AS LONG       ' Significant Colors(normally 0)         4
21. END TYPE                   '                 Total Header bytes =  40  

And if you want to know more about decoding them from there, let me know.  ;)

That first I you’re getting is for number of planes; second I is for bits per pixel.

[bplus]

Thanks Steve, so that is how the 24 style BMP is detected.

Almost have Navigator ready to see if I have any  more of these special BMP's on my Hard Drive, I suspect JB images might be?

[SMcNeill]

One thing I’m curious about here:  How do you keep from warping your image, without accounting for the padding in the image data?

Bitmaps are strict on how many bits they store per row, and they need to be multiples of 4.  If your image doesnt fit that criteria, you add padding to it.

Say a 4 pixel wide image would be stored as RGBRGBRGBRGB.  12 bytes per row, no padding is needed.

But a 3 pixel wide image is RGBRGBRGB — or only 9 bytes.  You tack 3 bytes of padding onto the end of it.

From what I can tell, it doesn’t seem like there’s any adjusting for the padding in the code?  Will what you’re doing work with non-size-4 images?

EDIT:

IF ((BMP.PWidth * 3) MOD 4) <> 0 THEN        '’need padding pixels
    Padding$ = SPACE$((4 - ((BMP.PWidth * 3) MOD 4)))
END IF

EDIT 2:
You should get the padding at line 86.5 in your code, at least, that’s my initial thoughts on it.

[bplus]

Yes now I can explore hard disk for BMP24 files and JB does use that format:

Code: QB64: [Select]

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

[SMcNeill]

Just read my edit above.  I believe you may run into issues with padding.  ;)

[bplus]

Just read my edit above.  I believe you may run into issues with padding.  ;)

I did read and he's using the 4 size only.

Do you have an image to demonstrate and test code and code fixes?

[SMcNeill]

I did read and he's using the 4 size only.

Do you have an image to demonstrate and test code and code fixes?

Grab the file below and give it a run.  It's only 638 pixels wide (non-4), so it requires end of line padding.

Here's a quick set of example code for you to study as well: 

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(1024, 800, 32)
2. handle = loadBMP24("non4.bmp")
3. _PUTIMAGE , handle
4.  
5. FUNCTION loadBMP24& (Filename$)
6.     DIM OF AS _UNSIGNED LONG
7.     DIM L AS _UNSIGNED LONG
8.     DIM W AS _UNSIGNED LONG
9.     DIM H AS _UNSIGNED LONG
10.     DIM I AS _UNSIGNED INTEGER
11.     DIM R AS _UNSIGNED LONG
12.     DIM C AS _UNSIGNED LONG
13.     DIM N AS _UNSIGNED LONG
14.     DIM a AS _MEM
15.     DIM handle AS LONG
16.     DIM dh AS LONG
17.     DIM tt AS STRING * 4
18.     DIM t AS STRING * 3
19.  
20.     IF RIGHT$(UCASE$(Filename$), 4) <> ".BMP" THEN EXIT FUNCTION
21.     PRINT Filename$
22.     OPEN Filename$ FOR BINARY AS #1
23.     GET #1, 11, OF
24.     GET #1, 15, L
25.     GET #1, , W
26.     GET #1, , H
27.     GET #1, , I
28.     GET #1, , I 'get I twice ???
29.     IF I <> 24 THEN EXIT FUNCTION
30.     handle = _NEWIMAGE(W, H, 32)
31.     a = _MEMIMAGE(handle)
32.     IF ((W * 3) MOD 4) <> 0 THEN '’need padding pixels
33.         Padding$ = SPACE$((4 - ((W * 3) MOD 4)))
34.     END IF
35.     'SEEK #1, OF 'go to the offset where the data starts
36.     FOR R = H - 1 TO 0 STEP -1
37.         FOR C = 1 TO W * 3 STEP 3
38.             GET #1, R * W * 3 + C + OF, t
39.             'GET #1, ,t 'get the data sequentially
40.             tt = t + CHR$(255)
41.             _MEMPUT a, a.OFFSET + N, tt
42.             N = N + 4
43.         NEXT C
44.         'GET #1, , Padding$ 'Get the padding at the end of the line
45.     NEXT R
46.     CLOSE
47.  
48.     dh = _NEWIMAGE(W, H, 32)
49.     _PUTIMAGE (0, 0), handle, dh
50.     loadBMP24& = dh
51.     _MEMFREE a
52. END SUB
53.  

Run it and you'll see the image distorted as heck.

Unremark out the lines I've got remarked and run it.  (Also remark out the current GET line of  GET #1, R * W * 3 + C + OF, t     , as we're replacing it with the one I have remarked.)

You should be able to easily see the difference.

Here's an image of what the program you have now displays, vs the original:

 

[bplus]

Well the alignment is good but stripe colors don't match (see attached)

Here is the FUNCTION I used with the modifications

Code: QB64: [Select]

1. FUNCTION loadBMP24& (Filename$)
2.     DIM OF AS _UNSIGNED LONG
3.     DIM L AS _UNSIGNED LONG
4.     DIM W AS _UNSIGNED LONG
5.     DIM H AS _UNSIGNED LONG
6.     DIM I AS _UNSIGNED INTEGER
7.     DIM R AS _UNSIGNED LONG
8.     DIM C AS _UNSIGNED LONG
9.     DIM N AS _UNSIGNED LONG
10.     DIM a AS _MEM
11.     DIM handle AS LONG
12.     DIM dh AS LONG
13.     DIM tt AS STRING * 4
14.     DIM t AS STRING * 3
15.     DIM padding$
16.     IF RIGHT$(UCASE$(Filename$), 4) <> ".BMP" THEN EXIT FUNCTION
17.     'PRINT Filename$
18.     OPEN Filename$ FOR BINARY AS #1
19.     GET #1, 11, OF
20.     GET #1, 15, L
21.     GET #1, , W
22.     GET #1, , H
23.     GET #1, , I
24.     GET #1, , I 'get I twice ???
25.     IF I <> 24 THEN EXIT FUNCTION
26.     handle = _NEWIMAGE(W, H, 32)
27.     a = _MEMIMAGE(handle)
28.     IF ((W * 3) MOD 4) <> 0 THEN '’need padding pixels
29.         padding$ = SPACE$((4 - ((W * 3) MOD 4)))
30.     END IF
31.     SEEK #1, OF 'go to the offset where the data starts
32.     FOR R = H - 1 TO 0 STEP -1
33.         FOR C = 1 TO W * 3 STEP 3
34.             'GET #1, R * W * 3 + C + OF, t
35.             GET #1, , t 'get the data sequentially
36.             tt = t + CHR$(255)
37.             _MEMPUT a, a.OFFSET + N, tt
38.             N = N + 4
39.         NEXT C
40.         GET #1, , padding$ 'Get the padding at the end of the line
41.     NEXT R
42.     CLOSE
43.  
44.     dh = _NEWIMAGE(W, H, 32)
45.     _PUTIMAGE (0, 0), handle, dh
46.     loadBMP24& = dh
47.     _MEMFREE a
48. END SUB
49.  
50.  

[SMcNeill]

Sorry.   A couple of little goofs on my part.

One was the SEEK.... I forgot to add 1 since binary files start at byte 1 and not 0.

    SEEK #1, OF + 1

Second is the face that it seems BMP files are stored bottom up, not top-down.  Just one of those many things I used to know, that I have to run into a little BLIP to remind myself of.   

Change the SEEK like above, and run it.  You'll see your image reversed.  :P

The change the MEMPUT to where you put the data in from the end to the beginning, and you're good to go:

           _MEMPUT a, a.OFFSET + a.SIZE - N - 4, tt 



And I think that'll account for your padding, start the color at the proper  pixel to read the RGB right, and draw it in the proper order.

[SMcNeill]

I had to go back and look at my own little BMP Save routine, to try and sort this out.  Here's the relevant part of the code, where we read the image from memory to save to file:

        w& = _WIDTH(image&)
        DO
            y = y - 1: x = x1% - 1
            DO
                x = x + 1
                _MEMGET m, m.OFFSET + (w& * y + x) * 4, temp


y starts at the bottom of the screen, and moves up.
x starts at the left of the screen, and moves right.

I'm thinking what I posted above might mirror the image for you, accidently.  (Not that you'd notice in single color rows...)


Here's what I'm thinking you actually need to do this properly:

Code: QB64: [Select]

1.     IF I <> 24 THEN EXIT FUNCTION
2.     handle = _NEWIMAGE(W, H, 32)
3.     a = _MEMIMAGE(handle)
4.     IF ((W * 3) MOD 4) <> 0 THEN '’need padding pixels
5.         Padding$ = SPACE$((4 - ((W * 3) MOD 4)))
6.     END IF
7.     SEEK #1, OF + 1 'go to the offset where the data starts
8.     FOR R = H - 1 TO 0 STEP -1 'from the bottom to top
9.         FOR C = 0 TO W - 1 'left to right
10.             GET #1, , t 'get the data sequentially
11.             tt = t + CHR$(255)
12.             _MEMPUT a, a.OFFSET + (W * R + C) * 4, tt
13.         NEXT C
14.         GET #1, , Padding$ 'Get the padding at the end of the line
15.     NEXT R
16.     CLOSE
17.  

[NOVARSEG]

Thank you everyone for the nice comments!

bplus

 

GET #1, , I
    GET #1, , I 'get I twice ???

The first I  read 2 bytes (DIM I AS INTEGER)  which is biPlanes and I did not need that info, so skipped it

biPlanes   2   Must be 1
biBitCount   2   Bits per pixel - 1, 4, 8, 16, 24, or 32

The second I is bits per pixel and the viewer works only with 24 bits per pixel.
****
Another thing, in my source code, my comment looks to be wrong as I tried the code in the root of drive C and it worked. In the past I was able to detect whether code was run in the root or not and I will have to dig up some old code to see how that was done.

IF load_dir("." + CHR$(0)) = -1 THEN 'found "." this is a folder  not a root drive

****
Steve

In my viewer code I did not run into a padding issue.   If there was padding at the end of a row (scan line) then for sure my code would not work.   from http://www.dragonwins.com/domains/getteched/bmp/bmpfileformat.htm  Look at subheading "Pixel Data"  I'm really not sure if that is correct.

Will look into this "padding thing"


The only "padding" I did was adding that 4th byte at the end of a 24 bit pixel because

handle = _NEWIMAGE(W, H, 32)

expects a 32 bit pixel

****
Dav
 Glad it worked on your computer!!!

[NOVARSEG]

So I did some more researche

from https://homepages.inf.ed.ac.uk/rbf/BOOKS/PHILLIPS/cips2ed.pdf

The BMP color table has four bytes in each color table entry. The bytes
are for the blue, green, and red color values. The fourth byte is padding and
is always zero. For a 256 gray shade image, the color table is 4x256 bytes
long. The blue, green, and red values equal one another.
The final part of the BMP file is the image data. The data is stored row
by row with padding on the end of each row. The padding ensures the image
rows are multiples of four. The four, just like in the color table, makes it
easier to read blocks and keep track of addresses.

Now I'm really confused. You could have any number of bytes per scan line as long as they are a multiple of 3 (24 bit BMP).  I don't see the reason for padding in a 24 bit BMP???

If there was in fact padding at the end of a 24 bit BMP scan line, then my viewer code would not work.

As the above quote says

makes it easier to read blocks and keep track of addresses.

HUH? file pointers have BYTE resolution

Addresses WHAT , all we need to know is the offset from start of file to pixel data.

[SMcNeill]

It’s like I told you:

You do one row at a time, starting at bottom left, to bottom right.
At the end of that row, you have padding to make it a length divisible by 4.
Then you go up to the line above it and repeat, until you reach the top.


You don’t need to worry about the color table reference, as that’s for other color modes.

[NOVARSEG]

Ya but I did not have to adjust for "padding" in my code . If there are padding bytes at the end of a scan line then the padding byte don't contain pixel data.  The file pointer (GET, point, . . .) is supposed to point to pixel data only

In a, say, 1024 * 768  24 bit BMP there are exactly 1024 * 3 bytes per scan line. That is what my code is saying.  If there was actually padding bytes at the end of a scan line then surely I would have found them.