QB64.org Forum

Active Forums => QB64 Discussion => Topic started by: Pete on January 20, 2021, 02:48:14 pm

Title: Who says Pete can't use _KEYHIT?
Post by: Pete 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. END SUB
632.  

Title: Re: Who says Pete can't use _KEYHIT?
Post by: Dav 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

Title: Re: Who says Pete can't use _KEYHIT?
Post by: Sanmayce 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.

Title: Re: Who says Pete can't use _KEYHIT?
Post by: Pete on January 22, 2021, 04:05:20 am

Quote from: Dav on January 21, 2021, 10:32:24 pm

(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

Text Only | Text with Attachments