Need a little help with updating a FileSelect function.

Code: (Select All)
'====================

'FILESELECT-FILES.BAS  v1.00

'====================

'A simple file selector box function using _FILES$.

'Coded by Dav for QB64-PE, OCT/2024



'Lists files in current directory in a scroll box.



'Use arrows, page up/down, home/end to navigate.

'ENTER selects highlighted filename, ESC cancels.



'Selecting a directory will navigate to that

'directory and list files under it.



'Background screen is preserved and restored.



'Works under windows & Linux (havent tested Mac).

'Works in text and graphical screen modes.

'



'=== DEMO FOLLOWS...



Screen _NewImage(700, 500, 32)

_ScreenMove _Middle



'=== draw a background



Cls , _RGB(32, 32, 32)

For x = 1 To _Width Step 3

    For y = 1 To _Height Step 3

        PSet (x, y), _RGB(Rnd * 255, Rnd * 255, Rnd * 255)

    Next

Next



Print "Use arrows to navigate to a filename.  "

Print "Press ENTER to select highlighted file."

Print "Press ESC to cancel and close file box."



'=== Define filebox colors here...



fsborder& = _RGB(255, 0, 0) 'filebox order color

fsfile& = _RGB(255, 255, 255) 'filename color

fsdir& = _RGB(255, 255, 64) 'directories color

fsback& = _RGB(64, 0, 0) 'Background color

fshigh& = _RGB(255, 255, 128) 'highlighted line color



'=== Ask user to select a file



a$ = FileSelect$(5, 15, 20, 55, "*", fsborder&, fsback&, fsfile&, fsdir&, fshigh&)



'=== Show results...



Print

If a$ <> "" Then

    Print "You selected: "; a$

Else

    Print "No file selected."

End If



End





