'** Use this sub-program to select a file(s)

DIM SHARED PgmFile$: PgmFile$ = "~OpenFile.tmp"
DIM SHARED GoUp$: GoUp$ = CHR$(0) + CHR$(72)
DIM SHARED GoDown$: GoDown$ = CHR$(0) + CHR$(80)
DIM SHARED GoLeft$: GoLeft$ = CHR$(0) + CHR$(75)
DIM SHARED GoRight$: GoRight$ = CHR$(0) + CHR$(77)
DIM SHARED PageUp$: PageUp$ = CHR$(0) + CHR$(73)
DIM SHARED PageDown$: PageDown$ = CHR$(0) + CHR$(81)
DIM SHARED Delete$: Delete$ = CHR$(0) + CHR$(83)
DIM SHARED Home$: Home$ = CHR$(0) + CHR$(71)
DIM SHARED End$: End$ = CHR$(0) + CHR$(79)

DIM SHARED lines, CharsAcross, ScrnW, ScrnH, path$, HideExtn
DIM SHARED TotalRecs, LastOnScreen, ViewMode$, CharsPerCol
DIM SHARED ListIdx, ListPP, ListStr, ItemsPerCol, ItemsPerPage
DIM SHARED SltFolders, ColP(80), stringW, MultiSelect

'+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
DIM SHARED ASCIIclrRd(15), ASCIIclrGr(15), ASCIIclrBl(15)
ff = FREEFILE: OPEN "ASCII_RGB.ini" FOR INPUT AS #ff
FOR clr = 0 TO 15
    INPUT #ff, clr, ASCIIclrRd(clr), ASCIIclrGr(clr), ASCIIclrBl(clr)
NEXT
CLOSE ff
'+-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

ViewMode$ = "D" 'default view mode
ListIdx = 1
ListStr = 1
ItemsPerCol = 25

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
TYPE structure1
    FileFullName AS STRING * 50
    FileName AS STRING * 50
    FileType AS STRING * 3
    FileBytes AS STRING * 15
    FileDateTime AS STRING * 20
    FileDim AS STRING * 10
    FileSelect AS INTEGER
END TYPE
DIM SHARED RecData AS structure1
DIM SHARED FileStats$: FileStats$ = "~OpenFileStats.tmp"
'-----------------------------------------------------------------
tf$ = "~RecLenChk.tmp": SHELL "erase " + tf$
OPEN tf$ FOR BINARY AS #1: PUT #1, 1, RecData: CLOSE 1
DIM SHARED RecLen
OPEN tf$ FOR BINARY AS #1: RecLen = LOF(1): CLOSE 1
''PRINT RecLen: END
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

'-------------------------------------------------------------------------
IF 11 = 1 THEN
    title$ = "--just a test"
    'path$ = "C:\Users\Paul Layfield\Documents\QB64-2\PuzzleImages"
    'wildcard$ = "*.jpg"
    path$ = "C:\Users\Paul Layfield\Documents\QB64-2"
    wildcard$ = "*.bas"
    OPEN PgmFile$ FOR OUTPUT AS #1
    WRITE #1, title$
    WRITE #1, path$
    WRITE #1, wildcard$
    WRITE #1, 20 'characters per column (for List mode)
    prms$ = ""
    prms$ = prms$ + " /HideExtn " 'do not show file extensions
    prms$ = prms$ + " /list " 'List mode
    'prms$ = prms$ + " /multi " 'multi-select mode
    'prms$ = prms$ + " /folders " 'show folders to select
    WRITE #1, prms$
    CLOSE 1
    testing = 1
END IF
'-------------------------------------------------------------------------

LoadFilenamesAndStats

SetScreen:

SetItemsPerPage

CLS
ShowList

'-- Main Loop ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

