Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Need a little help with updating a FileSelect function.
#1
I'm updating my old FileSelect function to use _Files$ instead of SHELLing and making temp files to get file/dir info.  Working OK doing that (I think) but have a couple a questions using CHDIR with it.

If there a way to see if a directory is accessible before trying to navigate to it?  When I try to navigate to a directory with permissions it errors out.  I'd like to not allow user to open those directories.  

Also, what is a good way (cross-platform) to see if the user is at the root directory?

Here's the code I'm working on.  Thanks.

- Dav 

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

Find my programs here in Dav's QB64 Corner
Reply


Messages In This Thread
Need a little help with updating a FileSelect function. - by Dav - 10-11-2024, 12:33 PM



Users browsing this thread: 4 Guest(s)