_Title "Pipecom Browser for BMP24 File Display" 'b+ testing one array system with pipecom ' Thanks to Spriggsy, Zak, for convincing me pipecom is better!
' Using Steve's fixed BMP24 loader
' Also thanks to Dav for 1 window for file and folder selection idea
' Also thanks to NOVARSEG who got me going on this for a better filename$ retriever
' 2021-02-10 Browser 2 update with LoadBMP24 Sub
' 2021-02-10 Browser 3, just _Loadimage
Do 'test our new function ScnState 0
col = 16: row = 3: charW = 128: charH = 40
myFile$ = GetFileName$(row, col, charW, charH)
ScnState -1 ' <<<<<<<<<<<<<<<<<<<<<<<<<<< this is supposed to restore back color
'image& = loadBMP24&(myFile$)
'loadBMP24 myFile$, W, H, image
_Title myFile$
+ " press any to get another BMP24 file image, esc to quit"
Function GetFileName$
(LocateR
, LocateC
, CharWide
, CharHigh
) ' < careful Locate Row, Col NOT x, y 'This Funtion needs:
' pipecom.h in same folder as QB64.exe
' This in main code section near top:
' Declare Library "pipecom"
' Function pipecom$ (cmd As String)
' End Declare
' sub Split source$, delimiter$, arr$()
' function GetArrayItem$(x, y, w, h, arr$())
Getfolder:
d = pipecom("dir /n /o:gend") '/n files on right (40) /o = order g for group dirs first, e extension, name, date
d
= Left$(d
, Len(d
) - 1) ' always ends with delimiter s = GetArrayItem$(LocateR, LocateC, CharWide, CharHigh, dir())
Color fc
, bc:
Cls ' will return empty string
curpos
= 1: arrpos
= LBound(loadMeArray
): LD
= Len(delim
) dpos
= InStr(curpos
, SplitMeString
, delim
) loadMeArray
(arrpos
) = Mid$(SplitMeString
, curpos
, dpos
- curpos
) arrpos = arrpos + 1
curpos = dpos + LD
dpos
= InStr(curpos
, SplitMeString
, delim
) loadMeArray
(arrpos
) = Mid$(SplitMeString
, curpos
)
' Help: all this I hope is intuitive so Help window is provided
' "Mouse, mouse wheel, and arrow keys should work as expected for item selection."
' "Press spacebar to select a highlighted item or just click it."
' "Use number(s) + enter to select an array item by it's index number,"
' "backspace will remove last number pressed, delete will clear a number started.
' "Numbers started are shown in bottom right PgDn bar."
' "Enter will also select the highlighted item, if no number has been started."
' "Home starts you at lowest array index, End highlights then highest index."
' "Use PgUp and PgDn keys to flip through pages of array items."
'
' Escape to Cancel Return "" else Return the selected string from the array
Function GetArrayItem$
(LocateRoww
, LocateColumn
, BoxWidth
, BoxHeight
, Arr
() As String) 'Notes: locateRow, locateColumn for top right corner of selection box on screen in characters for LOCATE.
'boxWidth and boxHeight are in character units, again for locate and print at correct places.
'All displaying is restricted to inside the box, which has PgUP and PgDn as top and bottom lines in the display.
ReDim As Long maxWidth
, maxHeight
, page
, hlite
, mx
, my
, locateRow
, lastMX
, lastMY
, row
, mb
'ScnState 0 ' use out side this function before and after
locateRow = LocateRoww + 1 'fix a miscalc in coding
maxWidth = BoxWidth ' number of characters in box
maxHeight = BoxHeight - 2 ' number of lines displayed of array at one time = 1 page
page = 0
hlite = 0 ' line in display ready for selection by spacebar or if no number is started, enter
clrStr$
= Space$(maxWidth
) 'clearing a display line
GoSub update
' show the beginning of the array items for selection choice = -1719
Do 'until get a selection or demand exit
'handle the key stuff
ElseIf kh&
= 13 Then 'enter pressed check if number is being entered? Else 'clear b$ to show some response to enter b$
= "":
GoSub update
'clear the value that doesn't work choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
Exit Do 'escape clause offered to Cancel selection process choice = hlite + page * maxHeight + lba 'best way to choose highlighted selection
Select Case kh&
'choosing sections of array to display and highlighted item Case 21248 ' delete so clear b$ If (page
+ 1) * maxHeight
+ lba
<= uba
Then page
= page
+ 1:
GoSub update
If (page
- 1) * maxHeight
+ lba
>= lba
Then page
= page
- 1:
GoSub update
page
= page
- 1: hlite
= maxHeight
- 1:
GoSub update
hlite
= hlite
- 1:
GoSub update
If (hlite
+ 1) + page
* maxHeight
+ lba
<= uba
Then 'ok to move up If hlite
+ 1 > maxHeight
- 1 Then page
= page
+ 1: hlite
= 0:
GoSub update
hlite
= hlite
+ 1:
GoSub update
page
= 0: hlite
= 0:
GoSub update
page
= Int((uba
- lba
) / maxHeight
): hlite
= maxHeight
- 1:
GoSub update
'handle the mouse stuff
page
= page
- 1: hlite
= maxHeight
- 1:
GoSub update
hlite
= hlite
- 1:
GoSub update
If (hlite
+ 1) + page
* maxHeight
+ lba
<= uba
Then 'ok to move up If hlite
+ 1 > maxHeight
- 1 Then page
= page
+ 1: hlite
= 0:
GoSub update
hlite
= hlite
+ 1:
GoSub update
'clear mouse clicks
choice = my + page * maxHeight + lba - 1 'select item clicked
If my
= 0 And (mx
<= maxWidth
And mx
>= maxWidth
- 2) Then 'exit sign Exit Do 'escape plan for mouse click top right corner of display box If (page
- 1) * maxHeight
+ lba
>= lba
Then page
= page
- 1:
GoSub update
ElseIf mx
>= 1 And mx
<= maxWidth
And my
= maxHeight
+ 1 Then 'page down bar clicked If (page
+ 1) * maxHeight
+ lba
<= uba
Then page
= page
+ 1:
GoSub update
Else ' mouse over highlighting, only if mouse has moved! If my
- 1 <> hlite
And (my
- 1 + page
* maxHeight
+ lba
<= uba
) Then hlite = my - 1
lastMX = mx: lastMY = my
If choice
<> -1719 Then GetArrayItem$
= Arr
(choice
) 'set function and restore screen 'ScnState -1 'restore
'display of array sections and controls on screen ====================================================
update:
'fix hlite if it has dropped below last array item
While hlite
+ page
* maxHeight
+ lba
> uba
hlite = hlite - 1
'main display of array items at page * maxHeight (lines high)
For row
= 0 To maxHeight
- 1 If hlite
= row
Then Color _RGB(200, 200, 255), _RGB32(0, 0, 88) Else Color _RGB32(0, 0, 88), _RGB(200, 200, 255) index = row + page * maxHeight + lba
Locate locateRow
+ row
, LocateColumn
'make page up and down bars to click, print PgUp / PgDn if available
'make exit sign for mouse click
Locate locateRow
- 1, LocateColumn
+ maxWidth
- 3
'if a number selection has been started show it's build = b$
Locate locateRow
+ maxHeight
, LocateColumn
+ maxWidth
- Len(b$
) - 1
Sub ScnState
(restoreTF
As Long) 'Thanks Steve McNeill should we get a snap shot of screen? Static As Long font
, dest
, source
, row
, col
, autodisplay
, mb
, snap
Color defaultColor
, backGroundColor
If mb
Then 'need this if line ? If mb
Then 'need this if line ?