DO

    k$ = UCASE$(INKEY$)

    DO WHILE _MOUSEINPUT ' get latest mouse information
    LOOP
    x% = _MOUSEX: mx = x%
    y% = _MOUSEY: my = y%
    LeftClick% = _MOUSEBUTTON(1) ' retrieve left button status
    RightClick% = _MOUSEBUTTON(2) ' retrieve right button status
    ''LOCATE 1, 1: PRINT mx; my
    IF LeftClick% = -1 THEN
        IF clkd = 0 THEN
            TestClickPos mx, my, k$
            ''IF reload THEN GOTO SetTheScreen
            clkd = 1
        END IF
    ELSE
        clkd = 0
    END IF

    SELECT CASE k$

        CASE CHR$(27): EXIT DO

        CASE CHR$(9) 'alternate Detail and List mode
            IF ViewMode$ = "D" THEN
                ViewMode$ = "L"
            ELSE
                ViewMode$ = "D"
            END IF
            GOTO SetScreen

        CASE PageUp$
            IF ListStr > 1 THEN
                ListIdx = ListIdx - ItemsPerPage
                ListStr = ListStr - ItemsPerPage
                IF ListStr < 1 THEN
                    ListIdx = 1
                    ListStr = 1
                END IF
                ShowList
            END IF

        CASE PageDown$
            IF LastOnScreen < TotalRecs THEN
                ListIdx = ListIdx + ItemsPerPage
                ListStr = ListStr + ItemsPerPage
                IF ListIdx > TotalRecs THEN ListIdx = TotalRecs
                ShowList
            END IF

        CASE GoUp$
            IF ListIdx > 1 THEN
                ListIdx = ListIdx - 1
                IF ListIdx < ListStr THEN
                    ListStr = ListStr - 1
                END IF
                ShowList
            END IF

        CASE GoDown$
            IF ListIdx < TotalRecs THEN
                ListIdx = ListIdx + 1
                IF ListIdx > LastOnScreen THEN
                    ListStr = ListStr + 1
                END IF
                ShowList
            END IF

        CASE Home$
            ListIdx = 1
            IF ListIdx < ListStr THEN ListStr = 1
            ShowList

        CASE End$
            ListIdx = TotalRecs
            IF ListIdx > LastOnScreen THEN ListStr = ListIdx
            ShowList

        CASE GoLeft$
            ListIdx = ListIdx - ItemsPerCol
            IF ListIdx < 1 THEN ListIdx = 1
            IF ListIdx < ListStr THEN
                ListStr = ListStr - ItemsPerCol
                IF ListStr < 1 THEN ListStr = 1
            END IF
            ShowList

        CASE GoRight$
            IF ListIdx + ItemsPerCol <= TotalRecs THEN
                ListIdx = ListIdx + ItemsPerCol
                IF ListIdx > LastOnScreen THEN
                    ListStr = ListStr + ItemsPerCol
                END IF
                ShowList
            END IF

        CASE " "
            IF MultiSelect THEN
                MultiSelectChg
            END IF

        CASE CHR$(13): EXIT DO

        CASE ELSE
            IF k$ >= "A" AND k$ <= "Z" THEN
                SetPointer k$
            END IF

    END SELECT

LOOP

OPEN PgmFile$ FOR OUTPUT AS #1

IF k$ = CHR$(27) THEN
    WRITE #1, 0, k$
ELSE
    OPEN FileStats$ FOR RANDOM AS #2 LEN = RecLen
    IF MultiSelect THEN
        FOR i = 1 TO TotalRecs
            GET #2, i, RecData
            IF RecData.FileSelect = 1 THEN
                f$ = RecData.FileFullName
                f$ = RTRIM$(f$)
                WRITE #1, i, f$
            END IF
        NEXT
    ELSE
        GET #2, ListIdx, RecData
        CLOSE 2
        f$ = RecData.FileFullName
        f$ = RTRIM$(f$)
        WRITE #1, ListIdx, f$
    END IF
    CLOSE 2
END IF

CLOSE 1

IF testing THEN
    SHELL "notepad.exe " + PgmFile$
END IF

CLS
SYSTEM

SUB MultiSelectChg '####################################################

    OPEN FileStats$ FOR RANDOM AS #2 LEN = RecLen
    GET #2, ListIdx, RecData
    n = RecData.FileSelect
    IF n = 0 THEN
        n = 1
    ELSE
        n = 0
    END IF
    RecData.FileSelect = n
    PUT #2, ListIdx, RecData
    CLOSE 2

    ShowList

END SUB

SUB TestClickPos (mx, my, k$) '#################################################

    po = mx / 8
    x$ = LTRIM$(STR$(po))
    RemoveDecimal po
    IF INSTR(x$, ".") THEN po = po + 1

    li = my / 16
    x$ = LTRIM$(STR$(li))
    RemoveDecimal li
    IF INSTR(x$, ".") THEN li = li + 1

    p = 1
    FOR c = 1 TO 80
        IF ColP(c) = 0 THEN EXIT FOR

        IF po >= ColP(c) AND po <= ColP(c) + stringW - 1 THEN
            ''LOCATE 1, 1: PRINT "column:"; c
            row = li - 1

            IF row >= 1 AND row <= ItemsPerCol THEN

                rn = row + (ItemsPerCol * (c - 1))
                IF rn <= TotalRecs THEN

                    IF ListIdx = rn THEN
                        k$ = CHR$(13)
                    ELSE
                        ListIdx = rn
                        ShowList
                    END IF

                    EXIT FOR

                END IF

            END IF

        END IF

        p = p + stringW

    NEXT
END SUB


