InForm/examples/TextFetch/TextFetch.bas

' Text Fetch.bas started b+ 2019-11-12 from other work with Dirs and Files loading
' Changes and updates by a740g (24-June-2023). Also simplified direntry.h
'
': This program uses
': InForm - GUI library for QB64 - v1.0
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------

OPTION _EXPLICIT

REDIM SHARED Dir(1 TO 1) AS STRING, File(1 TO 1) AS STRING

': Controls' IDs: ------------------------------------------------------------------
DIM SHARED frmTextFetch AS LONG
DIM SHARED lbCWD AS LONG
DIM SHARED lbDirs AS LONG
DIM SHARED ListDirs AS LONG
DIM SHARED lbFiles AS LONG
DIM SHARED ListFiles AS LONG
DIM SHARED lbFile AS LONG
DIM SHARED ListFile AS LONG
DIM SHARED lbTxt AS LONG
DIM SHARED ListTxt AS LONG
DIM SHARED BtnStart AS LONG
DIM SHARED BtnEnd AS LONG
DIM SHARED lbStart AS LONG
DIM SHARED lbEnd AS LONG

': External modules: ---------------------------------------------------------------
'$INCLUDE:'../../InForm/InForm.bi'
'$INCLUDE:'TextFetch.frm'

DECLARE LIBRARY "direntry"
    FUNCTION __load_dir%% ALIAS load_dir (s AS STRING)
    FUNCTION get_next_entry$ (flags AS LONG, file_size AS LONG)
    SUB close_dir
END DECLARE

FUNCTION load_dir%% (s AS STRING)
    load_dir = __load_dir(s + CHR$(0))
END FUNCTION

SUB loadText
    DIM i AS INTEGER, b$, clip$
    ResetList ListTxt
    FOR i = VAL(Caption(lbStart)) TO VAL(Caption(lbEnd))
        b$ = GetItem$(ListFile, i)
        AddItem ListTxt, GetItem$(ListFile, i)
        IF clip$ = "" THEN clip$ = b$ ELSE clip$ = clip$ + CHR$(13) + CHR$(10) + b$
    NEXT
    _CLIPBOARD$ = clip$
    Caption(lbTxt) = "Selected Text (in Clipboard):"
END SUB

SUB loadDirsFilesList
    DIM AS LONG nDirs, i

    Caption(lbCWD) = "Current Directory: " + _CWD$

    REDIM Dir(1 TO 1), File(1 TO 1)
    nDirs = GetCurDirLists(Dir(), File())

    IF nDirs > 0 THEN
        ResetList ListDirs
        FOR i = LBOUND(Dir) TO UBOUND(Dir)
            AddItem ListDirs, Dir(i)
        NEXT

        ResetList ListFiles
        FOR i = LBOUND(File) TO UBOUND(File)
            AddItem ListFiles, File(i)
        NEXT
    END IF
END SUB

FUNCTION GetCurDirLists& (DirList() AS STRING, FileList() AS STRING)
    CONST RESIZE_BLOCK_SIZE = 64

    REDIM DirList(1 TO RESIZE_BLOCK_SIZE), FileList(1 TO RESIZE_BLOCK_SIZE) ' resize the file and dir list arrays (and toss contents)

    DIM dirName AS STRING: dirName = _CWD$ ' we'll enumerate the current directory contents
    DIM AS LONG dirCount, fileCount, flags, fileSize
    DIM entryName AS STRING

    IF load_dir(dirName) THEN
        DO
            entryName = get_next_entry(flags, fileSize)
            IF entryName <> "" THEN
                SELECT CASE flags
                    CASE 1
                        dirCount = dirCount + 1
                        IF dirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(1 TO UBOUND(DirList) + RESIZE_BLOCK_SIZE)
                        DirList(dirCount) = entryName
                    CASE 2
                        fileCount = fileCount + 1
                        IF fileCount > UBOUND(FileList) THEN REDIM _PRESERVE FileList(1 TO UBOUND(FileList) + RESIZE_BLOCK_SIZE)
                        FileList(fileCount) = entryName
                END SELECT
            END IF
        LOOP UNTIL entryName = ""
        close_dir
    END IF

    REDIM _PRESERVE DirList(1 TO dirCount)
    REDIM _PRESERVE FileList(1 TO fileCount)

    GetCurDirLists = dirCount + fileCount ' return total count of items
END FUNCTION

'This SUB will take a given N delimited string, and delimiter$ and create an array of N+1 strings using the LBOUND of the given dynamic array to load.
'notes: the loadMeArray() needs to be dynamic string array and will not change the LBOUND of the array it is given.  rev 2019-08-27
SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS STRING)
    DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
    curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
    dpos = INSTR(curpos, SplitMeString, delim)
    DO UNTIL dpos = 0
        loadMeArray(arrpos) = MID$(SplitMeString, curpos, dpos - curpos)
        arrpos = arrpos + 1
        IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000) AS STRING
        curpos = dpos + LD
        dpos = INSTR(curpos, SplitMeString, delim)
    LOOP
    loadMeArray(arrpos) = MID$(SplitMeString, curpos)
    REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) AS STRING 'get the ubound correct
END SUB

FUNCTION fileStr$ (txtFile$)
    DIM rtn$
    IF _FILEEXISTS(txtFile$) THEN
        OPEN txtFile$ FOR BINARY AS #1
        rtn$ = SPACE$(LOF(1))
        GET #1, , rtn$
        CLOSE #1
        fileStr$ = rtn$
    END IF
END FUNCTION 'last line 317 + CRLF always added at end of .bas files

FUNCTION rightOf$ (source$, of$)
    IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
