Author Topic: Who says Pete can't use _KEYHIT?  (Read 2757 times)

0 Members and 1 Guest are viewing this topic.

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Who says Pete can't use _KEYHIT?
« on: January 20, 2021, 02:48:14 pm »
I know, I know, I almost always use INKEY$. For fun, I put both an INKEY$ and a _KEYHIT routine together in the new WP I'm putting together. It turns out they play nicely together. Well, as long as you remember to clear the _KEYHIT buffer! So to prove this old dog can do a few new tricks, here is some of the stripped out code from my WP project, which uses _HITKEY, instead of INKEY$. Be advised, stripped out code can be a bit buggy, but let's see how this goes.

Okay, so what is it?

It's a key input method for forms. You can laterally scroll the text past the input field, highlight text with Shift, Ctrl + Shift, mouse drag, and Shift + left click. You know, normal Windows stuff. It is amazing what we take for granted as simple text manipulation has so many conditions to address, and takes over 500 lines of code.

Let me know if you find any bugs present,

Pete

Code: QB64: [Select]
  1. fieldlength% = 36
  2. LOCATE 3, 12: PRINT "Form Input: ";
  3. COLOR 0, 7
  4. PRINT SPACE$(fieldlength% + 1);
  5. LOCATE , POS(0) - (fieldlength% + 1)
  6.  
  7. CALL textinput(text$, fieldlength%)
  8.  
  9. SUB textinput (text$, fieldlength%)
  10.     STATIC initiate%, hscrollon%, hscroll%, textfg%, textbk%, highlightfg%
  11.     STATIC highlightbk%, leftmargin%, rightmargin%, textmaxlength%, linecharacter%
  12.     STATIC click_l%, drag%, shiftclick%, starthighlight%, highlight%, overwrite%, CurAdvance%
  13.  
  14.     DO
  15.         IF NOT initiate% THEN ' Initiate textinput variables.
  16.             initiate% = -1
  17.             GOSUB initiate_variables
  18.         END IF
  19.  
  20.         ' --------------------POLL MOUSE--->
  21.         mb.w = 0
  22.         WHILE _MOUSEINPUT
  23.             mb.w = mb.w + _MOUSEWHEEL
  24.         WEND
  25.  
  26.         IF mb.w = 0 THEN
  27.             mx% = _MOUSEX ' Mouse column.
  28.             my% = _MOUSEY ' Mouse row.
  29.             mb.l = _MOUSEBUTTON(1)
  30.             mb.r = _MOUSEBUTTON(2)
  31.             mb.m = _MOUSEBUTTON(3)
  32.         END IF
  33.         '<----------------------------------
  34.  
  35.         mykey% = _KEYHIT
  36.  
  37.         IF mykey% = 0 THEN
  38.             IF my% <> oldmy% OR mx% <> oldmx% OR mb.l THEN
  39.                 GOSUB mouseroutine
  40.                 IF LEN(action$) THEN EXIT DO
  41.             END IF
  42.         END IF
  43.  
  44.         IF mykey% > 0 THEN
  45.             GOSUB form_input_keyroutine
  46.             IF LEN(action$) THEN EXIT DO
  47.         END IF
  48.         '-------------------------------------------------------------------------
  49.         oldmy% = my%: oldmx% = mx%
  50.     LOOP
  51.     EXIT SUB
  52.  
  53.     '---------------------------GOSUB STATEMENTS-----------------------------
  54.     initiate_variables:
  55.     textfg% = 0
  56.     textbk% = 7
  57.     highlightfg% = 15
  58.     highlightbk% = 1
  59.     leftmargin% = POS(0): iyy% = CSRLIN
  60.     rightmargin% = leftmargin% + fieldlength%
  61.     textmaxlength% = 100
  62.     linecharacter% = 255: REM Blank space
  63.  
  64.     IF textmaxlength% > rightmargin% - (leftmargin% - 1) THEN hscrollon% = -1
  65.     IF rightmargin% < leftmargin% THEN CLS: PRINT "Rightmargin% cannot be smaller than leftmargin%. Redo.": END
  66.     IF leftmargin% < 1 OR leftmargin% > 80 THEN CLS: PRINT "Leftmargin% is not within 1 - 80 range. Redo.": END
  67.     IF LEN(text$) > textmaxlength% THEN CLS: PRINT "Text length cannot start out larger than textmaxlength%. Redo.": END
  68.  
  69.     IF rightmargin% = leftmargin% AND textmaxlength% = 1 THEN
  70.         CurAdvance% = 0
  71.     ELSE
  72.         CurAdvance% = 1
  73.     END IF
  74.  
  75.     COLOR textfg%, textbk%
  76.     LOCATE iyy%, leftmargin%, 1, 7, 7
  77.     RETURN '-----------------------------------------------------------------
  78.  
  79.     form_input_keyroutine:
  80.     DO ' Falk loop.
  81.         IF _KEYDOWN(100303) = -1 OR _KEYDOWN(100304) = -1 THEN
  82.             SELECT CASE mykey%
  83.                 CASE 18176, 20224, 19200, 19712, 21248, 20992
  84.                     shift% = -1
  85.             END SELECT
  86.         ELSE
  87.             IF NOT drag% THEN shift% = 0
  88.         END IF
  89.  
  90.         IF _KEYDOWN(100305) = -1 OR _KEYDOWN(100306) = -1 THEN
  91.             SELECT CASE mykey%
  92.                 CASE 86, 118
  93.                     control% = -2
  94.                 CASE ELSE
  95.                     control% = -1
  96.             END SELECT
  97.         ELSE
  98.             control% = 0
  99.         END IF
  100.  
  101.         REM Evaluate changes to highlighted text, excluding cut/copy/paste
  102.         IF highlight% AND shift% = 0 AND control% <> -1 AND mykey% <> 8 AND mykey% < 21248 THEN
  103.             IF mykey% > 31 AND mykey% < 256 THEN
  104.                 GOSUB cutcopy
  105.             ELSE
  106.                 GOSUB wash
  107.             END IF
  108.         END IF
  109.  
  110.         IF shift% = -1 AND control% = 0 THEN
  111.             SELECT CASE mykey%
  112.                 CASE 19200
  113.                     GOSUB HighlightLeft
  114.  
  115.                 CASE 19712
  116.                     IF control% THEN
  117.                         GOSUB ctrlrt
  118.                     ELSE
  119.                         GOSUB HighlightRight
  120.                     END IF
  121.  
  122.                 CASE 18176
  123.                     GOSUB SelectToHome
  124.  
  125.                 CASE 20224
  126.                     GOSUB SelectToEnd
  127.  
  128.                 CASE 21248
  129.                     mykey% = 88: REM Convert Delete to Cut
  130.                     GOSUB cutcopy
  131.  
  132.                 CASE 20992
  133.                     GOSUB PasteClipboard
  134.             END SELECT
  135.  
  136.         ELSE
  137.  
  138.             SELECT CASE control%
  139.                 CASE 0
  140.                     SELECT CASE mykey%
  141.                         CASE 18176
  142.                             IF shift% THEN GOSUB SelectToHome ELSE GOSUB CursorHome
  143.  
  144.                         CASE 20224
  145.                             IF shift% THEN GOSUB SelectToEnd ELSE GOSUB CursorEnd
  146.  
  147.                         CASE 8, 21248: REM Backspace and Delete
  148.                             GOSUB BackspaceDelete
  149.  
  150.                         CASE 9: REM Tab
  151.  
  152.                         CASE 13
  153.                             GOSUB selection_made
  154.                             action$ = "enter"
  155.                             EXIT DO
  156.  
  157.                         CASE 19200
  158.                             GOSUB CursorLeft
  159.  
  160.                         CASE 19712
  161.                             GOSUB CursorRight
  162.  
  163.                         CASE 18432
  164.                             GOSUB CursorUp
  165.  
  166.                         CASE 20480
  167.                             GOSUB CursorDown
  168.  
  169.                         CASE 18688
  170.                             GOSUB PageUp
  171.  
  172.                         CASE 20736
  173.                             GOSUB PageDown
  174.  
  175.                         CASE 27
  176.                             GOSUB wash
  177.                             action$ = "exit"
  178.                             EXIT DO
  179.  
  180.                         CASE 20992: REM Insert
  181.                             GOSUB InsertOverwrite
  182.  
  183.                         CASE ELSE
  184.                             GOSUB DisplayText
  185.                             IF flagtext% = -1 THEN flagtext% = 0: mykey% = 0
  186.                     END SELECT
  187.  
  188.                     REM Control% = -1 or -2
  189.                 CASE -1, -2
  190.  
  191.                     SELECT CASE mykey%
  192.  
  193.                         CASE 65, 97 ' A a
  194.                             GOSUB SelectAll
  195.  
  196.                         CASE 67, 99, 88, 120 ' C c X x
  197.                             GOSUB cutcopy
  198.  
  199.                         CASE 86, 118 ' V v
  200.                             REM Paste
  201.                             GOSUB PasteClipboard
  202.  
  203.                         CASE 19712
  204.                             REM Cursor and arrow right
  205.                             GOSUB ctrlrt
  206.  
  207.                         CASE 19200
  208.                             REM Cursor and arrow left
  209.                             GOSUB ctrllt
  210.  
  211.                         CASE 18176
  212.                             GOSUB CursorHome ' Ctrl + Home
  213.  
  214.                         CASE 20224
  215.                             GOSUB CursorEnd ' Ctrl + End
  216.  
  217.                         CASE ELSE
  218.                             ' Do nothing.
  219.  
  220.                     END SELECT
  221.             END SELECT
  222.         END IF
  223.         EXIT DO
  224.     LOOP
  225.     RETURN '-----------------------------------------------------------------
  226.  
  227.     ' Key Actions.
  228.     CursorLeft:
  229.     IF POS(0) > leftmargin% THEN
  230.         LOCATE , POS(0) - CurAdvance%
  231.     ELSE
  232.         IF hscroll% THEN hscroll% = hscroll% - 1: GOSUB wash
  233.     END IF
  234.     RETURN '------------------------------------------------------------------
  235.  
  236.     CursorRight:
  237.     IF POS(0) < rightmargin% THEN
  238.         IF POS(0) + CurAdvance% <= leftmargin% - 1 + LEN(text$) + 1 THEN
  239.             IF POS(0) < rightmargin% THEN LOCATE , POS(0) + CurAdvance%
  240.         END IF
  241.     ELSE
  242.         IF hscrollon% THEN
  243.             IF hscroll% + rightmargin% - (leftmargin% - 1) <= LEN(text$) THEN
  244.                 hscroll% = hscroll% + 1
  245.                 GOSUB wash
  246.             END IF
  247.         END IF
  248.     END IF
  249.  
  250.     RETURN '------------------------------------------------------------------
  251.  
  252.     ctrllt:
  253.     IF highlight% <> 0 AND NOT shift% THEN GOSUB wash
  254.     texttemp$ = MID$(text$, 1, POS(0) - leftmargin% + 1 + hscroll%)
  255.     IF INSTR(texttemp$, " ") <> 0 THEN
  256.         FOR ictrllt% = POS(0) - leftmargin% + 1 + hscroll% TO 1 STEP -1
  257.             IF exitctrl% AND MID$(text$, ictrllt% - 1, 1) = " " THEN EXIT FOR
  258.             IF MID$(text$, ictrllt%, 1) <> " " THEN exitctrl% = -1
  259.             IF shift% THEN GOSUB HighlightLeft ELSE GOSUB CursorLeft
  260.         NEXT
  261.         exitctrl% = 0
  262.     ELSE
  263.         IF shift% THEN GOSUB SelectToHome ELSE GOSUB CursorHome
  264.     END IF
  265.     RETURN '---------------------------------------------------------------------
  266.  
  267.     ctrlrt:
  268.     IF highlight% <> 0 AND NOT shift% THEN GOSUB wash
  269.     texttemp$ = MID$(text$, POS(0) - leftmargin% + 1 + hscroll%)
  270.     IF INSTR(texttemp$, " ") <> 0 THEN
  271.         FOR ictrlrt% = POS(0) - leftmargin% + 1 + hscroll% TO LEN(text$)
  272.             IF MID$(text$, ictrlrt%, 1) <> " " THEN
  273.                 IF exitctrl% THEN EXIT FOR
  274.                 jctrlrt% = -1
  275.             END IF
  276.             IF MID$(text$, ictrlrt%, 1) = " " AND jctrlrt% THEN exitctrl% = -1
  277.             IF shift% THEN GOSUB HighlightRight ELSE GOSUB CursorRight
  278.         NEXT
  279.         exitctrl% = 0: ictrlrt% = 0: jctrlrt% = 0
  280.     ELSE
  281.         IF shift% THEN GOSUB SelectToEnd ELSE GOSUB CursorEnd
  282.     END IF
  283.     RETURN '---------------------------------------------------------------------
  284.  
  285.     CursorHome:
  286.     IF hscroll% <> 0 THEN hscroll% = 0: GOSUB wash
  287.     LOCATE , leftmargin%
  288.     RETURN '---------------------------------------------------------------------
  289.  
  290.     CursorEnd:
  291.     IF hscrollon% THEN
  292.         IF LEN(text$) > rightmargin% - (leftmargin% - 1) THEN
  293.             hscroll% = LEN(text$) - (rightmargin% - (leftmargin% - 1)) + 1: REM + 1 allows for adding to end of text.
  294.             GOSUB wash
  295.         END IF
  296.     END IF
  297.     IF LEN(text$) + leftmargin% - 1 >= rightmargin% THEN
  298.         LOCATE , rightmargin%
  299.     ELSE
  300.         LOCATE , leftmargin% - 1 + LEN(text$) + CurAdvance%
  301.     END IF
  302.     RETURN '---------------------------------------------------------------------
  303.  
  304.     CursorUp:
  305.     REM PRINT "Cursor Up"
  306.     RETURN
  307.  
  308.     CursorDown:
  309.     REM PRINT "Cursor Down"
  310.     RETURN '---------------------------------------------------------------------
  311.  
  312.     PageUp:
  313.     REM PRINT "Page Up"
  314.     RETURN
  315.  
  316.     PageDown:
  317.     REM PRINT "Page Down"
  318.     RETURN
  319.  
  320.     REM Highlighting -----------------------------------------------------------
  321.     HighlightLeft:
  322.     iyy% = CSRLIN: ixx% = POS(0)
  323.     IF POS(0) > leftmargin% OR hscroll% THEN
  324.  
  325.         IF highlight% AND POS(0) >= highlight% - hscroll% THEN ' Unhighlighting left to right.
  326.             ' Move back first and then calculate POS(0) - 1, below.
  327.             IF highlight% = starthighlight% THEN
  328.                 starthighlight% = 0: highlight% = 0
  329.             ELSE
  330.                 highlight% = POS(0) - 1 + hscroll% ' Diminishing.
  331.             END IF
  332.         ELSE ' Highlighting left to right.
  333.             ' Calculate first and then move back. POS(0).
  334.             IF highlight% = 0 THEN highlight% = POS(0) + hscroll%
  335.             starthighlight% = POS(0) + hscroll%
  336.         END IF
  337.  
  338.         IF POS(0) = leftmargin% AND hscroll% THEN hscroll% = hscroll% - 1 ' hscroll% is reduced after the calculations above.
  339.         c1% = textfg%: c2% = textbk%: c3% = highlightfg%: c4% = highlightbk%
  340.         texttemp$ = MID$(text$, 1 + hscroll%, rightmargin% - leftmargin% + 1)
  341.  
  342.         LOCATE iyy%, leftmargin%
  343.         COLOR c1%, c2%: PRINT MID$(texttemp$, 1, starthighlight% - hscroll% - leftmargin% - 1);
  344.         COLOR c3%, c4%: PRINT MID$(texttemp$, starthighlight% - hscroll% - leftmargin% + 0, ABS(highlight% - starthighlight%) + 1);
  345.         COLOR c1%, c2%: PRINT MID$(texttemp$, highlight% - hscroll% - leftmargin% + 1);
  346.  
  347.         IF ixx% - leftmargin% > 0 THEN ixx% = ixx% - 1 ' No moving cursor back when it is at left amrgin and scrolling text back.
  348.         LOCATE iyy%, ixx%
  349.         COLOR textfg%, textbk%
  350.     END IF
  351.     RETURN '---------------------------------------------------------------------
  352.  
  353.     HighlightRight:
  354.     iyy% = CSRLIN: ixx% = POS(0)
  355.     IF hscroll% + ixx% + 1 - leftmargin% <= LEN(text$) THEN
  356.         c1% = textfg%: c2% = textbk%: c3% = highlightfg%: c4% = highlightbk%
  357.  
  358.         IF POS(0) >= starthighlight% - hscroll% THEN
  359.             IF starthighlight% = 0 THEN starthighlight% = POS(0) + 1 + hscroll%
  360.             highlight% = POS(0) + 1 + hscroll%
  361.         ELSE
  362.             IF starthighlight% = highlight% THEN
  363.                 starthighlight% = 0: highlight% = 0
  364.             ELSE
  365.                 starthighlight% = POS(0) + 2 + hscroll%
  366.             END IF
  367.         END IF
  368.  
  369.         IF POS(0) = rightmargin% AND LEN(text$) - hscroll% > rightmargin% - leftmargin% THEN hscroll% = hscroll% + 1
  370.         texttemp$ = MID$(text$, 1 + hscroll%, rightmargin% - leftmargin% + 1)
  371.  
  372.         LOCATE iyy%, leftmargin%
  373.         COLOR c1%, c2%: PRINT MID$(texttemp$, 1, starthighlight% - hscroll% - leftmargin% - 1);
  374.         COLOR c3%, c4%: PRINT MID$(texttemp$, starthighlight% - hscroll% - leftmargin% + 0, ABS(highlight% - starthighlight%) + 1);
  375.         COLOR c1%, c2%: PRINT MID$(texttemp$, highlight% - hscroll% - leftmargin% + 1);
  376.         IF POS(0) = rightmargin% THEN PRINT SPACE$(1); ' Only used when highlighting past last character to include one blank space.
  377.         IF ixx% < rightmargin% THEN ixx% = ixx% + 1
  378.         LOCATE iyy%, ixx%
  379.         COLOR textfg%, textbk%
  380.     END IF
  381.     RETURN '---------------------------------------------------------------------
  382.  
  383.     ClickhighLight:
  384.     j% = 0
  385.     texttemp$ = MID$(text$, 1, POS(0) - leftmargin% + 1 + hscroll%)
  386.     FOR i% = LEN(texttemp$) TO 1 STEP -1
  387.         IF MID$(texttemp$, i%, 1) = " " AND j% THEN EXIT FOR ELSE j% = -1
  388.     NEXT
  389.     jClickhighLight% = LEN(texttemp$) - i% - 1
  390.     invokestarthighlight% = POS(0) + hscroll% - (LEN(texttemp$) - i%) + 1
  391.     FOR iClickhighLight% = 1 TO jClickhighLight%
  392.         IF POS(0) = leftmargin% THEN EXIT FOR
  393.         GOSUB CursorLeft
  394.     NEXT
  395.     shift% = -1
  396.     GOSUB ctrlrt
  397.     shift% = 0
  398.     invokestarthighlight% = 0: iClickhighLight% = 0: jClickhighLight% = 0
  399.     RETURN '---------------------------------------------------------------------
  400.  
  401.     SelectAll:
  402.     highlight% = 0: starthighlight% = 0: REM These are not zeroed as a ctrl keys bypass remove highlighting
  403.     GOSUB CursorHome
  404.     GOSUB SelectToEnd
  405.     RETURN '---------------------------------------------------------------------
  406.  
  407.     SelectToEnd:
  408.     IF mspan% = 0 THEN mspan% = POS(0) - leftmargin% + 1 + LEN(text$)
  409.     FOR iSelectToEnd% = 1 TO mspan%
  410.         GOSUB HighlightRight
  411.     NEXT
  412.     mspan% = 0: iSelectToEnd% = 0
  413.     RETURN '---------------------------------------------------------------------
  414.  
  415.     SelectToHome:
  416.     IF mspan% = 0 THEN
  417.         IF POS(0) = rightmargin% THEN
  418.             mspan% = rightmargin% - (leftmargin% - 1) + hscroll%
  419.         ELSE
  420.             mspan% = POS(0) - leftmargin% + 1 + hscroll%
  421.         END IF
  422.     END IF
  423.  
  424.     FOR iSelectToHome% = 1 TO mspan%
  425.         GOSUB HighlightLeft
  426.     NEXT
  427.     mspan% = 0: iSelectToHome% = 0
  428.     RETURN '---------------------------------------------------------------------
  429.  
  430.     DisplayText:
  431.     DO ' Falk loop.
  432.         IF mykey% > 31 AND mykey% < 256 THEN
  433.             LOCATE , , 1
  434.             IF overwrite% = -1 OR CurAdvance% = 0 THEN
  435.                 texttemp$ = MID$(text$, 1, POS(0) - leftmargin%) + CHR$(mykey%) + MID$(text$, POS(0) - leftmargin% + 2)
  436.             ELSE
  437.                 texttemp$ = MID$(text$, 1, POS(0) - leftmargin%) + CHR$(mykey%) + MID$(text$, POS(0) - leftmargin% + 1)
  438.             END IF
  439.  
  440.             positioncursor% = POS(0)
  441.  
  442.             IF overwrite% = -1 OR CurAdvance% = 0 THEN
  443.  
  444.                 IF POS(0) - leftmargin% + hscroll% < textmaxlength% THEN
  445.                     text$ = MID$(text$, 1, POS(0) + (hscroll%) - leftmargin%) + CHR$(mykey%) + MID$(text$, POS(0) + hscroll% - leftmargin% + 2)
  446.                 ELSE
  447.                     flagtext% = -1: EXIT DO 'To Return
  448.                 END IF
  449.  
  450.                 REM Evaluate Horizontal Scroll
  451.                 IF POS(0) = rightmargin% THEN
  452.                     hscroll% = hscroll% + 1
  453.                 END IF
  454.             ELSE
  455.                 IF LEN(text$) < textmaxlength% THEN
  456.                     text$ = MID$(text$, 1, POS(0) + hscroll% - leftmargin%) + CHR$(mykey%) + MID$(text$, POS(0) + hscroll% - leftmargin% + 1)
  457.                     flagtext% = 0
  458.                 ELSE
  459.                     flagtext% = -1
  460.                 END IF
  461.  
  462.                 IF flagtext% = -1 THEN EXIT DO ' To Return REM flagtext% is set to zero upon return and exit.
  463.  
  464.                 REM Evaluate Horizontal Scroll
  465.                 IF hscrollon% AND POS(0) = rightmargin% THEN
  466.                     hscroll% = hscroll% + 1
  467.                 END IF
  468.             END IF
  469.  
  470.             ' Print to form input line.
  471.             LOCATE , leftmargin%: PRINT STRING$(rightmargin% - (leftmargin% - 1), linecharacter%);
  472.             LOCATE , leftmargin%: PRINT MID$(text$, (hscroll% + 1), rightmargin% - (leftmargin% - 1));
  473.  
  474.             IF CurAdvance% = 1 AND positioncursor% - leftmargin% + 1 < rightmargin% - leftmargin% + 1 THEN
  475.                 LOCATE , positioncursor% + CurAdvance%
  476.             ELSE
  477.                 LOCATE , positioncursor%
  478.             END IF
  479.         END IF
  480.         EXIT DO
  481.     LOOP
  482.     RETURN '---------------------------------------------------------------------
  483.  
  484.     BackspaceDelete:
  485.     IF highlight% THEN GOSUB cutcopy
  486.     IF POS(0) > leftmargin% OR mykey% = 21248 OR hscroll% > 0 THEN
  487.         IF POS(0) <= leftmargin% + LEN(text$) THEN
  488.             IF mykey% = 8 THEN
  489.                 IF POS(0) <= leftmargin% + 2 AND hscroll% > 0 THEN
  490.                     REM Adjust for horizontal scroll
  491.                     holdcursor% = POS(0)
  492.                     LOCATE , leftmargin%
  493.                     countcolumnsmoved% = hscroll%
  494.                     jBackspaceDelete% = (rightmargin% - (leftmargin% - 1)) * .33
  495.                     IF jBackspaceDelete% < 3 AND rightmargin% - (leftmargin% - 1) > 3 THEN jBackspaceDelete% = 3: REM Set minimum scroll back.
  496.                     FOR iBackspaceDelete% = 1 TO jBackspaceDelete%
  497.                         GOSUB CursorLeft
  498.                     NEXT
  499.                     LOCATE , holdcursor% + countcolumnsmoved% - hscroll% - 1
  500.                     countcolumnsmoved% = 0: iBackspaceDelete% = 0: jBackspaceDelete% = 0
  501.                 ELSE
  502.                     LOCATE , POS(0) - 1
  503.                 END IF
  504.             END IF
  505.             iyy% = CSRLIN: ixx% = POS(0)
  506.             text$ = MID$(text$, 1, POS(0) - leftmargin% + hscroll%) + MID$(text$, POS(0) - leftmargin% + hscroll% + 2)
  507.             texttemp$ = MID$(text$, hscroll% + 1, rightmargin% - (leftmargin% - 1))
  508.             LOCATE iyy%, leftmargin%: PRINT texttemp$ + STRING$((rightmargin% - (leftmargin% - 1)) - LEN(texttemp$), linecharacter%);
  509.             LOCATE iyy%, ixx%
  510.         END IF
  511.     END IF
  512.     RETURN '---------------------------------------------------------------------
  513.  
  514.     cutcopy:
  515.     IF highlight% THEN
  516.         IF mykey% = 99 OR mykey% = 120 THEN
  517.             _CLIPBOARD$ = MID$(text$, starthighlight% - leftmargin%, highlight% - starthighlight% + 1)
  518.         END IF
  519.  
  520.         IF mykey% = 88 OR mykey% = 120 OR mykey% = 8 OR mykey% = 21248 THEN ' ctrl + x (cut), delete, backspace.
  521.             positioncursor% = starthighlight% - 1 - hscroll%
  522.             texttemp$ = MID$(text$, 1, starthighlight% - leftmargin% - 1) + MID$(text$, highlight% - leftmargin% + 1)
  523.             text$ = texttemp$
  524.             hscroll% = hscroll% - ABS(highlight% - starthighlight%)
  525.             IF hscroll% < 0 THEN hscroll% = 0
  526.             LOCATE , positioncursor%
  527.             GOSUB wash
  528.         END IF
  529.     END IF
  530.     RETURN '---------------------------------------------------------------------
  531.  
  532.     PasteClipboard:
  533.     IF LEN(text$) + LEN(_CLIPBOARD$) <= textmaxlength% THEN
  534.         text$ = MID$(text$, 1, POS(0) - leftmargin% + hscroll%) + _CLIPBOARD$ + MID$(text$, POS(0) - leftmargin% + 1 + hscroll%)
  535.         i% = LEN(_CLIPBOARD$) - (rightmargin% - POS(0))
  536.         positioncursor% = POS(0) + LEN(_CLIPBOARD$) - 1 + CurAdvance%
  537.         IF positioncursor% > rightmargin% THEN
  538.             hscroll% = hscroll% + positioncursor% - rightmargin%
  539.             positioncursor% = rightmargin%
  540.         END IF
  541.         LOCATE , positioncursor%
  542.         GOSUB wash
  543.     ELSE
  544.         BEEP
  545.     END IF
  546.     RETURN '---------------------------------------------------------------------
  547.  
  548.     InsertOverwrite:
  549.     IF overwrite% = 0 THEN
  550.         overwrite% = -1
  551.         LOCATE , , 1, 7, 30
  552.     ELSE
  553.         overwrite% = 0
  554.         LOCATE , , 1, 7, 7
  555.     END IF
  556.     RETURN
  557.     ' End Key Controls-------------------------------------------------------
  558.  
  559.     mouseroutine:
  560.     DO ' Falk loop
  561.         IF shiftclick% THEN
  562.             IF shiftclick% > 0 THEN mykey% = 19712: shiftclick% = shiftclick% - 1 ELSE mykey% = 19200: shiftclick% = shiftclick% + 1
  563.             EXIT DO ' To Return
  564.         END IF
  565.  
  566.         IF _KEYDOWN(100303) OR _KEYDOWN(100304) THEN shift% = -1 ELSE shift% = 0
  567.  
  568.         IF 0 = 0 THEN
  569.  
  570.             IF mb.l THEN
  571.                 IF mx% > leftmargin% + LEN(text$) THEN EXIT DO ' To Return
  572.  
  573.                 IF click_l% >= 0 THEN
  574.                     click_l% = -1
  575.                     IF highlight% AND NOT shift% THEN GOSUB wash
  576.                 END IF
  577.  
  578.                 IF shift% THEN
  579.                     SELECT CASE mx%
  580.                         CASE IS > POS(0): mykey% = 19712: shiftclick% = mx% - POS(0) - 1
  581.                         CASE IS = POS(0): mykey% = 0
  582.                         CASE IS < POS(0): mykey% = 19200: shiftclick% = mx% - POS(0) + 1
  583.                     END SELECT
  584.                     IF mykey% THEN EXIT DO ' To Return
  585.                 END IF
  586.             ELSE
  587.                 IF click_l% = -1 THEN click_l% = 1: drag% = 0
  588.             END IF
  589.  
  590.             IF click_l% = -1 THEN
  591.                 IF mx% = POS(0) THEN
  592.                     drag% = -1
  593.                 ELSE
  594.                     IF my% = CSRLIN AND drag% = 0 THEN
  595.                         LOCATE my%, mx% ' Click in input field.
  596.                     END IF
  597.                 END IF
  598.             END IF
  599.  
  600.             IF drag% THEN
  601.                 shift% = -1
  602.                 SELECT CASE mx%
  603.                     CASE IS > POS(0): mykey% = 19712: IF mx% > rightmargin% THEN _DELAY .05
  604.                     CASE IS = POS(0): mykey% = 0
  605.                     CASE IS < POS(0): mykey% = 19200: IF mx% < leftmargin% THEN _DELAY .05
  606.                 END SELECT
  607.             END IF
  608.  
  609.             EXIT DO ' To Return
  610.         END IF
  611.         EXIT DO
  612.     LOOP
  613.     RETURN
  614.  
  615.     '-------------------------------Nested Gosubs-----------------------------
  616.     wash:
  617.     starthighlight% = 0
  618.     highlight% = 0
  619.     iyy% = CSRLIN: ixx% = POS(0)
  620.     COLOR textfg%, textbk%
  621.     LOCATE , leftmargin%
  622.     texttemp$ = MID$(text$, (hscroll% + 1), rightmargin% - (leftmargin% - 1))
  623.     PRINT texttemp$ + STRING$(rightmargin% - (leftmargin% - 1) - LEN(texttemp$), linecharacter%);
  624.     LOCATE iyy%, ixx%
  625.     RETURN '---------------------------------------------------------------------
  626.  
  627.     selection_made:
  628.     CLS: PRINT text$
  629.     RETURN '---------------------------------------------------------------------
  630.  
  631.  
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Dav

  • Forum Resident
  • Posts: 792
    • View Profile
