Text Fetch with InForm v1.0

[bplus]

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

Code: QB64: [Select]

1. OPTION _EXPLICIT 'Text Fetch.bas started b+ 2019-11-12 from other work with Dirs and Files loading
2.  
3. REDIM SHARED Dir(0) AS STRING, File(0) AS STRING
4.  
5. ': This program uses
6. ': InForm - GUI library for QB64 - v1.0
7. ': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
8. ': https://github.com/FellippeHeitor/InForm
9. '-----------------------------------------------------------
10.  
11. ': Controls' IDs: ------------------------------------------------------------------
12. DIM SHARED frmTextFetch AS LONG
13. DIM SHARED lbCWD AS LONG
14. DIM SHARED lbDirs AS LONG
15. DIM SHARED ListDirs AS LONG
16. DIM SHARED lbFiles AS LONG
17. DIM SHARED ListFiles AS LONG
18. DIM SHARED lbFile AS LONG
19. DIM SHARED ListFile AS LONG
20. DIM SHARED lbTxt AS LONG
21. DIM SHARED ListTxt AS LONG
22. DIM SHARED BtnStart AS LONG
23. DIM SHARED BtnEnd AS LONG
24. DIM SHARED lbStart AS LONG
25. DIM SHARED lbEnd AS LONG
26. DIM SHARED tmpDir AS STRING '  establish a permanent spot for temp files
27.  
28. IF ENVIRON$("TEMP") <> "" THEN 'Thanks to Steve McNeill use user temp files directory
29.     tmpDir = ENVIRON$("TEMP")
30. ELSEIF ENVIRON$("TMP") <> "" THEN
31.     tmpDir = ENVIRON$("TMP")
32. ELSE 'Thanks to Steve McNeill this should be very unlikely
33.     IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp"
34.     tmpDir = "C:\temp"
35. END IF
36.  
37. ': External modules: ---------------------------------------------------------------
38. '$INCLUDE:'InForm\InForm.ui'
39. '$INCLUDE:'InForm\xp.uitheme'
40. '$INCLUDE:'Text Fetch.frm'
41.  
42. SUB loadText
43.     DIM i AS INTEGER, b$, clip$
44.     ResetList ListTxt
45.     FOR i = VAL(Caption(lbStart)) TO VAL(Caption(lbEnd))
46.         b$ = GetItem$(ListFile, i)
47.         AddItem ListTxt, GetItem$(ListFile, i)
48.         IF clip$ = "" THEN clip$ = b$ ELSE clip$ = clip$ + CHR$(13) + CHR$(10) + b$
49.     NEXT
50.     _CLIPBOARD$ = clip$
51.     Caption(lbTxt) = "Selected Text (in Clipboard):"
52. END SUB
53.  
54. SUB loadDirsFilesList 'f or this form
55.     DIM i AS INTEGER
56.     Caption(lbCWD) = "Current Directory: " + _CWD$
57.     loadDIR Dir()
58.     ResetList ListDirs
59.     FOR i = LBOUND(dir) TO UBOUND(dir)
60.         AddItem ListDirs, Dir(i)
61.     NEXT
62.     loadFiles File()
63.     ResetList ListFiles
64.     FOR i = LBOUND(file) TO UBOUND(file)
65.         AddItem ListFiles, File(i)
66.     NEXT
67. END SUB
68.  
69. '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.
70. '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
71. SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS STRING)
72.     DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
73.     curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
74.     dpos = INSTR(curpos, SplitMeString, delim)
75.     DO UNTIL dpos = 0
76.         loadMeArray(arrpos) = MID$(SplitMeString, curpos, dpos - curpos)
77.         arrpos = arrpos + 1
78.         IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000) AS STRING
79.         curpos = dpos + LD
80.         dpos = INSTR(curpos, SplitMeString, delim)
81.     LOOP
82.     loadMeArray(arrpos) = MID$(SplitMeString, curpos)
83.     REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) AS STRING 'get the ubound correct
84. END SUB
85.  
86. FUNCTION fileStr$ (txtFile$)
87.     IF _FILEEXISTS(txtFile$) THEN
88.         OPEN txtFile$ FOR BINARY AS #1
89.         fileStr$ = SPACE$(LOF(1))
90.         GET #1, , fileStr$
91.         CLOSE #1
92.     END IF
93. END FUNCTION 'last line 317 + CRLF always added at end of .bas files
94.  
95. SUB loadDIR (fa() AS STRING)
96.     DIM tmpFile AS STRING, Index%, fline$, d$
97.     tmpFile = tmpDir + "\DIR$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
98.     SHELL _HIDE "DIR /a:d >" + tmpFile 'get directories  but have to do a little pruning
99.     OPEN tmpFile FOR INPUT AS #1
100.     Index% = -1
101.     DO WHILE NOT EOF(1)
102.         LINE INPUT #1, fline$
103.         IF INSTR(fline$, "<DIR>") THEN
104.             d$ = _TRIM$(rightOf$(fline$, "<DIR>"))
105.             Index% = Index% + 1
106.             REDIM _PRESERVE fa(Index%)
107.             fa(Index%) = d$
108.         END IF
109.     LOOP
110.     CLOSE #1
111.     KILL tmpFile
112. END SUB
113.  
114. SUB loadFiles (fa() AS STRING)
115.     DIM tmpFile AS STRING, Index%
116.     tmpFile = tmpDir + "\FILE$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
117.     SHELL _HIDE "DIR *.* /a:-d /b /o:-gen > " + tmpFile
118.     OPEN tmpFile$ FOR INPUT AS #1
119.     Index% = -1
120.     DO WHILE NOT EOF(1)
121.         Index% = Index% + 1
122.         REDIM _PRESERVE fa(Index%) AS STRING
123.         LINE INPUT #1, fa(Index%)
124.     LOOP
125.     CLOSE #1
126.     KILL tmpFile$
127. END SUB
128.  
129. FUNCTION rightOf$ (source$, of$)
130.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
131. END FUNCTION
132.  
133. ': Event procedures: ---------------------------------------------------------------
134. SUB __UI_BeforeInit
135.  
136. END SUB
137.  
138. SUB __UI_OnLoad
139.     loadDirsFilesList
140. END SUB
141.  
142. SUB __UI_BeforeUpdateDisplay
143.     'This event occurs at approximately 30 frames per second.
144.     'You can change the update frequency by calling SetFrameRate DesiredRate%
145.  
146. END SUB
147.  
148. SUB __UI_BeforeUnload
149.     'If you set __UI_UnloadSignal = False here you can
150.     'cancel the user's request to close.
151.  
152. END SUB
153.  
154. SUB __UI_Click (id AS LONG)
155.     DIM dir$, fi$, fs$, i AS INTEGER, value AS INTEGER
156.     SELECT CASE id
157.         CASE frmTextFetch
158.  
159.         CASE lbCWD
160.  
161.         CASE lbDirs
162.  
163.         CASE ListDirs
164.             dir$ = GetItem$(ListDirs, Control(ListDirs).Value)
165.             IF _DIREXISTS(dir$) THEN
166.                 CHDIR dir$
167.                 Caption(lbCWD) = "Current Directory: " + _CWD$
168.                 loadDirsFilesList
169.             END IF
170.  
171.         CASE lbFiles
172.  
173.         CASE ListFiles
174.             fi$ = GetItem$(ListFiles, Control(ListFiles).Value)
175.             IF _FILEEXISTS(fi$) THEN
176.                 fs$ = fileStr$(fi$)
177.                 REDIM fa$(0)
178.                 Split fs$, CHR$(13) + CHR$(10), fa$()
179.                 ResetList ListFile
180.                 FOR i = LBOUND(fa$) TO UBOUND(fa$)
181.                     AddItem ListFile, fa$(i)
182.                 NEXT
183.                 'clear
184.                 Caption(lbStart) = "Line Start"
185.                 Caption(lbEnd) = "Line End"
186.                 Caption(lbFile) = "Selected File: Path = " + _CWD$ + ",  Name = " + fi$
187.             END IF
188.  
189.         CASE lbFile
190.  
191.         CASE ListFile
192.  
193.         CASE lbTxt
194.  
195.         CASE ListTxt
196.  
197.         CASE BtnStart
198.             value = Control(ListFile).Value
199.             Caption(lbStart) = STR$(value) + " Start Line"
200.             IF VAL(Caption(lbStart)) - VAL(Caption(lbEnd)) > 0 THEN loadText
201.  
202.         CASE BtnEnd
203.             value = Control(ListFile).Value
204.             Caption(lbEnd) = STR$(value) + " End Line"
205.             IF VAL(Caption(lbEnd)) - VAL(Caption(lbStart)) > 0 THEN loadText
206.  
207.         CASE lbStart
208.  
209.         CASE lbEnd
210.  
211.     END SELECT
212. END SUB
213.  
214. SUB __UI_MouseEnter (id AS LONG)
215.     SELECT CASE id
216.         CASE frmTextFetch
217.  
218.         CASE lbCWD
219.  
220.         CASE lbDirs
221.  
222.         CASE ListDirs
223.  
224.         CASE lbFiles
225.  
226.         CASE ListFiles
227.  
228.         CASE lbFile
229.  
230.         CASE ListFile
231.  
232.         CASE lbTxt
233.  
234.         CASE ListTxt
235.  
236.         CASE BtnStart
237.  
238.         CASE BtnEnd
239.  
240.         CASE lbStart
241.  
242.         CASE lbEnd
243.  
244.     END SELECT
245. END SUB
246.  
247. SUB __UI_MouseLeave (id AS LONG)
248.     SELECT CASE id
249.         CASE frmTextFetch
250.  
251.         CASE lbCWD
252.  
253.         CASE lbDirs
254.  
255.         CASE ListDirs
256.  
257.         CASE lbFiles
258.  
259.         CASE ListFiles
260.  
261.         CASE lbFile
262.  
263.         CASE ListFile
264.  
265.         CASE lbTxt
266.  
267.         CASE ListTxt
268.  
269.         CASE BtnStart
270.  
271.         CASE BtnEnd
272.  
273.         CASE lbStart
274.  
275.         CASE lbEnd
276.  
277.     END SELECT
278. END SUB
279.  
280. SUB __UI_FocusIn (id AS LONG)
281.     SELECT CASE id
282.         CASE ListDirs
283.  
284.         CASE ListFiles
285.  
286.         CASE ListFile
287.  
288.         CASE ListTxt
289.  
290.         CASE BtnStart
291.  
292.         CASE BtnEnd
293.  
294.     END SELECT
295. END SUB
296.  
297. SUB __UI_FocusOut (id AS LONG)
298.     'This event occurs right before a control loses focus.
299.     'To prevent a control from losing focus, set __UI_KeepFocus = True below.
300.     SELECT CASE id
301.         CASE ListDirs
302.  
303.         CASE ListFiles
304.  
305.         CASE ListFile
306.  
307.         CASE ListTxt
308.  
309.         CASE BtnStart
310.  
311.         CASE BtnEnd
312.  
313.     END SELECT
314. END SUB
315.  
316. SUB __UI_MouseDown (id AS LONG)
317.     SELECT CASE id
318.         CASE frmTextFetch
319.  
320.         CASE lbCWD
321.  
322.         CASE lbDirs
323.  
324.         CASE ListDirs
325.  
326.         CASE lbFiles
327.  
328.         CASE ListFiles
329.  
330.         CASE lbFile
331.  
332.         CASE ListFile
333.  
334.         CASE lbTxt
335.  
336.         CASE ListTxt
337.  
338.         CASE BtnStart
339.  
340.         CASE BtnEnd
341.  
342.         CASE lbStart
343.  
344.         CASE lbEnd
345.  
346.     END SELECT
347. END SUB
348.  
349. SUB __UI_MouseUp (id AS LONG)
350.     SELECT CASE id
351.         CASE frmTextFetch
352.  
353.         CASE lbCWD
354.  
355.         CASE lbDirs
356.  
357.         CASE ListDirs
358.  
359.         CASE lbFiles
360.  
361.         CASE ListFiles
362.  
363.         CASE lbFile
364.  
365.         CASE ListFile
366.  
367.         CASE lbTxt
368.  
369.         CASE ListTxt
370.  
371.         CASE BtnStart
372.  
373.         CASE BtnEnd
374.  
375.         CASE lbStart
376.  
377.         CASE lbEnd
378.  
379.     END SELECT
380. END SUB
381.  
382. SUB __UI_KeyPress (id AS LONG)
383.     'When this event is fired, __UI_KeyHit will contain the code of the key hit.
384.     'You can change it and even cancel it by making it = 0
385.     SELECT CASE id
386.         CASE ListDirs
387.  
388.         CASE ListFiles
389.  
390.         CASE ListFile
391.  
392.         CASE ListTxt
393.  
394.         CASE BtnStart
395.  
396.         CASE BtnEnd
397.  
398.     END SELECT
399. END SUB
400.  
401. SUB __UI_TextChanged (id AS LONG)
402.     SELECT CASE id
403.     END SELECT
404. END SUB
405.  
406. SUB __UI_ValueChanged (id AS LONG)
407.     SELECT CASE id
408.         CASE ListDirs
409.  
410.         CASE ListFiles
411.  
412.         CASE ListFile
413.  
414.         CASE ListTxt
415.  
416.     END SELECT
417. END SUB
418.  
419. SUB __UI_FormResized
420.  
421. END SUB
422.  
423. '==============================================  Failed Again! but took longer this time =============================================
424.  
425. SUB loadDirsFilesList_BLAHHHHHHHHHHHHHHH 'modified Steve's that uses
426.     'Below needed for Steves load dirs and files which fails ????? for some strange reason
427.     ''''this needs to be somewhere QB64 can find, I have direntry.h in file folder as well as QB64.exe root
428.     DECLARE CUSTOMTYPE LIBRARY "direntry"
429.         FUNCTION load_dir& (s AS STRING)
430.         FUNCTION has_next_entry& ()
431.         SUB close_dir ()
432.         SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
433.     END DECLARE
434.  
435.     DIM nDirs AS INTEGER, i AS INTEGER, cntTrys AS INTEGER
436.     Caption(lbCWD) = "Current Directory: " + _CWD$
437.     WHILE nDirs = 0
438.         REDIM Dir(0), File(0)
439.         nDirs = GetCurDirLists(Dir(), File())
440.         cntTrys = cntTrys + 1
441.         _DELAY .1
442.         IF cntTrys > 100 THEN EXIT SUB
443.     WEND
444.     ResetList ListDirs
445.     FOR i = LBOUND(dir) TO UBOUND(dir)
446.         AddItem ListDirs, Dir(i)
447.     NEXT
448.     ResetList ListFiles
449.     FOR i = LBOUND(file) TO UBOUND(file)
450.         AddItem ListFiles, File(i)
451.     NEXT
452. END SUB
453.  
454. ' once again this thing from Steve fails, this time it got further than with my other test
455. FUNCTION GetCurDirLists% (DirList() AS STRING, FileList() AS STRING)
456.     DIM DirCount AS INTEGER, FileCount AS INTEGER, lengtht AS LONG, nam$, d$
457.     DIM flags AS LONG, file_size AS LONG
458.  
459.     REDIM _PRESERVE DirList(100), FileList(100)
460.     DirCount = 0: FileCount = 0
461.     d$ = _CWD$
462.     IF load_dir(d$) THEN
463.         DO
464.             lengtht = has_next_entry
465.             IF lengtht > -1 THEN
466.                 nam$ = SPACE$(lengtht)
467.                 get_next_entry nam$, flags, file_size
468.                 'IF (flags AND 1) OR _DIREXISTS(d$ + nam$) THEN
469.                 IF (flags AND 1) THEN
470.                     DirCount = DirCount + 1
471.                     IF DirCount > UBOUND(DirList) THEN REDIM _PRESERVE DirList(UBOUND(DirList) + 100)
472.                     DirList(DirCount) = nam$
473.                     'ELSEIF (flags AND 2) OR _FILEEXISTS(d$ + nam$) THEN
474.                 ELSEIF (flags AND 2) THEN
475.                     FileCount = FileCount + 1
476.                     IF FileCount > UBOUND(filelist) THEN REDIM _PRESERVE FileList(UBOUND(filelist) + 100)
477.                     FileList(FileCount) = nam$
478.                 END IF
479.             END IF
480.         LOOP UNTIL lengtht = -1
481.         close_dir
482.     ELSE
483.     END IF
484.     REDIM _PRESERVE DirList(DirCount)
485.     REDIM _PRESERVE FileList(FileCount)
486.     GetCurDirLists% = DirCount
487. END FUNCTION
488.  

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: [Select]

1. Function fileStr$ (txtFile$)
2.     Dim rtn$
3.     If _FileExists(txtFile$) Then
4.         Open txtFile$ For Binary As #1
5.         rtn$ = Space$(LOF(1))
6.         Get #1, , rtn$
7.         Close #1
8.         fileStr$ = rtn$
9.     End If
10. End Function 'last line 317 + CRLF always added at end of .bas files
11.  

[mohai]

Hello,

Interesting application.
I did not know of direntry library. It looks very useful to do a file explorer.
I wish I had known of it before doing a dialog box (https://qb64forum.alephc.xyz/index.php?topic=4689.0).
I will have a look at it.

By the way, you maybe already know it. Try to add a "./" or a ".\" before the library filename. It worked for me.

        Declare CustomType Library ".\direntry"

[bplus]

Hello,

Interesting application.
I did not know of direntry library. It looks very useful to do a file explorer.
I wish I had known of it before doing a dialog box (https://qb64forum.alephc.xyz/index.php?topic=4689.0).
I will have a look at it.

By the way, you maybe already know it. Try to add a "./" or a ".\" before the library filename. It worked for me.

        Declare CustomType Library ".\direntry"

hmm... I know I've worked with direntry but not here in Text Fetch with InForm, that is pure Windows because I was Shelling to write Directory Files in a Temp folder back then.

Code: QB64: [Select]

1. SUB loadDIR (fa() AS STRING)
2.     DIM tmpFile AS STRING, Index%, fline$, d$
3.     tmpFile = tmpDir + "\DIR$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
4.     SHELL _HIDE "DIR /a:d >" + tmpFile 'get directories  but have to do a little pruning
5.     OPEN tmpFile FOR INPUT AS #1
6.     Index% = -1
7.     DO WHILE NOT EOF(1)
8.         LINE INPUT #1, fline$
9.         IF INSTR(fline$, "<DIR>") THEN
10.             d$ = _TRIM$(rightOf$(fline$, "<DIR>"))
11.             Index% = Index% + 1
12.             REDIM _PRESERVE fa(Index%)
13.             fa(Index%) = d$
14.         END IF
15.     LOOP
16.     CLOSE #1
17.     KILL tmpFile
18. END SUB
19.  

I may have updated Text Fetch the non-InForm version with any OS Direntry method?? don't remember.
Text Fetch was written way before we got most all bugs out of Direntry method that I could use without problems.

And you apparently have found another one?  ;-))

Here is my last word on Direntry Method: https://qb64forum.alephc.xyz/index.php?topic=4360.msg138242#msg138242
and there I do see a .\ in commented notes.