Text Fetch with InForm v1.0

QB64 Team Software > InForm-based programs

(1/2) > >>

bplus:
Let me be first to post a program with v1 :)

--- Code: QB64: ---OPTION _EXPLICIT 'Text Fetch.bas started b+ 2019-11-12 from other work with Dirs and Files loading REDIM SHARED Dir(0) AS STRING, File(0) AS STRING ': This program uses': InForm - GUI library for QB64 - v1.0': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor': https://github.com/FellippeHeitor/InForm'----------------------------------------------------------- ': Controls' IDs: ------------------------------------------------------------------DIM SHARED frmTextFetch AS LONGDIM SHARED lbCWD AS LONGDIM SHARED lbDirs AS LONGDIM SHARED ListDirs AS LONGDIM SHARED lbFiles AS LONGDIM SHARED ListFiles AS LONGDIM SHARED lbFile AS LONGDIM SHARED ListFile AS LONGDIM SHARED lbTxt AS LONGDIM SHARED ListTxt AS LONGDIM SHARED BtnStart AS LONGDIM SHARED BtnEnd AS LONGDIM SHARED lbStart AS LONGDIM SHARED lbEnd AS LONGDIM SHARED tmpDir AS STRING ' establish a permanent spot for temp files IF ENVIRON$("TEMP") <> "" THEN 'Thanks to Steve McNeill use user temp files directory tmpDir = ENVIRON$("TEMP")ELSEIF ENVIRON$("TMP") <> "" THEN tmpDir = ENVIRON$("TMP")ELSE 'Thanks to Steve McNeill this should be very unlikely IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp" tmpDir = "C:\temp"END IF ': External modules: ---------------------------------------------------------------'$INCLUDE:'InForm\InForm.ui''$INCLUDE:'InForm\xp.uitheme''$INCLUDE:'Text Fetch.frm' 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 'f or this form DIM i AS INTEGER Caption(lbCWD) = "Current Directory: " + _CWD$ loadDIR Dir() ResetList ListDirs FOR i = LBOUND(dir) TO UBOUND(dir) AddItem ListDirs, Dir(i) NEXT loadFiles File() ResetList ListFiles FOR i = LBOUND(file) TO UBOUND(file) AddItem ListFiles, File(i) NEXTEND SUB '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-27SUB 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 correctEND SUB FUNCTION fileStr$ (txtFile$) IF _FILEEXISTS(txtFile$) THEN OPEN txtFile$ FOR BINARY AS #1 fileStr$ = SPACE$(LOF(1)) GET #1, , fileStr$ CLOSE #1 END IFEND FUNCTION 'last line 317 + CRLF always added at end of .bas files SUB loadDIR (fa() AS STRING) DIM tmpFile AS STRING, Index%, fline$, d$ tmpFile = tmpDir + "\DIR$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good! SHELL _HIDE "DIR /a:d >" + tmpFile 'get directories but have to do a little pruning OPEN tmpFile FOR INPUT AS #1 Index% = -1 DO WHILE NOT EOF(1) LINE INPUT #1, fline$ IF INSTR(fline$, "<DIR>") THEN d$ = _TRIM$(rightOf$(fline$, "<DIR>")) Index% = Index% + 1 REDIM _PRESERVE fa(Index%) fa(Index%) = d$ END IF LOOP CLOSE #1 KILL tmpFileEND SUB SUB loadFiles (fa() AS STRING) DIM tmpFile AS STRING, Index% tmpFile = tmpDir + "\FILE$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good! SHELL _HIDE "DIR *.* /a:-d /b /o:-gen > " + tmpFile OPEN tmpFile$ FOR INPUT AS #1 Index% = -1 DO WHILE NOT EOF(1) Index% = Index% + 1 REDIM _PRESERVE fa(Index%) AS STRING LINE INPUT #1, fa(Index%) LOOP CLOSE #1 KILL tmpFile$END SUB 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 loadDirsFilesListEND 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 SELECTEND 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 SELECTEND 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 SELECTEND SUB SUB __UI_FocusIn (id AS LONG) SELECT CASE id CASE ListDirs CASE ListFiles CASE ListFile CASE ListTxt CASE BtnStart CASE BtnEnd END SELECTEND 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 SELECTEND 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 SELECTEND 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 SELECTEND 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 SELECTEND SUB SUB __UI_TextChanged (id AS LONG) SELECT CASE id END SELECTEND SUB SUB __UI_ValueChanged (id AS LONG) SELECT CASE id CASE ListDirs CASE ListFiles CASE ListFile CASE ListTxt END SELECTEND SUB SUB __UI_FormResized END SUB '============================================== Failed Again! but took longer this time ============================================= SUB loadDirsFilesList_BLAHHHHHHHHHHHHHHH 'modified Steve's that uses 'Below needed for Steves load dirs and files which fails ????? for some strange reason ''''this needs to be somewhere QB64 can find, I have direntry.h in file folder as well as QB64.exe root DECLARE CUSTOMTYPE LIBRARY "direntry" FUNCTION load_dir& (s AS STRING) FUNCTION has_next_entry& () SUB close_dir () SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG) END DECLARE DIM nDirs AS INTEGER, i AS INTEGER, cntTrys AS INTEGER Caption(lbCWD) = "Current Directory: " + _CWD$ WHILE nDirs = 0 REDIM Dir(0), File(0) nDirs = GetCurDirLists(Dir(), File()) cntTrys = cntTrys + 1 _DELAY .1 IF cntTrys > 100 THEN EXIT SUB WEND 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) NEXTEND SUB ' once again this thing from Steve fails, this time it got further than with my other testFUNCTION GetCurDirLists% (DirList() AS STRING, FileList() AS STRING) DIM DirCount AS INTEGER, FileCount AS INTEGER, lengtht AS LONG, nam$, d$ DIM flags AS LONG, file_size AS LONG REDIM _PRESERVE DirList(100), FileList(100) DirCount = 0: FileCount = 0 d$ = _CWD$ IF load_dir(d$) THEN DO lengtht = has_next_entry IF lengtht > -1 THEN nam$ = SPACE$(lengtht) get_next_entry nam$, flags, file_size 'IF (flags AND 1) OR _DIREXISTS(d$ + nam$) THEN IF (flags AND 1) THEN DirCount = DirCount + 1 IF DirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(UBOUND(DirList) + 100) DirList(DirCount) = nam$ 'ELSEIF (flags AND 2) OR _FILEEXISTS(d$ + nam$) THEN ELSEIF (flags AND 2) THEN FileCount = FileCount + 1 IF FileCount > UBOUND(filelist) THEN REDIM _PRESERVE FileList(UBOUND(filelist) + 100) FileList(FileCount) = nam$ END IF END IF LOOP UNTIL lengtht = -1 close_dir ELSE END IF REDIM _PRESERVE DirList(DirCount) REDIM _PRESERVE FileList(FileCount) GetCurDirLists% = DirCountEND FUNCTION

Sorry, Windows only, I tried like hell to get Steve's any OS file and directory loading code to work, it does for a bit but dies when go too far up chain (in my tests with this code). I have left the failed code at bottom of code listing. Maybe someone can monkey with it and get it going for Linux and other OS's.

PS here is the whole package for compile, don't forget falcon.h goes (and direntry.h if you want to give that a go) with QB64.exe folder.

SierraKen:
That looks pretty cool bplus! LOL you beat me for being the first to post with v. 1 by just barely. :) But just remember, I am 100% newbie at this stuff. So this program is sorta like Notepad but it just reads a text file I guess from certain lines that you specify. Pretty nifty! Check out my first InForm game that I just posted.

FellippeHeitor:
That's really cool, bplus! Clever use of listbox controls for text display. You almost had me believe that was a multiline textbox :-)

Thanks for adding to the samples!

Colonel_Panic:
Nice clean interface.
very professional looking.
I'm impressed.

bplus:
Fix FileStr$ Function for QB64 v2.0 change:

--- Code: QB64: ---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 IfEnd Function 'last line 317 + CRLF always added at end of .bas files

Navigation

[0] Message Index

[#] Next page

Go to full version