Re: Who says Pete can't use _KEYHIT?
« Reply #1 on: January 21, 2021, 10:32:24 pm »
This works very well, Pete!  Does everything I would want, and uses the keys I'm used to using, in regard to highlighting and such (shit + arrows for selection).  Scrolls longer text, highlights, copies, paste, allows mouse selection.  Works fine. 

Solid SUB.  Self contained too, so adding it to programs will be a snap.  (Glad to see I'm not the only one who's still using GOSUB!).

- Dav

Offline Sanmayce

  • Newbie
  • Posts: 63
  • Where is that English Text Sidekick?
    • View Profile
    • Sanmayce's home
Re: Who says Pete can't use _KEYHIT?
« Reply #2 on: January 22, 2021, 03:20:57 am »
Ditto @Dav , tried myself many things as CTRL+Shift+Arrows, mouse selecting, copying... works nice, will in next weeks exhaustively check the code out.

Thank you @Pete for sharing, a must-have SUB, indeed.
He learns not to learn and reverts to what all men pass by.

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Who says Pete can't use _KEYHIT?
« Reply #3 on: January 22, 2021, 04:05:20 am »
(shit + arrows for selection)...

shit + arrows? Hmm, maybe if I compact the code, I could reduce that to darts + frog venom.

Part of me wants to make an INKEY$ version. I use PEEK for the shift key in that one. Part of me also wants to try it in a graphics mode. I'm just not used to COLOR in graphic and I'm not sure if the PRINT and LOCATE statements would need to be changed. It would be nice if there was a simple method to apply for conversion, instead of a complete rewrite.

Thanks fro trying it, and making the typo. I needed a good laugh after this last election.

Pete :D
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/