Author Topic: Fetch Text  (Read 3994 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Fetch Text
« on: November 12, 2019, 11:28:09 pm »
Test app for my own natal GUI, so far only Text boxes for massive text display and selText boxes like giant menus.

Click boxes at top left corner to goto start of text, click bottom left corner to goto last page ending of of text, click top of frame for page up, bottom of frame page down, can you guess clicking left and right of frame? ;)

Selecting text, shift and scroll mouse or keys with shift... when you have it press enter.

Anyway, since I just posted Text Fetch the InForm version here is the one I was working on in Oct for comparison.

Code: QB64: [Select]
  1. _TITLE "Fetch Text app of GUI Boxes" 'B+  2019-10-15
  2. ' a box for selecting directories, a box for files, a box to display file text and a box to show selected text
  3. '2019-11-12 add a clipboard clip$ and post
  4.  
  5. CONST xmax = 1200 '150 chars
  6. CONST ymax = 720 '45 chars
  7. CONST offFC = &HFF999999, offBC = &HFF333333
  8. CONST DD$ = "$" + "$" ' details delimiter not likely to occur in Text?
  9.  
  10. TYPE bxType
  11.     c AS INTEGER 'column, these are all in character cell units not pixels
  12.     r AS INTEGER 'row, like LOCATE row, col
  13.     w AS INTEGER ' actual text will have 2 less character used to frame box
  14.     h AS INTEGER 'actual text has 1 less line
  15.     fc AS _UNSIGNED LONG 'fore color
  16.     bc AS _UNSIGNED LONG 'back color
  17.     o AS INTEGER 'on/off active = got focus =-1 else 0
  18.     DNA AS INTEGER ' the kind of box 1 = txtBx, 2 = selBx
  19.  
  20. TYPE txtBxType 'these are all in character cell units not pixels
  21.     id AS INTEGER 'connect to parent bx index
  22.     txt AS STRING ' to convert to string array with Split
  23.     delim AS STRING 'for txt to split when drawing to base 1 array
  24.     rowStart AS INTEGER ' track top line of display
  25.     colStart AS INTEGER ' 1 to... maxW
  26.     curRow AS INTEGER ' highlite row 1 to..  ubound of array
  27.     R1 AS INTEGER 'this is anchor position of text block selection
  28.     R2 AS INTEGER ' this is above or below anchor position
  29.     maxW AS INTEGER 'find the length of longest string - text display width + 1
  30.     maxH AS INTEGER ' ubound of text array - display height of box + 1
  31.     ubText AS INTEGER ' track this so don't have to recalc maximum curRow can go
  32.     selected AS INTEGER ' TF selection
  33.  
  34. TYPE selBxType
  35.     id AS INTEGER 'trace back to parent Bx number
  36.     txt AS STRING 'for split into string array
  37.     delim AS STRING 'delim for split
  38.     sNum AS INTEGER 'tracking key press number for selection <enter>
  39.     highlite AS INTEGER ' select highlite by space bar or left mouse click
  40.     selected AS INTEGER ' use getSelected$ for number or text$
  41.     maxH AS INTEGER 'track upper limit or string array
  42.  
  43. DIM SHARED CRLF$ 'a common delimiter for txt files
  44. CRLF$ = CHR$(13) + CHR$(10)
  45.  
  46. DIM SHARED tmpDir AS STRING '  establish a permanent spot for temp files
  47. IF ENVIRON$("TEMP") <> "" THEN 'Thanks to Steve McNeill use user temp files directory
  48.     tmpDir = ENVIRON$("TEMP")
  49. ELSEIF ENVIRON$("TMP") <> "" THEN
  50.     tmpDir = ENVIRON$("TMP")
  51. ELSE 'Thanks to Steve McNeill this should be very unlikely
  52.     IF _DIREXISTS("C:\temp") THEN ELSE MKDIR "C:\temp"
  53.     tmpDir = "C:\temp"
  54.  
  55. 'Box type arrays and counts, theBx is the Box with focus
  56. DIM SHARED nBx AS INTEGER, nTxtBx AS INTEGER, nSelBx AS INTEGER, theBx AS INTEGER
  57. REDIM SHARED Bx(0) AS bxType, txtBx(0) AS txtBxType, selBx(0) AS selBxType
  58.  
  59. DIM SHARED oldmx AS INTEGER, oldmy AS INTEGER ' preserve last mouse locations
  60.  
  61. '                                           Local variables for this program
  62. DIM j AS INTEGER, test$ ' for main loop
  63.  
  64. ' ========================================== DIM and Layout New Boxes Here ========================================================
  65.  
  66. '  assign new Bx   put the Bx controls in  Tab order (Shift + Tab reverse order)
  67.  
  68. ' for reference here is call to newBx
  69. ' newBx col, row, txtwidth + 2 in font cells, txtHeight + 1 in font cells, fore Color, back Color, details string depends on Bx type
  70.  
  71. 'details string build for new TextBox or SelectBox,  DD$ is delimiter for detail split in code
  72. ' detail = "TextBox" + DD$
  73. ' detail = detail + theText$ + DD$
  74. ' detail = detail + theDelimiter$ (of theText$: CRLF$ for txt files or , for data files...)
  75.  
  76. REDIM drs(0) AS STRING, fls(0) AS STRING
  77. DIM curd AS STRING, d$, f$, c$, s$, w$
  78. DIM dbx AS INTEGER, fbx AS INTEGER, cbx AS INTEGER, sbx AS INTEGER
  79. curd = _CWD$
  80. loadDIR drs()
  81. loadFiles fls()
  82. d$ = join$(drs())
  83. f$ = join$(fls())
  84. dbx = newBx(2, 1, 104, 21, &HFF88AAFF, &HFF000088, "selBx" + DD$ + d$ + DD$ + CRLF$)
  85. fbx = newBx(107, 1, 43, 21, &HFFFFAA88, &HFF880000, "selBx" + DD$ + f$ + DD$ + CRLF$)
  86. cbx = newBx(2, 23, 148, 11, &HFFAAFFAA, &HFF008800, "textBx" + DD$ + c$ + DD$ + CRLF$)
  87. sbx = newBx(2, 35, 148, 10, &HFFFFFF00, &HFF550033, "txtBx" + DD + s$ + DD$ + CRLF$)
  88.  
  89. '===================================================== END of Layout =============================================================
  90.  
  91. SCREEN _NEWIMAGE(xmax, ymax, 32)
  92. _SCREENMOVE 100, 20
  93.  
  94. WHILE _KEYDOWN(27) = 0 ' main loop
  95.  
  96.     COLOR &HFFAAAAAA, &HFF000000: CLS
  97.     FOR j = 1 TO nBx 'redraw everything
  98.         SELECT CASE Bx(j).DNA
  99.             CASE 1 'txtBx
  100.                 drawTxtBx j
  101.             CASE 2
  102.                 drawSelBx j
  103.         END SELECT
  104.     NEXT
  105.     COLOR &HFFAAAAAA, &HFF000000 'keep color for screen  after drawing
  106.     focus 'which box has the focus? then mouse and key handler
  107.     test$ = getItem$(dbx)
  108.     IF test$ <> "" THEN 'new directory
  109.         'LOCATE 1, 1: PRINT test$
  110.         'INPUT "OK "; w$
  111.         '_KEYCLEAR
  112.         CHDIR test$
  113.         loadDIR drs()
  114.         loadFiles fls()
  115.         d$ = join$(drs())
  116.         f$ = join$(fls())
  117.         putItem dbx, d$ + DD$ + CRLF$
  118.         putItem fbx, f$ + DD$ + CRLF$
  119.     END IF
  120.     test$ = getItem$(fbx) 'get file name for file content
  121.     IF test$ <> "" THEN
  122.         c$ = fileStr$(test$)
  123.         putItem cbx, c$ + DD$ + CRLF$
  124.     END IF
  125.     test$ = getItem$(cbx)
  126.     IF test$ <> "" THEN
  127.         _CLIPBOARD$ = test$
  128.         putItem sbx, test$ + DD$ + CRLF$
  129.     END IF
  130.  
  131.     _KEYCLEAR 'it takes an enter keypress to select by number, need to clear that for next input
  132.  
  133.     _DISPLAY
  134.     _LIMIT 60
  135.  
  136. FUNCTION getItem$ (bxNum AS INTEGER) 'return the item value from bxNum, once retrieved clear value??
  137.     DIM b AS INTEGER, n AS INTEGER, start AS INTEGER, i AS INTEGER
  138.     REDIM tx(1 TO 1) AS STRING
  139.     SELECT CASE Bx(bxNum).DNA
  140.         CASE 1 'text box mainly text box is just for displaying stuff, select a block of text
  141.             FOR b = 1 TO nTxtBx
  142.                 IF txtBx(b).id = bxNum THEN
  143.                     IF txtBx(b).selected THEN
  144.                         Split txtBx(b).txt, txtBx(b).delim, tx()
  145.                         start = txtBx(b).R1: n = txtBx(b).R2
  146.                         IF start > n THEN SWAP start, n
  147.                         FOR i = start TO n
  148.                             IF i = start THEN getItem$ = tx(start) ELSE getItem$ = getItem$ + CRLF$ + tx(i)
  149.                         NEXT
  150.                         txtBx(b).selected = 0
  151.                         EXIT FUNCTION
  152.                     END IF
  153.                 END IF
  154.             NEXT
  155.         CASE 2 'select box, reurn text string selected
  156.             FOR b = 1 TO nSelBx
  157.                 IF selBx(b).id = bxNum THEN
  158.                     n = selBx(b).selected
  159.                     IF n > 0 AND n <= selBx(b).maxH THEN
  160.                         Split selBx(b).txt, selBx(b).delim, tx()
  161.                         getItem$ = tx(n)
  162.                         selBx(b).selected = 0 ' clear the selected index
  163.                         EXIT FUNCTION
  164.                     END IF
  165.                 END IF
  166.             NEXT
  167.     END SELECT
  168.  
  169. SUB putItem (bxNum AS INTEGER, details$) ' change out text and reset DNA Box
  170.     DIM b AS INTEGER, mxW AS INTEGER, row AS INTEGER
  171.     REDIM d(1 TO 1) AS STRING, tx(1 TO 1) AS STRING
  172.     SELECT CASE Bx(bxNum).DNA
  173.         CASE 1 'change out text and it's delimiter
  174.             FOR b = 1 TO nTxtBx
  175.                 IF txtBx(b).id = bxNum THEN
  176.                     Split details$, DD$, d()
  177.                     txtBx(b).txt = d(1)
  178.                     txtBx(b).delim = d(2)
  179.                     txtBx(b).rowStart = 1
  180.                     txtBx(b).colStart = 1
  181.                     txtBx(b).curRow = 1
  182.                     txtBx(b).R1 = 1
  183.                     txtBx(b).R2 = 1
  184.                     txtBx(b).selected = 0
  185.                     mxW = 1
  186.                     Split txtBx(b).txt, txtBx(b).delim, tx()
  187.                     FOR row = LBOUND(tx) TO UBOUND(tx)
  188.                         IF LEN(tx(row)) > mxW THEN mxW = LEN(tx(row))
  189.                     NEXT
  190.                     txtBx(b).maxW = mxW - (Bx(bxNum).w - 2) + 1 ' display width is 2 less than bx.w, formula says add 1 so  -2 + 1 = -1
  191.                     txtBx(b).maxH = UBOUND(tx) - Bx(bxNum).h + 2 ' display height is -1 from bx.h + 1
  192.                     IF txtBx(b).maxH < 1 THEN txtBx(b).maxH = 1
  193.                     txtBx(b).ubText = UBOUND(tx) ' max row
  194.                     EXIT SUB
  195.                 END IF
  196.             NEXT
  197.  
  198.         CASE 2 'change out text and it's delimiter
  199.             FOR b = 1 TO nSelBx
  200.                 IF selBx(b).id = bxNum THEN
  201.                     Split details$, DD$, d()
  202.                     selBx(b).txt = d(1)
  203.                     selBx(b).delim = d(2)
  204.                     selBx(b).sNum = 0
  205.                     selBx(b).highlite = 1
  206.                     selBx(b).selected = 0
  207.                     Split selBx(b).txt, selBx(b).delim, tx()
  208.                     selBx(b).maxH = UBOUND(tx) ' display height is -1 from bx.h + 1
  209.                     EXIT SUB
  210.                 END IF
  211.             NEXT
  212.     END SELECT
  213.  
  214. SUB focus 'mouse and key event handling
  215.     DIM mx AS INTEGER, my AS INTEGER, mb1 AS INTEGER, mb2 AS INTEGER, mw AS INTEGER, mc AS INTEGER, mr AS INTEGER
  216.     DIM b AS INTEGER, c AS INTEGER, kh&, i AS INTEGER, tw AS INTEGER, th AS INTEGER, page AS INTEGER
  217.  
  218.     IF nBx AND theBx = 0 THEN theBx = 1: Bx(theBx).o = -1 'set theBx for startup
  219.  
  220.     'to use mouse wheel for scrolling I have to do this before knowing if theBx with focus has changed, assuming it hasn't
  221.         mw = _MOUSEWHEEL
  222.         IF Bx(theBx).DNA = 1 THEN
  223.             FOR c = 1 TO nTxtBx
  224.                 IF txtBx(c).id = theBx THEN EXIT FOR
  225.             NEXT
  226.             IF txtBx(c).curRow + mw >= 1 AND txtBx(c).curRow + mw <= txtBx(c).ubText THEN
  227.                 txtBx(c).curRow = txtBx(c).curRow + mw
  228.                 IF txtBx(c).curRow < txtBx(c).rowStart THEN txtBx(c).rowStart = txtBx(c).curRow
  229.                 IF txtBx(c).curRow > txtBx(c).rowStart + Bx(theBx).h - 2 THEN
  230.                     txtBx(c).rowStart = txtBx(c).rowStart + txtBx(c).curRow - txtBx(c).rowStart - Bx(theBx).h + 2
  231.                     IF txtBx(c).rowStart > txtBx(c).maxH THEN txtBx(c).rowStart = txtBx(c).maxH
  232.                 END IF
  233.                 txtBx(c).R2 = txtBx(c).curRow
  234.                 IF _KEYDOWN(100304) = 0 THEN txtBx(c).R1 = txtBx(c).curRow
  235.             END IF
  236.         ELSEIF Bx(theBx).DNA = 2 THEN
  237.             FOR c = 1 TO nSelBx
  238.                 IF selBx(c).id = theBx THEN EXIT FOR
  239.             NEXT
  240.             IF selBx(c).highlite + mw >= 1 AND selBx(c).highlite + mw <= selBx(c).maxH THEN
  241.                 selBx(c).highlite = selBx(c).highlite + mw
  242.             END IF
  243.         END IF
  244.     WEND
  245.  
  246.     'now we see if theBx = index of box that has focus has changed by mouse over
  247.     mx = _MOUSEX: my = _MOUSEY: mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
  248.     kh& = _KEYHIT
  249.     IF mb1 THEN
  250.         DO: _LIMIT 100: LOOP UNTIL _MOUSEINPUT 'wait for end of click
  251.     END IF
  252.     mc = mx \ 8 + 1: mr = my \ 16 + 1
  253.     IF mx <> oldmx OR my <> oldmy THEN 'check what bx mouse is over
  254.         FOR i = 1 TO nBx
  255.             IF mc >= Bx(i).c AND mc <= Bx(i).c + Bx(i).w - 1 THEN
  256.                 IF mr >= Bx(i).r AND mr <= Bx(i).r + Bx(i).h - 1 THEN
  257.                     IF i <> theBx THEN
  258.                         b = i
  259.                     END IF
  260.                 END IF
  261.             END IF
  262.         NEXT
  263.         oldmx = mx: oldmy = my
  264.     END IF
  265.  
  266.     'now we see if theBx = index of box that has focus has changed by Tab Key press
  267.     IF _KEYDOWN(100304) AND kh& = 9 THEN
  268.         b = theBx - 1: IF b < 1 THEN b = nBx
  269.     ELSEIF kh& = 9 THEN
  270.         b = theBx + 1: IF b > nBx THEN b = 1
  271.     END IF
  272.     IF b AND b <> theBx THEN
  273.         Bx(theBx).o = 0: Bx(b).o = -1: theBx = b
  274.     END IF
  275.  
  276.     'now handle other mouse and key events according to bx(theBx).DNA = the type of box
  277.     SELECT CASE Bx(theBx).DNA
  278.         CASE 1 'text box
  279.             FOR b = 1 TO nTxtBx 'which txtBx
  280.                 IF theBx = txtBx(b).id THEN EXIT FOR 'it be b
  281.             NEXT
  282.             tw = Bx(theBx).w - 2: th = Bx(theBx).h - 1 'get the display width and height
  283.  
  284.             'mouse, make sure mouse is in theBx
  285.             IF mc >= Bx(theBx).c AND mc <= Bx(theBx).c + Bx(theBx).w THEN
  286.                 IF mr >= Bx(theBx).r AND mr <= Bx(theBx).r + Bx(theBx).h THEN
  287.                     IF mc = Bx(theBx).c AND mb1 THEN 'clicking left side of frame
  288.                         IF mr = Bx(theBx).r THEN ' clicking top left corner = ctrl + home
  289.                             txtBx(b).curRow = 1: txtBx(b).colStart = 1: txtBx(b).rowStart = 1
  290.                         ELSEIF mr = Bx(theBx).r + Bx(theBx).h THEN ' clicking bottom left corner  cntrl + end
  291.                             txtBx(b).curRow = txtBx(b).ubText: txtBx(b).colStart = 1: txtBx(b).rowStart = txtBx(b).maxH
  292.                         ELSEIF Bx(theBx).r < mr AND mr < Bx(theBx).r + Bx(theBx).h THEN ' clicking between corners
  293.                             txtBx(b).colStart = txtBx(b).colStart - tw
  294.                             IF txtBx(b).colStart < 1 THEN txtBx(b).colStart = 1
  295.                         END IF
  296.  
  297.                         'click right frame = Pg right
  298.                     ELSEIF (mc = Bx(theBx).c + Bx(theBx).w - 1 OR mc = Bx(theBx).c + Bx(theBx).w) AND mb1 THEN
  299.                         txtBx(b).colStart = txtBx(b).colStart + tw
  300.                         IF txtBx(b).colStart > txtBx(b).maxW THEN txtBx(b).colStart = txtBx(b).maxW
  301.  
  302.                         'click top frame = PgUp
  303.                     ELSEIF mr = Bx(theBx).r AND mb1 THEN
  304.                         txtBx(b).curRow = txtBx(b).curRow - th
  305.                         IF txtBx(b).curRow < 1 THEN txtBx(b).curRow = 1
  306.                         IF txtBx(b).curRow < txtBx(b).rowStart THEN
  307.                             txtBx(b).rowStart = txtBx(b).rowStart - th
  308.                             IF txtBx(b).rowStart < 1 THEN txtBx(b).rowStart = 1
  309.                         END IF
  310.                         txtBx(b).R2 = txtBx(b).curRow
  311.                         IF _KEYDOWN(100304) = 0 THEN txtBx(b).R1 = txtBx(b).curRow
  312.  
  313.                         ' click bottom frame = PgDn
  314.                     ELSEIF mr = Bx(theBx).r + Bx(theBx).h AND mb1 THEN
  315.                         txtBx(b).curRow = txtBx(b).curRow + th
  316.                         txtBx(b).rowStart = txtBx(b).rowStart + th
  317.                         IF txtBx(b).curRow > txtBx(b).ubText THEN txtBx(b).curRow = txtBx(b).ubText
  318.                         IF txtBx(b).rowStart > txtBx(b).maxH THEN txtBx(b).rowStart = txtBx(b).maxH
  319.                         txtBx(b).R2 = txtBx(b).curRow
  320.                         IF _KEYDOWN(100304) = 0 THEN txtBx(b).R1 = txtBx(b).curRow
  321.  
  322.                     ELSE
  323.                         IF mb1 THEN 'click main body, just highlite or select to the click
  324.                             txtBx(b).curRow = txtBx(b).rowStart + mr - Bx(theBx).r - 1
  325.                             IF txtBx(b).curRow < 1 THEN txtBx(b).curRow = 1
  326.                             IF txtBx(b).curRow > txtBx(b).ubText THEN txtBx(b).curRow = txtBx(b).ubText
  327.                             txtBx(b).R2 = txtBx(b).curRow
  328.                             IF _KEYDOWN(100304) = 0 THEN txtBx(b).R1 = txtBx(b).curRow
  329.                         END IF
  330.  
  331.                     END IF
  332.                 END IF
  333.             END IF
  334.  
  335.             'key presses
  336.             IF _KEYDOWN(100306) AND kh& = 18176 THEN 'ctrl + home
  337.                 txtBx(b).curRow = 1: txtBx(b).rowStart = 1
  338.                 txtBx(b).R2 = txtBx(b).curRow
  339.                 IF _KEYDOWN(100304) = 0 THEN txtBx(b).R1 = txtBx(b).curRow
  340.             ELSEIF _KEYDOWN(100306) AND kh& = 20224 THEN 'ctlr + end
  341.                 txtBx(b).rowStart = txtBx(b).maxH
  342.                 txtBx(b).curRow = txtBx(b).ubText
  343.                 txtBx(b).R2 = txtBx(b).curRow
  344.                 IF _KEYDOWN(100304) = 0 THEN txtBx(b).R1 = txtBx(b).curRow
  345.             ELSEIF _KEYDOWN(100306) AND kh& = 19200 THEN 'ctlr + left
  346.                 IF txtBx(b).maxW > 1 THEN
  347.                     IF txtBx(b).colStart - tw < 1 THEN
  348.                         txtBx(b).colStart = 1
  349.                     ELSE
  350.                         txtBx(b).colStart = txtBx(b).colStart - tw
  351.                     END IF
  352.                 END IF
  353.             ELSEIF _KEYDOWN(100306) AND kh& = 19712 THEN 'ctlr + right
  354.                 IF txtBx(b).maxW > 1 THEN
  355.                     IF txtBx(b).colStart + tw > txtBx(b).maxW THEN
  356.                         txtBx(b).colStart = txtBx(b).maxW
  357.                     ELSE
  358.                         txtBx(b).colStart = txtBx(b).colStart + tw
  359.                     END IF
  360.                 END IF
  361.             ELSE
  362.                 IF txtBx(b).maxW > 1 THEN 'left right home and end
  363.                     SELECT CASE kh&
  364.                         CASE 19200 'left
  365.                             IF txtBx(b).colStart > 1 THEN txtBx(b).colStart = txtBx(b).colStart - 1
  366.                         CASE 19712 'right
  367.                             IF txtBx(b).colStart < txtBx(b).maxW THEN txtBx(b).colStart = txtBx(b).colStart + 1
  368.                         CASE 18176 'home
  369.                             IF txtBx(b).maxW > 1 THEN txtBx(b).colStart = 1
  370.                         CASE 20224 'end
  371.                             IF txtBx(b).maxW > 1 THEN txtBx(b).colStart = txtBx(b).maxW
  372.                     END SELECT
  373.                 END IF
  374.                 IF txtBx(b).maxH > 1 THEN
  375.                     SELECT CASE kh&
  376.                         CASE 13 'enter we have made our selection
  377.                             txtBx(b).selected = -1
  378.                         CASE 32 'clear selection
  379.                             txtBx(b).selected = 0
  380.                         CASE 18432 'up
  381.                             IF txtBx(b).curRow > 1 THEN txtBx(b).curRow = txtBx(b).curRow - 1
  382.                             IF txtBx(b).curRow < txtBx(b).rowStart THEN txtBx(b).rowStart = txtBx(b).curRow
  383.                             txtBx(b).R2 = txtBx(b).curRow
  384.                             IF _KEYDOWN(100304) = 0 THEN txtBx(b).R1 = txtBx(b).curRow
  385.                         CASE 20480 'down
  386.                             IF txtBx(b).curRow < txtBx(b).ubText THEN txtBx(b).curRow = txtBx(b).curRow + 1
  387.                             IF txtBx(b).curRow > txtBx(b).rowStart + th - 1 THEN ''''''''''''''''''''''
  388.                                 txtBx(b).rowStart = txtBx(b).rowStart + 1
  389.                                 IF txtBx(b).rowStart > txtBx(b).maxH THEN txtBx(b).rowStart = txtBx(b).maxH
  390.                             END IF
  391.                             txtBx(b).R2 = txtBx(b).curRow
  392.                             IF _KEYDOWN(100304) = 0 THEN txtBx(b).R1 = txtBx(b).curRow
  393.                         CASE 18688 'pg up
  394.                             txtBx(b).curRow = txtBx(b).curRow - th
  395.                             IF txtBx(b).curRow < 1 THEN txtBx(b).curRow = 1
  396.                             IF txtBx(b).curRow < txtBx(b).rowStart THEN
  397.                                 txtBx(b).rowStart = txtBx(b).rowStart - th
  398.                                 IF txtBx(b).rowStart < 1 THEN txtBx(b).rowStart = 1
  399.                             END IF
  400.                             txtBx(b).R2 = txtBx(b).curRow
  401.                             IF _KEYDOWN(100304) = 0 THEN txtBx(b).R1 = txtBx(b).curRow
  402.                         CASE 20736 'pg down
  403.                             txtBx(b).curRow = txtBx(b).curRow + th
  404.                             txtBx(b).rowStart = txtBx(b).rowStart + th
  405.                             IF txtBx(b).curRow > txtBx(b).ubText THEN txtBx(b).curRow = txtBx(b).ubText
  406.                             IF txtBx(b).rowStart > txtBx(b).maxH THEN txtBx(b).rowStart = txtBx(b).maxH
  407.                             txtBx(b).R2 = txtBx(b).curRow
  408.                             IF _KEYDOWN(100304) = 0 THEN txtBx(b).R1 = txtBx(b).curRow
  409.                     END SELECT
  410.                 END IF
  411.             END IF
  412.  
  413.         CASE 2 'Select box
  414.             FOR b = 1 TO nSelBx 'which selBx
  415.                 IF theBx = selBx(b).id THEN EXIT FOR 'it be b
  416.             NEXT
  417.             th = Bx(theBx).h - 1 'get the display width and height
  418.             page = INT(selBx(b).highlite / th)
  419.             IF selBx(b).highlite MOD th = 0 THEN page = page - 1
  420.  
  421.             'mouse  is probably already inside box unless theBx was set by tabbing so double check for mouse functions
  422.             IF mc >= Bx(theBx).c AND mc <= Bx(theBx).c + Bx(theBx).w THEN 'mouse must be inside columns
  423.                 IF mr >= Bx(theBx).r AND mr <= Bx(theBx).r + Bx(theBx).h THEN ' mouse inside rows
  424.                     IF mr = Bx(theBx).r AND mc = Bx(theBx).c AND mb1 THEN 'Ctrl + home if clicked
  425.                         selBx(b).highlite = 1
  426.                     ELSEIF mr = Bx(theBx).r + Bx(theBx).h AND mc = Bx(theBx).c AND mb1 THEN 'Ctrl + end if clicked
  427.                         selBx(b).highlite = selBx(b).maxH
  428.                     ELSEIF mr = Bx(theBx).r AND mb1 THEN
  429.                         IF selBx(b).highlite - th < 1 THEN 'PUp
  430.                             selBx(b).highlite = 1
  431.                         ELSE
  432.                             selBx(b).highlite = selBx(b).highlite - th
  433.                         END IF
  434.                         'fix click highlite and select
  435.                     ELSEIF mr > Bx(theBx).r AND mr < Bx(theBx).r + Bx(theBx).h - 1 AND mb1 THEN ' clicked so select it
  436.                         selBx(b).highlite = page * th + mr - Bx(theBx).r
  437.                         IF selBx(b).highlite < 1 THEN selBx(b).highlite = 1
  438.                         IF selBx(b).highlite > selBx(b).maxH THEN selBx(b).highlite = selBx(b).maxH
  439.                         IF mb1 THEN selBx(b).selected = selBx(b).highlite
  440.                     ELSEIF mr = Bx(theBx).r + Bx(theBx).h AND mb1 THEN 'pgdn if clicked
  441.                         IF selBx(b).highlite + th > selBx(b).maxH THEN
  442.                             selBx(b).highlite = selBx(b).maxH
  443.                         ELSE
  444.                             selBx(b).highlite = selBx(b).highlite + th
  445.                         END IF
  446.                     END IF ' bunch of conditions
  447.                 END IF 'in rows
  448.             END IF ' in cols
  449.  
  450.             'key presses
  451.             IF _KEYDOWN(100306) AND kh& = 18176 THEN 'ctrl + home
  452.                 IF selBx(b).maxH > 1 THEN selBx(b).highlite = 1 'ctrl + home
  453.             ELSEIF _KEYDOWN(100306) AND kh& = 20224 THEN 'ctlr + end
  454.                 IF selBx(b).maxH > 1 THEN selBx(b).highlite = selBx(b).maxH ' ctrl + end
  455.             ELSE
  456.                 IF selBx(b).maxH > 1 THEN
  457.                     SELECT CASE kh&
  458.                         CASE 13 'enter select the number input
  459.                             IF selBx(b).sNum >= 1 AND selBx(b).sNum <= selBx(b).maxH THEN
  460.                                 selBx(b).selected = selBx(b).sNum
  461.                             ELSE
  462.                                 selBx(b).selected = selBx(b).highlite
  463.                             END IF
  464.                             selBx(b).sNum = 0
  465.                         CASE 32 'spacebar
  466.                             selBx(b).selected = selBx(b).highlite
  467.                             selBx(b).sNum = 0
  468.                         CASE 48 TO 57 'add digit to sNum
  469.                             selBx(b).sNum = VAL(_TRIM$(STR$(selBx(b).sNum)) + CHR$(kh&))
  470.                         CASE 99, 21248 'c for clear or delete
  471.                             selBx(b).sNum = 0
  472.                         CASE 8 'back space
  473.                             IF selBx(b).sNum > 0 THEN
  474.                                 selBx(b).sNum = VAL(LEFT$(_TRIM$(STR$(selBx(b).sNum)), LEN(_TRIM$(STR$(selBx(b).sNum))) - 1))
  475.                             END IF
  476.                         CASE 18432 'up
  477.                             IF selBx(b).highlite > 1 THEN selBx(b).highlite = selBx(b).highlite - 1
  478.                         CASE 20480 'down
  479.                             IF selBx(b).highlite < selBx(b).maxH THEN selBx(b).highlite = selBx(b).highlite + 1
  480.                         CASE 18688 'pg up
  481.                             IF selBx(b).highlite - th < 1 THEN
  482.                                 selBx(b).highlite = 1
  483.                             ELSE
  484.                                 selBx(b).highlite = selBx(b).highlite - th
  485.                             END IF
  486.                         CASE 20736 'pg down
  487.                             IF selBx(b).highlite + th > selBx(b).maxH THEN
  488.                                 selBx(b).highlite = selBx(b).maxH
  489.                             ELSE
  490.                                 selBx(b).highlite = selBx(b).highlite + th
  491.                             END IF
  492.                     END SELECT
  493.                 END IF
  494.             END IF
  495.     END SELECT
  496.  
  497. SUB drawTxtBx (i AS INTEGER) ' 1 char frame around the box
  498.     DIM b AS INTEGER, tw AS INTEGER, th AS INTEGER, r AS INTEGER, s$, d!, j!, fc AS _UNSIGNED LONG, bc AS _UNSIGNED LONG
  499.     DIM sStart AS INTEGER, sEnd AS INTEGER
  500.     REDIM tx(1 TO 1) AS STRING
  501.  
  502.     FOR b = 1 TO nTxtBx 'b is txtBx index that matches the Bx index, theorectically other controls will have Bx index
  503.         IF i = txtBx(b).id THEN EXIT FOR 'it be b
  504.     NEXT
  505.     Split txtBx(b).txt, txtBx(b).delim, tx() ' get the text into an array
  506.     tw = Bx(i).w - 2: th = Bx(i).h - 1 'get the display width and height
  507.     IF txtBx(b).R1 > txtBx(b).R2 THEN sStart = txtBx(b).R2: sEnd = txtBx(b).R1 ELSE sStart = txtBx(b).R1: sEnd = txtBx(b).R2
  508.  
  509.     IF txtBx(b).maxW > 1 THEN 'text indicator column bar needed
  510.         d! = 8 * (tw - 1) * (txtBx(b).colStart - 1) / (txtBx(b).maxW - 1)
  511.         FOR j! = 4 TO 0 STEP -.25
  512.             LINE ((Bx(i).c) * 8 + 4 + d! - j!, (Bx(i).r - .5) * 16 - 2 * j!)-STEP(2 * j!, Bx(i).h * 16 + 4 * j!), _RGB32(255 - j! * 50, 255 - j! * 50, 255 - j! * 50), BF
  513.         NEXT
  514.     END IF
  515.  
  516.     IF txtBx(b).maxH > 1 THEN 'text indicator row bar needed
  517.         d! = 16 * (th - 1) * (txtBx(b).curRow - 1) / (txtBx(b).ubText - 1)
  518.         FOR j! = 4 TO 0 STEP -.25
  519.             LINE ((Bx(i).c - 1) * 8 - 2 * j!, (Bx(i).r + .5) * 16 - 2 + d! - j!)-STEP(Bx(i).w * 8 + 4 * j!, 2 * j!), _RGB32(255 - j! * 50, 255 - j! * 50, 255 - j! * 50), BF
  520.         NEXT
  521.     END IF
  522.  
  523.     IF Bx(i).o THEN 'box and frame
  524.         fc = Bx(i).fc: bc = Bx(i).bc
  525.         LINE ((Bx(i).c - 1) * 8, (Bx(i).r - .5) * 16)-STEP(Bx(i).w * 8, Bx(i).h * 16), bc, BF
  526.     ELSE
  527.         fc = offFC: bc = offBC
  528.         LINE ((Bx(i).c - 1) * 8, (Bx(i).r - .5) * 16)-STEP(Bx(i).w * 8, Bx(i).h * 16), bc, BF
  529.     END IF
  530.     LINE ((Bx(i).c - 1) * 8, (Bx(i).r - .5) * 16)-STEP(Bx(i).w * 8, Bx(i).h * 16), fc, B
  531.  
  532.     'text and highlite startRow
  533.     FOR r = 1 TO th
  534.         IF txtBx(b).rowStart + r - 1 >= 1 AND txtBx(b).rowStart + r - 1 <= txtBx(b).ubText THEN
  535.             IF txtBx(b).rowStart + r - 1 >= sStart AND txtBx(b).rowStart + r - 1 <= sEnd THEN COLOR bc, fc ELSE COLOR fc, bc
  536.             s$ = LEFT$(MID$(tx(txtBx(b).rowStart + r - 1), txtBx(b).colStart) + SPACE$(tw), tw)
  537.             LP Bx(i).c + 1, Bx(i).r + r, s$
  538.         END IF
  539.     NEXT
  540.  
  541. SUB drawSelBx (i AS INTEGER) ' 1 char frame around the box
  542.     DIM page AS INTEGER
  543.     REDIM tx(1 TO 1) AS STRING
  544.  
  545.     FOR b = 1 TO nSelBx 'b is txtBx index that matches the Bx index, theorectically other controls will have Bx index
  546.         IF i = selBx(b).id THEN EXIT FOR 'it be b
  547.     NEXT
  548.     Split selBx(b).txt, selBx(b).delim, tx() ' get the text into an array
  549.     tw = Bx(i).w - 2: th = Bx(i).h - 1 'get the display width and height
  550.     page = INT(selBx(b).highlite / th)
  551.  
  552.     IF selBx(b).highlite MOD th = 0 THEN page = page - 1
  553.  
  554.     IF Bx(i).o THEN
  555.         fc = Bx(i).fc: bc = Bx(i).bc
  556.         LINE ((Bx(i).c - 1) * 8, (Bx(i).r - .5) * 16)-STEP(Bx(i).w * 8, Bx(i).h * 16), Bx(i).bc, BF
  557.     ELSE
  558.         fc = offFC: bc = offBC
  559.         LINE ((Bx(i).c - 1) * 8, (Bx(i).r - .5) * 16)-STEP(Bx(i).w * 8, Bx(i).h * 16), offBC, BF
  560.     END IF
  561.     LINE ((Bx(i).c - 1) * 8, (Bx(i).r - .5) * 16)-STEP(Bx(i).w * 8, Bx(i).h * 16), fc, B
  562.  
  563.     FOR r = 1 TO th
  564.         IF page * th + r >= 1 AND page * th + r <= selBx(b).maxH THEN
  565.             IF page * th + r = selBx(b).highlite THEN COLOR bc, fc ELSE COLOR fc, bc
  566.             s$ = LEFT$(_TRIM$(STR$(page * th + r)) + " " + tx(page * th + r) + SPACE$(tw), tw)
  567.             LP Bx(i).c + 1, Bx(i).r + r, s$
  568.         END IF
  569.     NEXT
  570.     IF selBx(b).sNum THEN LP Bx(i).c, Bx(i).r, _TRIM$(STR$(selBx(b).sNum))
  571.  
  572.     REDIM d(1 TO 1) AS STRING, tx(1 TO 1) AS STRING
  573.     DIM row AS INTEGER, mxW AS INTEGER
  574.     nBx = nBx + 1
  575.     REDIM _PRESERVE Bx(1 TO nBx) AS bxType
  576.     Bx(nBx).c = c: Bx(nBx).r = r
  577.     Bx(nBx).w = w: Bx(nBx).h = h
  578.     Bx(nBx).fc = fc: Bx(nBx).bc = bc
  579.     Bx(nBx).o = 0
  580.     Split details, DD$, d()
  581.     SELECT CASE UCASE$(d(1))
  582.         CASE "TEXTBOX", "TXTBX", "TEXTBX", "TXTBOX", "TEXT BOX", "TXT BX", "TEXT BX", "TXT BOX", "BOX O TEXT"
  583.             Bx(nBx).DNA = 1
  584.             nTxtBx = nTxtBx + 1
  585.             REDIM _PRESERVE txtBx(1 TO nTxtBx) AS txtBxType
  586.             txtBx(nTxtBx).id = nBx
  587.             txtBx(nTxtBx).txt = d(2)
  588.             txtBx(nTxtBx).delim = d(3)
  589.             txtBx(nTxtBx).rowStart = 1
  590.             txtBx(nTxtBx).colStart = 1
  591.             txtBx(nTxtBx).curRow = 1
  592.             txtBx(nTxtBx).R1 = 1
  593.             txtBx(nTxtBx).R2 = 1
  594.             txtBx(nTxtBx).selected = 0
  595.             mxW = 1
  596.             Split txtBx(nTxtBx).txt, txtBx(nTxtBx).delim, tx()
  597.             FOR row = LBOUND(tx) TO UBOUND(tx)
  598.                 IF LEN(tx(row)) > mxW THEN mxW = LEN(tx(row))
  599.             NEXT
  600.             txtBx(nTxtBx).maxW = mxW - (Bx(nBx).w - 2) + 1 ' display width is 2 less than bx.w, formula says add 1 so  -2 + 1 = -1
  601.             txtBx(nTxtBx).maxH = UBOUND(tx) - Bx(nBx).h + 2 ' display height is -1 from bx.h + 1
  602.             IF txtBx(nTxtBx).maxH < 1 THEN txtBx(nTxtBx).maxH = 1
  603.             txtBx(nTxtBx).ubText = UBOUND(tx)
  604.         CASE "SELECTBOX", "SELBX", "SELECTBX", "SELBOX", "SELECT BOX", "SEL BX", "SELECT BX", "SEL BOX", "MENU"
  605.             Bx(nBx).DNA = 2
  606.             nSelBx = nSelBx + 1
  607.             REDIM _PRESERVE selBx(1 TO nSelBx) AS selBxType
  608.             selBx(nSelBx).id = nBx
  609.             selBx(nSelBx).txt = d(2)
  610.             selBx(nSelBx).delim = d(3)
  611.             selBx(nSelBx).sNum = 0
  612.             selBx(nSelBx).highlite = 1
  613.             selBx(nSelBx).selected = 0
  614.             Split selBx(nSelBx).txt, selBx(nSelBx).delim, tx()
  615.             selBx(nSelBx).maxH = UBOUND(tx) ' display height is -1 from bx.h + 1
  616.  
  617.     END SELECT
  618.     newBx% = nBx
  619.  
  620. SUB LP (col, row, S$)
  621.     LOCATE row, col: PRINT S$;
  622.  
  623. '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.
  624. '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
  625. SUB Split (SplitMeString AS STRING, delim AS STRING, loadMeArray() AS STRING)
  626.     DIM curpos AS LONG, arrpos AS LONG, LD AS LONG, dpos AS LONG 'fix use the Lbound the array already has
  627.     curpos = 1: arrpos = LBOUND(loadMeArray): LD = LEN(delim)
  628.     dpos = INSTR(curpos, SplitMeString, delim)
  629.     DO UNTIL dpos = 0
  630.         loadMeArray(arrpos) = MID$(SplitMeString, curpos, dpos - curpos)
  631.         arrpos = arrpos + 1
  632.         IF arrpos > UBOUND(loadMeArray) THEN REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO UBOUND(loadMeArray) + 1000) AS STRING
  633.         curpos = dpos + LD
  634.         dpos = INSTR(curpos, SplitMeString, delim)
  635.     LOOP
  636.     loadMeArray(arrpos) = MID$(SplitMeString, curpos)
  637.     REDIM _PRESERVE loadMeArray(LBOUND(loadMeArray) TO arrpos) AS STRING 'get the ubound correct
  638.  
  639. FUNCTION fileStr$ (txtFile$)
  640.     IF _FILEEXISTS(txtFile$) THEN
  641.         OPEN txtFile$ FOR BINARY AS #1
  642.         fileStr$ = SPACE$(LOF(1))
  643.         GET #1, , fileStr$
  644.         CLOSE #1
  645.     END IF
  646. END FUNCTION 'last line 317 + CRLF always added at end of .bas files
  647.  
  648. FUNCTION join$ (sa$())
  649.     DIM i AS INTEGER
  650.     FOR i = LBOUND(sa$) TO UBOUND(sa$)
  651.         IF join$ = "" THEN join$ = sa$(i) ELSE join$ = join$ + CRLF$ + sa$(i)
  652.     NEXT
  653.  
  654. SUB loadDIR (fa() AS STRING)
  655.     DIM tmpFile AS STRING, Index%, fline$, d$
  656.     tmpFile = tmpDir + "\DIR$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
  657.     SHELL _HIDE "DIR /a:d >" + tmpFile 'get directories  but have to do a little pruning
  658.     OPEN tmpFile FOR INPUT AS #1
  659.     Index% = -1
  660.     DO WHILE NOT EOF(1)
  661.         LINE INPUT #1, fline$
  662.         IF INSTR(fline$, "<DIR>") THEN
  663.             d$ = _TRIM$(rightOf$(fline$, "<DIR>"))
  664.             Index% = Index% + 1
  665.             REDIM _PRESERVE fa(Index%)
  666.             fa(Index%) = d$
  667.         END IF
  668.     LOOP
  669.     CLOSE #1
  670.     KILL tmpFile
  671.  
  672. SUB loadFiles (fa() AS STRING)
  673.     DIM tmpFile AS STRING, Index%
  674.     tmpFile = tmpDir + "\FILE$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
  675.     SHELL _HIDE "DIR *.* /a:-d /b /o:-gen > " + tmpFile
  676.     OPEN tmpFile$ FOR INPUT AS #1
  677.     Index% = -1
  678.     DO WHILE NOT EOF(1)
  679.         Index% = Index% + 1
  680.         REDIM _PRESERVE fa(Index%) AS STRING
  681.         LINE INPUT #1, fa(Index%)
  682.     LOOP
  683.     CLOSE #1
  684.     KILL tmpFile$
  685.  
  686. FUNCTION rightOf$ (source$, of$)
  687.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
  688.  

BTW the box that has the focus lights up with color!
Fetch Text.PNG
* Fetch Text.PNG (Filesize: 38.29 KB, Dimensions: 1248x768, Views: 213)
Fetch Text compare natal GUI.PNG
* Fetch Text compare natal GUI.PNG (Filesize: 51.1 KB, Dimensions: 1244x767, Views: 199)
« Last Edit: November 12, 2019, 11:34:38 pm by bplus »