Function FileSelect$ (y, x, y2, x2, Filespec$, fsborder&, fsback&, fsfile&, fsdir&, fshigh&)

    'FileSelect$ function by Dav, OCT/2024



    'This function returns a selected filename.



    'Show files in current directory in a scroll box.

    'Use arrows, page up/down, home/end to navigate.

    'ENTER selects highlighted filename, ESC cancels.

    'Selecting a directory will navigate to that dir

    'and list files under that directory.



    'y,x = top left of box

    'y2,x2 = bottom right of box

    'Filespec$ = spec of files to list in box

    'fsborder& = color of box border

    'fsback& = background color of file box.

    'fsfile& = color of filenames

    'fsdir& = color of directories

    'fshigh& = color of highlighted line

    '=================================================



    '=== save original place of cursor

    origy = CsrLin

    origx = Pos(1)



    '=== save colors

    fg& = _DefaultColor

    bg& = _BackgroundColor



    '=== Save whole screen

    Dim scr1 As _MEM, scr2 As _MEM

    scr1 = _MemImage(0): scr2 = _MemNew(scr1.SIZE)

    _MemCopy scr1, scr1.OFFSET, scr1.SIZE To scr2, scr2.OFFSET



    '========

    loadagain:

    '=======



    '=== get total file + dir count

    c = 0

    x$ = _Files$(Filespec$)

    Do

        If x$ = "" Then Exit Do

        c = c + 1

        x$ = _Files$

    Loop



    'if no files found, at least add 1 for ".."

    If c = 0 Then c = 1



    '=== make room for names

    ReDim FileNames$(0 To c)



    '=== first line always go up a directory

    FileNames$(0) = ".."

    LineCount = 1



    '=== get dir names first, add to Filename$ array

    x$ = _Files$(Filespec$)

    Do

        If x$ = "" Then Exit Do

        'skip "." and ".." from this list

        If x$ = "./" Or x$ = ".\" Then GoTo jump

        If x$ = "../" Or x$ = "..\" Then GoTo jump

        If Right$(x$, 1) = "/" Or Right$(x$, 1) = "\" Then

            FileNames$(LineCount) = "[" + Left$(x$, Len(x$) - 1) + "]"

            LineCount = LineCount + 1

        End If

        jump:

        x$ = _Files$

    Loop



    '=== get file names next, add to Filename$ array

    x$ = _Files$(Filespec$)

    Do

        If x$ = "" Then Exit Do

        'skip all dir this time

        If Right$(x$, 1) = "/" Or Right$(x$, 1) = "\" Then

            ' do nothing

        Else

            FileNames$(LineCount) = x$

            LineCount = LineCount + 1

        End If

        x$ = _Files$

    Loop





    '=== draw a box

    Color fsborder&

    For L = 0 To y2 + 1

        Locate y + L, x: Print String$(x2 + 4, Chr$(219));

    Next



    '=== show current working dir at top

    Color fsfile&, fsborder&

    CurDir$ = _CWD$

    '=== Shorten it is too long, for display purposes

    If Len(CurDir$) > x2 - x Then

        CurDir$ = Mid$(CurDir$, 1, x2 - x - 3) + "..."

    End If

    Locate y, x + 2: Print CurDir$;





    '=== scroll through list...

    top = 0: selection = 0



    Do



        For L = 0 To (y2 - 1)



            Locate (y + 1) + L, (x + 2)



            topl = top + L: If topl > LineCount Then topl = LineCount



            If topl = selection Then

                Color fsback&, fshigh& 'selected line

            Else

                Color fsfile&, fsback& 'regular

                '=== directories get a different color...

                If Mid$(FileNames$(topl), 1, 1) = "[" Then

                    Color fsdir&, fsback&

                End If

            End If

            Print Left$(FileNames$(topl) + String$(x2, " "), x2);

        Next



        '=== Get user input

        Do

            k$ = InKey$: _Limit 30

        Loop Until k$ <> ""



        Select Case k$



            Case Is = Chr$(0) + Chr$(72) 'Up arrow

                If selection > 0 Then selection = selection - 1

                If selection < top Then top = selection



            Case Is = Chr$(0) + Chr$(80) 'Down Arrow

                If selection < (LineCount - 1) Then selection = selection + 1

                If selection > (top + (y2 - 2)) Then top = selection - y2 + 1



            Case Is = Chr$(0) + Chr$(73) 'Page up

                top = top - y2

                selection = selection - y2

                If top < 0 Then top = 0

                If selection < 0 Then selection = 0



            Case Is = Chr$(0) + Chr$(81) 'Page Down

                top = top + y2

                selection = selection + y2

                If top >= LineCount - y2 Then top = LineCount - y2

                If top < 0 Then top = 0

                If selection >= LineCount Then selection = LineCount - 1



            Case Is = Chr$(0) + Chr$(71) 'Home

                top = 0: selection = 0



            Case Is = Chr$(0) + Chr$(79) 'End

                selection = LineCount - 1

                top = selection - y2 + 1

                If top < 0 Then top = 0



            Case Is = Chr$(27) ' ESC cancels

                FileSelect$ = ""

                Exit Do



            Case Is = Chr$(13) 'Enter



                '=== if .. then go up one dir

                If RTrim$(FileNames$(selection)) = ".." Then

                    cd$ = _CWD$

                    If InStr(_OS$, "WIN") Then

                        cd$ = Left$(cd$, _InStrRev(cd$, "\"))

                    Else

                        cd$ = Left$(cd$, _InStrRev(cd$, "/"))

                    End If

                    ChDir cd$

                    Erase FileNames$

                    GoTo loadagain

                End If



                'see if directory

                test$ = RTrim$(FileNames$(selection))

                If Left$(test$, 1) = "[" Then

                    test$ = Mid$(test$, 2, Len(test$) - 2)

                    ChDir test$

                    Erase FileNames$

                    GoTo loadagain

                Else

                    If InStr(_OS$, "WIN") Then

                        If Right$(_CWD$, 1) = "\" Then

                            C$ = _CWD$

                        Else

                            C$ = _CWD$ + "\"

                        End If

                    Else

                        If Right$(_CWD$, 1) = "/" Then

                            C$ = _CWD$

                        Else

                            C$ = _CWD$ + "/"

                        End If

                    End If



                    FileSelect$ = C$ + RTrim$(FileNames$(selection))

                    Exit Do



                End If



        End Select



    Loop



    _KeyClear



    '=== Restore the whole screen

    _MemCopy scr2, scr2.OFFSET, scr2.SIZE To scr1, scr1.OFFSET

    _MemFree scr1: _MemFree scr2



    '=== restore original y,x and color

    Locate origy, origx



    Color fg&, bg&



End Function
'curr$ = the directory to check IF NOT _DIREXISTS(curr$) THEN IF LEN(curr$) = 3 AND RIGHT$(curr$, 2) = ":\" THEN 'is root ?? 'permission denied or no media in (removeable) drive ELSE 'path not found END IF ELSE IF LEN(curr$) > 3 OR MID$(curr$, 2, 1) <> ":" THEN 'is not root or relative ?? oldCurr$ = _CWD$ ON ERROR GOTO internalHandler lastErr% = 0 CHDIR curr$ ON ERROR GOTO 0 IF lastErr% = 0 THEN 'path is accessible ELSEIF lastErr% = 76 THEN 'permission denied END IF CHDIR oldCurr$ END IF END IF internalHandler: lastErr% = ERR RESUME NEXT