SUB SetItemsPerPage '####################################################

    lines = ItemsPerCol + 4
    ScrnH = lines * 16

    CharsAcross = 80 'does not change (?)
    ''CharsPerCol = 15 'varies ''fron input file
    columns = CharsAcross / CharsPerCol 'how many columns?
    RemoveDecimal columns
    IF ViewMode$ = "D" THEN
        'detail mode
        ItemsPerPage = ItemsPerCol
        ScrnW = CharsAcross * 8
    ELSE
        'list mode
        ItemsPerPage = ItemsPerCol * columns
        ''PRINT columns; ItemsPerPage: END
        ScrnW = (columns * CharsPerCol) * 8
    END IF

    SCREEN _NEWIMAGE(ScrnW, ScrnH, 32)


END SUB

SUB SetPointer (k$) '######################################################

    OPEN FileStats$ FOR RANDOM AS #2 LEN = RecLen

    FOR rn = 1 TO TotalRecs

        GET #2, rn, RecData
        f$ = RecData.FileFullName
        c$ = UCASE$(LEFT$(f$, 1))

        IF c$ = k$ THEN EXIT FOR

    NEXT

    CLOSE 2

    IF c$ <> k$ THEN EXIT SUB

    ListIdx = rn
    IF ListIdx > LastOnScreen THEN ListStr = rn
    IF ListIdx < ListStr THEN ListStr = rn
    ShowList


END SUB

SUB LoadFilenamesAndStats '################################################

    OPEN PgmFile$ FOR INPUT AS #1
    INPUT #1, title$
    INPUT #1, path$
    INPUT #1, wildcard$
    ''INPUT #1, ViewMode$
    INPUT #1, CharsPerCol
    INPUT #1, parms$
    CLOSE 1
    ViewMode$ = UCASE$(ViewMode$)

    parms$ = LCASE$(parms$)
    HideExtn = INSTR(parms$, "/hideextn")
    lm = INSTR(parms$, "/list"): IF lm THEN ViewMode$ = "L"
    SltFolders = INSTR(parms$, "/folders ")
    MultiSelect = INSTR(parms$, "/multi ")

    _TITLE title$

    IF path$ <> "" THEN
        IF RIGHT$(path$, 1) <> "\" THEN path$ = path$ + "\"
    END IF

    tf$ = "~~OPenFilelisting.tmp"
    q$ = CHR$(34)

    cmd$ = "dir " + q$ + path$ + wildcard$ + q$ + " >" + tf$
    ''PRINT cmd$
    SHELL cmd$
    ''SHELL "notepad.exe " + tf$: END

    SCREEN _NEWIMAGE(300, 300, 32)

    OPEN tf$ FOR INPUT AS #1
    OPEN FileStats$ FOR RANDOM AS #2 LEN = RecLen

    DO UNTIL EOF(1)

        LINE INPUT #1, X$

        IF SltFolders THEN
            p = INSTR(X$, "<DIR>")
            IF p = 0 THEN
                X$ = ""
            ELSE
                IF MID$(X$, 40, 1) = "." THEN X$ = ""
            END IF
        END IF

        IF MID$(X$, 3, 1) = "/" THEN
            GOSUB ProcessRecord
        END IF

    LOOP

    TotalRecs = rn
    PRINT rn

    CLOSE 1, 2

    EXIT SUB

    '=================================================================
    ProcessRecord:
    '=================================================================
    RecData.FileFullName = MID$(X$, 40, 50)
    n$ = RTRIM$(MID$(X$, 40, 50))
    FOR p = LEN(n$) TO 1 STEP -1
        IF MID$(n$, p, 1) = "." THEN EXIT FOR
    NEXT
    RecData.FileName = LEFT$(n$, p - 1)
    RecData.FileType = UCASE$(RIGHT$(n$, LEN(n$) - p))
    RecData.FileBytes = MID$(X$, 24, 15)
    RecData.FileDateTime = LEFT$(X$, 20)
    GOSUB ExtraStats
    rn = rn + 1
    PUT #2, rn, RecData
    RETURN

    '===================================================================
    ExtraStats:
    '===================================================================
    f$ = path$ + n$
    SELECT CASE RecData.FileType
        CASE "JPG", "BMP", "PNG"
            image& = _LOADIMAGE(f$)
            w% = _WIDTH(image&) '  get image width
            h% = _HEIGHT(image&) ' get image height
            z$ = LTRIM$(STR$(w%)) + "x" + LTRIM$(STR$(h%))
            RecData.FileDim = z$
    END SELECT
    RETURN

END SUB