END FUNCTION

': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit

END SUB

SUB __UI_OnLoad
    loadDirsFilesList
END SUB

SUB __UI_BeforeUpdateDisplay
    'This event occurs at approximately 30 frames per second.
    'You can change the update frequency by calling SetFrameRate DesiredRate%

END SUB

SUB __UI_BeforeUnload
    'If you set __UI_UnloadSignal = False here you can
    'cancel the user's request to close.

END SUB

SUB __UI_Click (id AS LONG)
    DIM dir$, fi$, fs$, i AS INTEGER, value AS INTEGER
    SELECT CASE id
        CASE frmTextFetch

        CASE lbCWD

        CASE lbDirs

        CASE ListDirs
            dir$ = GetItem$(ListDirs, Control(ListDirs).Value)
            IF _DIREXISTS(dir$) THEN
                CHDIR dir$
                Caption(lbCWD) = "Current Directory: " + _CWD$
                loadDirsFilesList
            END IF

        CASE lbFiles

        CASE ListFiles
            fi$ = GetItem$(ListFiles, Control(ListFiles).Value)
            IF _FILEEXISTS(fi$) THEN
                fs$ = fileStr$(fi$)
                REDIM fa$(0)
                Split fs$, CHR$(13) + CHR$(10), fa$()
                ResetList ListFile
                FOR i = LBOUND(fa$) TO UBOUND(fa$)
                    AddItem ListFile, fa$(i)
                NEXT
                'clear
                Caption(lbStart) = "Line Start"
                Caption(lbEnd) = "Line End"
                Caption(lbFile) = "Selected File: Path = " + _CWD$ + ",  Name = " + fi$
            END IF

        CASE lbFile

        CASE ListFile

        CASE lbTxt

        CASE ListTxt

        CASE BtnStart
            value = Control(ListFile).Value
            Caption(lbStart) = STR$(value) + " Start Line"
            IF VAL(Caption(lbStart)) - VAL(Caption(lbEnd)) > 0 THEN loadText

        CASE BtnEnd
            value = Control(ListFile).Value
            Caption(lbEnd) = STR$(value) + " End Line"
            IF VAL(Caption(lbEnd)) - VAL(Caption(lbStart)) > 0 THEN loadText

        CASE lbStart

        CASE lbEnd

    END SELECT
END SUB

SUB __UI_MouseEnter (id AS LONG)
    SELECT CASE id
        CASE frmTextFetch

        CASE lbCWD

        CASE lbDirs

        CASE ListDirs

        CASE lbFiles

        CASE ListFiles

        CASE lbFile

        CASE ListFile

        CASE lbTxt

        CASE ListTxt

        CASE BtnStart

        CASE BtnEnd

        CASE lbStart

        CASE lbEnd

    END SELECT
END SUB

SUB __UI_MouseLeave (id AS LONG)
    SELECT CASE id
        CASE frmTextFetch

        CASE lbCWD

        CASE lbDirs

        CASE ListDirs

        CASE lbFiles

        CASE ListFiles

        CASE lbFile

        CASE ListFile

        CASE lbTxt

        CASE ListTxt

        CASE BtnStart

        CASE BtnEnd

        CASE lbStart

        CASE lbEnd

    END SELECT
END SUB

SUB __UI_FocusIn (id AS LONG)
    SELECT CASE id
        CASE ListDirs

        CASE ListFiles

        CASE ListFile

        CASE ListTxt

        CASE BtnStart

        CASE BtnEnd

    END SELECT
END SUB

SUB __UI_FocusOut (id AS LONG)
    'This event occurs right before a control loses focus.
    'To prevent a control from losing focus, set __UI_KeepFocus = True below.
    SELECT CASE id
        CASE ListDirs

        CASE ListFiles

        CASE ListFile

        CASE ListTxt

        CASE BtnStart

        CASE BtnEnd

    END SELECT
END SUB

SUB __UI_MouseDown (id AS LONG)
    SELECT CASE id
        CASE frmTextFetch

        CASE lbCWD

        CASE lbDirs

        CASE ListDirs

        CASE lbFiles

        CASE ListFiles

        CASE lbFile

        CASE ListFile

        CASE lbTxt

        CASE ListTxt

        CASE BtnStart

        CASE BtnEnd

        CASE lbStart

        CASE lbEnd

    END SELECT
END SUB

SUB __UI_MouseUp (id AS LONG)
    SELECT CASE id
        CASE frmTextFetch

        CASE lbCWD

        CASE lbDirs

        CASE ListDirs

        CASE lbFiles

        CASE ListFiles

        CASE lbFile

        CASE ListFile

        CASE lbTxt

        CASE ListTxt

        CASE BtnStart

        CASE BtnEnd

        CASE lbStart

        CASE lbEnd

    END SELECT
END SUB

SUB __UI_KeyPress (id AS LONG)
    'When this event is fired, __UI_KeyHit will contain the code of the key hit.
    'You can change it and even cancel it by making it = 0
    SELECT CASE id
        CASE ListDirs

        CASE ListFiles

        CASE ListFile

        CASE ListTxt

        CASE BtnStart

        CASE BtnEnd

    END SELECT
END SUB

SUB __UI_TextChanged (id AS LONG)
    SELECT CASE id
    END SELECT
END SUB

SUB __UI_ValueChanged (id AS LONG)
    SELECT CASE id
        CASE ListDirs

        CASE ListFiles

        CASE ListFile

        CASE ListTxt

    END SELECT
END SUB

SUB __UI_FormResized

END SUB

'$INCLUDE:'../../InForm/InForm.ui'
'$INCLUDE:'../../InForm/xp.uitheme'