Author Topic: Text Fetch with InForm v1.0  (Read 518 times)

Offline bplus

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



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.
« Last Edit: November 12, 2019, 10:00:39 PM by bplus »

Offline SierraKen

  • Forum Resident
  • Posts: 956
Re: Text Fetch with InForm v1.0
« Reply #1 on: November 12, 2019, 11:08:41 PM »
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.

Offline FellippeHeitor

  • QB64 Developer
  • Forum Resident
  • Posts: 2233
  • LET IT = BE
    • QB64.org
Re: Text Fetch with InForm v1.0
« Reply #2 on: November 13, 2019, 08:01:25 AM »
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!