SUB ShowList '##########################################################

    t$ = LEFT$(path$, CharsAcross)
    t$ = t$ + SPACE$(CharsAcross - LEN(t$))
    Fclr& = _RGB32(255, 255, 255)
    Bclr& = _RGB32(127, 6, 127)
    COLOR Fclr&, Bclr&
    LOCATE 1, 1: PRINT t$

    IF MultiSelect THEN
        x$ = "*Multi*"
        p = CharsAcross - LEN(x$)
        LOCATE 1, p
        asciiCOLOR 0, 15
        PRINT x$
    END IF

    l = 2
    p = 1
    bottomLine = l + ItemsPerCol - 1
    c = 1

    OPEN FileStats$ FOR RANDOM AS #2 LEN = RecLen

    IF ViewMode$ = "D" THEN
        ForStop = ListStr + ItemsPerCol - 1
        stringW = CharsAcross
    ELSE
        ''PRINT ItemsPerPage: END
        ForStop = ListStr + ItemsPerPage - 1
        stringW = CharsPerCol
    END IF

    FOR rn = ListStr TO ForStop

        f$ = ""
        b$ = ""
        dt$ = ""
        dm$ = ""
        slt = 0 'selected?  1=yes / 0=no

        IF rn <= TotalRecs THEN
            GET #2, rn, RecData
            f$ = RecData.FileFullName
            slt = RecData.FileSelect
            IF slt THEN
                f$ = CHR$(16) + LEFT$(f$, LEN(f$) - 1)
            END IF
            b$ = RecData.FileBytes
            b$ = RIGHT$(b$, 14)
            dt$ = RecData.FileDateTime
            dm$ = RecData.FileDim
            dm$ = RTRIM$(dm$)
            LastOnScreen = rn
            IF HideExtn THEN
                pp = INSTR(f$, ".")
                IF pp > 0 THEN f$ = LEFT$(f$, pp - 1)
            END IF
        END IF

        rn$ = LTRIM$(STR$(rn))
        rn$ = SPACE$(4 - LEN(rn$)) + rn$

        z$ = ""
        IF ViewMode$ = "D" THEN
            z$ = rn$ + " : "
            z$ = z$ + dt$ + SPACE$(10 - LEN(dt$))
            z$ = z$ + b$ + SPACE$(15 - LEN(b$))
            z$ = z$ + dm$ + SPACE$(10 - LEN(dm$))
            ''CLS: PRINT z$; "<": END
        END IF
        z$ = z$ + f$ + SPACE$(30 - LEN(f$))

        z$ = LEFT$(z$, stringW)
        z$ = z$ + SPACE$(stringW - LEN(z$))
        MID$(z$, stringW, 1) = " "

        ''LOCATE 1, 10: PRINT l; p
        LOCATE l, p
        'Fclr& = _RGB32(255, 255, 255)
        'Bclr& = _RGB32(11, 11, 67)
        asciiCOLOR 7, 0
        IF slt THEN
            'Fclr& = _RGB32(20, 100, 200)
            'Bclr& = _RGB32(200, 2, 255)
            asciiCOLOR 0, 3
        END IF
        IF rn = ListIdx THEN
            'Fclr& = _RGB32(200, 1, 2)
            'Bclr& = _RGB32(11, 200, 255)
            asciiCOLOR 15, 1
        END IF
        'COLOR Fclr&, Bclr&
        PRINT z$
        ColP(c) = p

        IF rn = ListIdx THEN
            saveL = l
            saveP = p
        END IF

        IF l = bottomLine THEN
            l = 2
            p = p + stringW
            c = c + 1
        ELSE
            l = l + 1
        END IF

    NEXT

    CLOSE 2

    EXIT SUB

    x = 0
    x = (saveP * 8) - 8 + 1
    y = (saveL * 16) - 16 + 1
    w = stringW * 8
    h = 16
    Rd = 0
    Gr = 255
    Bl = 0
    fill = 0
    DrawBox x, y, w, h, Rd, Gr, Bl, fill

END SUB

SUB DrawBox (x, y, w, h, Rd, Gr, Bl, fill) '###########################################
    clr& = _RGB32(Rd, Gr, Bl)
    IF fill THEN
        LINE (x, y)-(x + w - 1, y + h - 1), clr&, BF
    ELSE
        LINE (x, y)-(x + w - 1, y + h - 1), clr&, B
    END IF
END SUB

SUB RemoveDecimal (n) '#####################################################
    x$ = LTRIM$(STR$(n))
    P = INSTR(x$, ".")
    IF P > 0 THEN n = VAL(LEFT$(x$, P - 1))
END SUB

SUB asciiCOLOR (fc, bc) '###############################################
    rd = ASCIIclrRd(fc)
    gr = ASCIIclrGr(fc)
    bl = ASCIIclrBl(fc)
    Fclr& = _RGB32(rd, gr, bl)
    IF bc < 0 THEN
        COLOR Fclr&
        EXIT SUB
    END IF
    rd = ASCIIclrRd(bc)
    gr = ASCIIclrGr(bc)
    bl = ASCIIclrBl(bc)
    Bclr& = _RGB32(rd, gr, bl)
    COLOR Fclr&, Bclr&
END SUB