enl%
= 13:
CALL windowscreen
(enl%
)
REDIM SHARED formbuttony%
(3), formbuttonx%
(3), formbutton$
(3)
margin.t = 2
margin.l = 5
dwidth = 68
page.h = 6
row = 1
noe = 13
x$
(1) = "We the People of the United States, in Order to form a more perfect " + CHR$(10) x$
(2) = "Union, establish Justice, insure domestic Tranquility, provide for " + CHR$(10) x$
(3) = "the common defence, promote the general Welfare, and secure the " + CHR$(10) x$
(4) = "Blessings of Liberty to ourselves and our Posterity, do ordain and " + CHR$(10) x$
(5) = "establish this Constitution for the United States of America." + CHR$(10) x$
(7) = "Article I" + CHR$(10) x$
(9) = "Section 1: Congress" + CHR$(10) x$
(11) = "All legislative Powers herein granted shall be vested in a Congress " + CHR$(10) x$
(12) = "of the United States, which shall consist of a Senate and House of " + CHR$(10) x$
(13) = "Representatives." + CHR$(10) DIM SHARED pete
, ifield%
, noif%
, ifrow%
, change_initiate%
change_initiate%
= -1:
CALL popup
(msg$
, msg%
, button$
(), button%
, button_index%
, find$
, config%
) ' Note: find$ is pass by ref find$ becomes text$ in popup sub and returns text$ back to find$ here.
CASE "Whole Word" ' Default selection if Enter is used instead of a button. whole_word% = 1
case_sensitive% = 0
whole_word% = 1
case_sensitive% = 1
whole_word% = 0
case_sensitive% = 0
whole_word% = 0
case_sensitive% = 1
CLS:
PRINT "No config% assigned to this case. "; config%:
END ''' action$ = ""
IF scr
+ page.h
< noe
THEN row
= page.h: scr
= scr
+ 1:
GOSUB displaydoc:
GOSUB finder
displaydoc:
LOCATE margin.t
+ i%
, margin.l
+ 1
finder:
find$
= LCASE$(find$
): findorig$
= find$
findorig$ = find$
flag% = 0
LOCATE margin.t
+ i%
, margin.l
+ 1
a2$ = a1$ ' No space for a solid line wrap around.
a2$
= a2$
+ MID$(x$
(i%
+ 1 + scr
), 1, INSTR(x$
(i%
+ 1 + scr
), CHR$(10)) - 1) a2% = -1
a2% = 0
CASE 0 ' Not case sensitive. CASE 0 ' Part word and not case sensitive.
find$
= MID$(findorig$
, 1, LEN(a1$
) - seed%
) flag% = 1
LOCATE margin.t
+ i%
, margin.l
+ seed%
seed%
= seed%
+ LEN(find$
)
flag% = 0: find$ = findorig$
flag% = 2
find$
= MID$(findorig$
, LEN(find$
) + 2) seed% = 0
CASE 1 ' Whole word and not case sensitive.
find$
= MID$(findorig$
, 1, LEN(a1$
) - seed%
) flag% = 1
LOCATE margin.t
+ i%
, margin.l
+ seed%
seed%
= seed%
+ LEN(find$
)
flag% = 0
find$ = findorig$
flag% = 2
find$
= MID$(findorig$
, LEN(find$
) + 2) seed% = 0
seed%
= seed%
+ LEN(find$
)
CASE 0 ' Part word and case sensitive. seed%
= INSTR(seed%
, a2$
, find$
)
k%
= INSTR(seed%
, a2$
, find$
) seed%
= INSTR(seed%
, a2$
, find$
) find$
= MID$(findorig$
, 1, LEN(a1$
) - seed%
) flag% = 1
seed%
= INSTR(seed%
, a2$
, find$
) seed%
= INSTR(seed%
, a2$
, find$
)
LOCATE margin.t
+ i%
, margin.l
+ seed%
seed%
= seed%
+ LEN(find$
)
flag% = 0: find$ = findorig$
flag% = 2
find$
= MID$(findorig$
, LEN(find$
) + 2) seed% = 0
seed%
= seed%
+ LEN(find$
)
CASE 1 ' Whole word and case sensitive. seed%
= INSTR(seed%
, a2$
, find$
)
k%
= INSTR(seed%
, a2$
, find$
) seed%
= INSTR(seed%
, a2$
, find$
) find$
= MID$(findorig$
, 1, LEN(a1$
) - seed%
) flag% = 1
seed%
= INSTR(seed%
, a2$
, find$
) seed%
= INSTR(seed%
, a2$
, find$
)
LOCATE margin.t
+ i%
, margin.l
+ seed%
seed%
= seed%
+ LEN(find$
)
flag% = 0: find$ = findorig$
flag% = 2
find$
= MID$(findorig$
, LEN(find$
) + 2) seed% = 0
seed%
= seed%
+ LEN(find$
)
replacer:
find$ = entry$(1)
r$ = entry$(2)
a$ = ""
a$ = " " + a$: a$ = a$ + " "
' parse a$
seed% = 0: j = 0
seed%
= seed%
+ LEN(find$
)
j = j + 1: x$(j) = x$
a$ = ""
j = j + 1
j = j + 1: x$(j) = x$
noe = j
SUB popup
(msg$
, msg%
, button$
(), button%
, button_index%
, text$
, config%
)
config% = 2 ' Find
msg$ = ""
ifield% = 48 ' Input field length.
ifield$(1) = "Find:"
button% = 4: button_index% = 4
w1% = 0: w2% = 0: w3% = 0: w4% = 0
noif% = 1
config% = 3 ' Find / Replace
msg$ = ""
ifield% = 48
ifield$(1) = " Find:"
ifield$(2) = "Replace:"
button% = 4: button_index% = 4
w1% = 0: w2% = 0: w3% = 7: w4% = 0
noif% = 2
REDIM button$
(8), ifieldyy%
(noif%
), ifieldxx%
(noif%
) button$(1) = "Yes": button$(2) = "No!"
button$(3) = "Retry": button$(4) = "Cancel"
button$(5) = "Whole Word": button$(6) = "Whole/Case": button$(7) = "Any Part": button$(8) = "Any/Case"
IF w3%
= 0 THEN w3%
= 5 ' Min.
IF w4%
= 0 THEN ' Calculate forn container width w4%
= LEN(msg$
) + 4 ' Min IF LEN(ifield$
(i%
)) + ifield%
> w4%
THEN w4%
= LEN(ifield$
(i%
)) + ifield%
+ 6
' Auto-Center
w2%
= _WIDTH \
2 - w4% \
2 + .5
oldsmode
= SMODE:
PCOPY 0, 1:
SCREEN 0, 0, 1, 1: SMODE
= 1 oldsmode
= SMODE:
PCOPY 1, 2:
SCREEN 0, 0, 2, 2: SMODE
= 2
LOCATE w1%
, w2%
, 0 ' Cursor hide A$ = ""
LOCATE w1%
+ 1, w2%
+ w4% \
2 - LEN(msg$
) \
2 CASE 0 ' No message title. Usually used with input fields with limited vertical space. ifrow% = 1
IF UBOUND(ifield$
) > 1 THEN i%
= 2: j%
= UBOUND(ifield$
) ELSE i%
= 0: j%
= 1 ' Where 2 is the spacing between input fields. LOCATE w1%
+ w3% \
2 - j%
+ i%
* (g%
- 1), w2%
+ w4% \
2 - (ifield%
+ LEN(ifield$
(g%
)) + 2) \
2 ifieldyy%
(g%
) = CSRLIN: ifieldxx%
(g%
) = POS(0) + LEN(ifield$
(g%
)) + 1 ' Start of text input line. passrightmargin%
= POS(0) - 1 ' Sets right margin of the input field.
j% = 0
j%
= j%
+ LEN(button$
(button_index%
+ i%
)) + 2 LOCATE buttonyy%
, w2%
+ w4% \
2 - j% \
2 - 1 k% = 0
FOR i%
= button_index%
+ 1 TO button_index%
+ button%
k% = k% + 1
LOCATE buttonyy%
, w2%
+ w4% \
2 - j% \
2 k% = 0
' Prints names on buttons.
FOR i%
= button_index%
+ 1 TO button_index%
+ button%
k% = k% + 1
LOCATE ifieldyy%
(ifrow%
), ifieldxx%
(ifrow%
), 1 tabx% = 0: action$ = ""
inputfieldyy%
= CSRLIN: inputfieldxx%
= POS(0)
CALL textinput
(text$
, passrightmargin%
, mykey%
, doctype$
, doctype$
(), doctype%
, doctypey%
(), doctypex%
(), x$
(), xfull$
(), scrb
, noe
, row
, scr
, config%
, b$
)
CALL user
(b$
, mx%
, my%
, alt%
, shift%
, ctrl%
, ctrlshift%
, con_panel%
, doc_status_saved%
)
action$
= "poll input lines":
GOSUB tab_and_enter_fields: action$
= "" IF LEN(b$
) THEN ' b$ can be made null in the gosub above. This occurs when there are still more fields to fill in. action$ = "Whole Word" ' F3 Find option.
action$ = "Whole/Case" ' F3 Find option.
' Find Function only.
action$ = "Any Part" ' F3 Find option.
action$ = "Any/Case" ' F3 Find option.
IF button_index%
= 0 THEN action$
= "yes" IF button_index%
= 2 THEN action$
= "retry" IF button_index%
= 0 THEN action$
= "no" IF button_index%
= 2 THEN action$
= "abort" action$ = "close"
IF LEN(action$
) THEN EXIT DO ''''' Newly added. Delete this if it causes problems.
IF bhl%
THEN IF bhl%
= 1 AND my%
<> mouselocator%
OR bhl%
= 1 AND MID$(mouselocator$
, mx%
, 1) = "0" THEN tabx%
= 0: bhl%
= 0
IF oldmx%
= mx%
AND oldmy%
= my%
THEN i%
= 0 ELSE i%
= -1 ' Mouse has moved. IF b$
= CHR$(9) THEN k%
= tabx%: bhl%
= 9 ELSE k%
= VAL(MID$(mouselocator$
, mx%
, 1)): tabx%
= k%: bhl%
= 1 IF pete
THEN LOCATE , , 0 ' Hide cursor while making buttons.
entry$(ifrow%) = text$
h% = k%: tabx% = h%
h% = 0: tabx% = 0
'''''''''''IF pete THEN LOCATE yy2, xx2, 1
''' ss = CSRLIN: rr = POS(0): LOCATE 1, 41: PRINT mb.l, _MOUSEBUTTON(1): LOCATE ss, rr
IF closex%
THEN SOUND 1000, .1: closex%
= 0: action$
= "close" IF my%
= mouselocator%
AND MID$(mouselocator$
, mx%
, 1) <> "0" THEN IF button_index%
= 0 THEN action$
= "yes" IF button_index%
= 2 THEN action$
= "retry" IF button_index%
= 4 THEN action$
= "Whole Word":
GOSUB tab_and_enter_fields
' F3 Find option. IF button_index%
= 0 THEN action$
= "no" IF button_index%
= 2 THEN action$
= "abort" IF button_index%
= 4 THEN action$
= "Whole/Case":
GOSUB tab_and_enter_fields
' F3 Find option. ' Find Function only.
IF button_index%
= 4 THEN action$
= "Any Part":
GOSUB tab_and_enter_fields
' F3 Find option. IF button_index%
= 4 THEN action$
= "Any/Case":
GOSUB tab_and_enter_fields
' F3 Find option.
IF mx%
>= ifieldxx%
(1) AND mx%
<= ifieldxx%
(1) + ifield%
AND my%
>= ifieldyy%
(1) AND my%
<= ifieldyy%
(UBOUND(ifield$
)) THEN ''ss = CSRLIN: rr = POS(0): LOCATE 1, 1: PRINT i%; ifrow%; my%; ifieldyy%(ifrow%), ifieldxx%(1); mx%; ifieldxx%(1) + ifield%: LOCATE ss, rr
entry$(ifrow%) = text$
ifrow% = 0
text$ = entry$(ifrow%)
IF b$
= CHR$(9) THEN b$
= "" ''''''IS THIS EVEN NECESSARY ANYMORE??? oldmy% = my%: oldmx% = mx%
LOOP UNTIL LEN(action$
) ''' An exit with len(action$) was added many lines up, so maybe this could be just loop?
SMODE
= oldsmode:
SCREEN 0, 0, SMODE
, SMODE
ELSE ' No buttons present. LOCATE w1%
+ w3% \
2, w2%
+ w4% \
2 - LEN(msg$
) \
2
clear_button:
tab_and_enter_fields:
IF tabx%
= button%
THEN ' Last tab button is highlighted. Go back to input fields. h%
= button%:
GOSUB clear_button
entry$(ifrow%) = text$
tabx% = 0
LOCATE ifieldyy%
(ifrow%
), ifieldxx%
(ifrow%
), 1 b$ = ""
' Remove any highlighting.
LOCATE ifieldyy%
(ifrow%
), ifieldxx%
(ifrow%
), 0 LOCATE ifieldyy%
(ifrow%
), ifieldxx%
(ifrow%
) entry$(ifrow%) = text$
tabx% = 1 ' To reloop.
entry$(ifrow%) = text$
entry$(ifrow%) = text$
ifrow% = ifrow% + 1
LOCATE ifieldyy%
(ifrow%
), ifieldxx%
(ifrow%
), 1 b$ = ""
tabx% = tabx% + 1
SUB user
(b$
, mx%
, my%
, alt%
, shift%
, ctrl%
, ctrlshift%
, con_panel%
, doc_status_saved%
)
'''IF _EXIT THEN CALL exit_warning(doc_status_saved%)
alt% = -1: con_panel% = -1
IF alt%
THEN alt%
= 0: con_panel%
= 1
mb.w = 0
SUB textinput
(text$
, passrightmargin%
, mykey%
, doctype$
, doctype$
(), doctype%
, doctypey%
(), doctypex%
(), x$
(), xfull$
(), scrb
AS my_scrb
, noe
AS INTEGER, row
, scr
, config%
, b$
) STATIC hscrollon%
, hscroll%
, textfg%
, textbk%
, highlightfg%
, highlightbk%
, leftmargin%
, rightmargin%
, noleadingspace%
, textmaxlength%
, linecharacter%
, click_l%
, drag%
, shiftclick%
, tabx%
STATIC starthighlight%
, highlight%
, overwrite%
, CurAdvance%
IF change_initiate%
THEN change_initiate%
= 0: initiate%
= 0 ' Resets initiate%. Use when calling this sub to change settings like leftmargin% by zeroing static variable initiate%. '''vartable% = 2: CALL setvariables(scrb, c1%, c2%, c1alt%, h1%, h2%, row, ins%, dwidth, dwidth2, menubar%)
row = 1: tabx% = 2: thumb% = 0
IF NOT initiate%
THEN ' Initiate textinput variables. initiate% = -1
' --------------------POLL MOUSE--->
mb.w = 0
'<----------------------------------
'''ss = CSRLIN: rr = POS(0): LOCATE 1, 1: PRINT mb.l, _MOUSEBUTTON(1): LOCATE ss, rr
IF noleadingspace%
THEN ' Remove leading spaces of any text entry in form.
'-------------------------------------------------------------------------
'''IF _EXIT THEN CALL exit_warning(doc_status_saved%)
''''''IF mykey% = 0 THEN GOSUB file_display_keys
GOSUB form_input_keyroutine
'-------------------------------------------------------------------------
oldmy% = my%: oldmx% = mx%
'---------------------------GOSUB STATEMENTS-----------------------------
initiate_variables:
PageWidth1% = 80
PageWidth2% = 25
Topmargin% = 3
BottomMargin% = PageWidth2% - UpFromBottom%
UpFromBottom% = 2
BlockSize%
= 0:
REM -1 = variable.
TabElements%
= 1:
REM Number of
input fields horizontally arranged.
- 1 indicates variable.
ColorPrompt%
= 0:
REM 0 = COLOR 7, 0. Set all foreground
/background by background
* 16 + background.
ColorResponse%
= 0:
REM 0 will use textfg%
and textbk%
as defaults; otherwise set all foreground
/background by background
* 16 + background.
InputFieldLength%
= 0:
REM Set
to a number
to allow variable length fields; otherwise filed
input length will be determined by rightmargin%
- (leftmargin%
- 1).
PromptColumn%
= 1:
REM Column where prompt starts. Use
0 if no prompts. Use
-1 for multiple prompts
on same row.
TableStyle%
= 0:
REM 0 = Prompt
/Space
/Input, 1 = Prompt
/Colon
+Space
/Response
, 2 = Prompt
/Spacers
/Response
Spacer$
= ".":
REM Type of spacer character
if spacers are used
(Table Style
2).
textfg% = 7
textbk% = 0
highlightfg% = 0
highlightbk% = 7
rightmargin% = passrightmargin%
textmaxlength% = 250
noleadingspace% = -1
linecharacter%
= 255:
REM Blank space
IF textmaxlength%
> rightmargin%
- (leftmargin%
- 1) THEN hscrollon%
= -1 IF rightmargin%
< leftmargin%
THEN CLS:
PRINT "Rightmargin% cannot be smaller than leftmargin%. Redo.":
END IF leftmargin%
< 1 OR leftmargin%
> 80 THEN CLS:
PRINT "Leftmargin% is not within 1 - 80 range. Redo.":
END REM no longer valid with hscroll.
IF textmaxlength%
> rightmargin%
- leftmargin%
+ 1 THEN CLS:
PRINT "textmaxlength% cannot exceed rightmargin% - leftmargin% + 1. Redo.:end" IF LEN(text$
) > textmaxlength%
THEN CLS:
PRINT "Text length cannot start out larger than textmaxlength%. Redo.":
END
IF rightmargin%
= leftmargin%
AND textmaxlength%
= 1 THEN CurAdvance% = 0
CurAdvance% = 1
LOCATE iyy%
, leftmargin%
, 1, 7, 7 RETURN '-----------------------------------------------------------------
form_input_keyroutine:
IF SMODE
= 3 THEN ' Doctype dropdown is open. CASE 9, 27 ' Close doctype dropdown. GOSUB close_doctype_dropdown
GOSUB close_doctype_dropdown
GOSUB doctype_selected
' (Gosub parameter i%) mykey% = 0
' Process text if cursor is on form field text input line.
CASE 18176, 20224, 19200, 19712, 21248, 20992 shift% = -1
control% = -2
control% = -1
control% = 0
REM Evaluate changes
to highlighted text
, excluding cut
/copy
/paste
mykey%
= 88:
REM Convert Delete
to Cut
DO ' Single falks do/loop. formbuttonx%
(1) = ABS(formbuttonx%
(1)) action$ = "open file"
action$ = "save as"
'''myfile$ = text$
action$ = "cancel"
CASE 1 ' File selected from display window. tabx% = 2
CASE 2 ' Save or Open selected file. action$ = "open file"
action$ = "save as"
tabx% = 2
'''myfile$ = text$
CASE 3 ' Open doctype dropdown menu. CASE 4 ' Save or Open selected file. Only occurs when tab selected then mouse goes on another button and then goes to a neutral position. In this case the variable is no longer negative and the loop above misses it. action$ = "open file"
action$ = "save as"
tabx% = 2
action$ = "cancel": tabx% = 2
IF flagtext%
= -1 THEN flagtext%
= 0: mykey%
= 0
CASE 67, 99, 88, 120 ' C c X x
GOSUB CursorHome
' Ctrl + Home
GOSUB CursorEnd
' Ctrl + End
' Do nothing.
RETURN '-----------------------------------------------------------------
' Key Actions.
tabkey:
tabx% = tabx% + 1
i%
= 0:
GOSUB displaybutton
LOCATE w1%
+ w3%
- 4 - 3, w2%
+ 15, 1 i%
= -1:
GOSUB displaybutton
i%
= -2:
GOSUB displaybutton
i%
= -3:
GOSUB displaybutton
b$
= "": mykey%
= 0: null$
= INKEY$: k%
= _KEYHIT ' Clear keyboard buffers RETURN '------------------------------------------------------------------
CursorLeft:
RETURN '------------------------------------------------------------------
CursorRight:
IF POS(0) + CurAdvance%
<= leftmargin%
- 1 + LEN(text$
) + 1 THEN IF hscroll%
+ rightmargin%
- (leftmargin%
- 1) <= LEN(text$
) THEN hscroll% = hscroll% + 1
RETURN '------------------------------------------------------------------
ctrllt:
texttemp$
= MID$(text$
, 1, POS(0) - leftmargin%
+ 1 + hscroll%
) FOR ictrllt%
= POS(0) - leftmargin%
+ 1 + hscroll%
TO 1 STEP -1 IF MID$(text$
, ictrllt%
, 1) <> " " THEN exitctrl%
= -1 exitctrl% = 0
RETURN '---------------------------------------------------------------------
ctrlrt:
texttemp$
= MID$(text$
, POS(0) - leftmargin%
+ 1 + hscroll%
) FOR ictrlrt%
= POS(0) - leftmargin%
+ 1 + hscroll%
TO LEN(text$
) jctrlrt% = -1
IF MID$(text$
, ictrlrt%
, 1) = " " AND jctrlrt%
THEN exitctrl%
= -1 exitctrl% = 0: ictrlrt% = 0: jctrlrt% = 0
RETURN '---------------------------------------------------------------------
CursorHome:
RETURN '---------------------------------------------------------------------
CursorEnd:
IF LEN(text$
) > rightmargin%
- (leftmargin%
- 1) THEN hscroll%
= LEN(text$
) - (rightmargin%
- (leftmargin%
- 1)) + 1:
REM + 1 allows
for adding
to end of text.
IF LEN(text$
) + leftmargin%
- 1 >= rightmargin%
THEN LOCATE , leftmargin%
- 1 + LEN(text$
) + CurAdvance%
RETURN '---------------------------------------------------------------------
CursorUp:
CursorDown:
IF formbuttonx%
(1) < 0 OR tabx%
= 3 THEN ' Opens the doctype dropdown menu. formbuttonx%
(1) = ABS(formbuttonx%
(1)) RETURN '---------------------------------------------------------------------
PageUp:
PageDown:
REM Highlighting
----------------------------------------------------------- HighlightLeft:
IF highlight%
AND POS(0) >= highlight%
- hscroll%
THEN ' Unhighlighting left to right. ' Move back first and then calculate POS(0) - 1, below.
IF highlight%
= starthighlight%
THEN starthighlight% = 0: highlight% = 0
highlight%
= POS(0) - 1 + hscroll%
' Diminishing. ELSE ' Highlighting left to right. ' Calculate first and then move back. POS(0).
IF highlight%
= 0 THEN highlight%
= POS(0) + hscroll%
starthighlight%
= POS(0) + hscroll%
IF POS(0) = leftmargin%
AND hscroll%
THEN hscroll%
= hscroll%
- 1 ' hscroll% is reduced after the calculations above. c1% = textfg%: c2% = textbk%: c3% = highlightfg%: c4% = highlightbk%
texttemp$
= MID$(text$
, 1 + hscroll%
, rightmargin%
- leftmargin%
+ 1)
COLOR c1%
, c2%:
PRINT MID$(texttemp$
, 1, starthighlight%
- hscroll%
- leftmargin%
- 1);
COLOR c3%
, c4%:
PRINT MID$(texttemp$
, starthighlight%
- hscroll%
- leftmargin%
+ 0, ABS(highlight%
- starthighlight%
) + 1);
COLOR c1%
, c2%:
PRINT MID$(texttemp$
, highlight%
- hscroll%
- leftmargin%
+ 1);
IF ixx%
- leftmargin%
> 0 THEN ixx%
= ixx%
- 1 ' No moving cursor back when it is at left amrgin and scrolling text back. RETURN '---------------------------------------------------------------------
HighlightRight:
IF hscroll%
+ ixx%
+ 1 - leftmargin%
<= LEN(text$
) THEN c1% = textfg%: c2% = textbk%: c3% = highlightfg%: c4% = highlightbk%
IF starthighlight%
= 0 THEN starthighlight%
= POS(0) + 1 + hscroll%
highlight%
= POS(0) + 1 + hscroll%
IF starthighlight%
= highlight%
THEN starthighlight% = 0: highlight% = 0
starthighlight%
= POS(0) + 2 + hscroll%
IF POS(0) = rightmargin%
AND LEN(text$
) - hscroll%
> rightmargin%
- leftmargin%
THEN hscroll%
= hscroll%
+ 1 texttemp$
= MID$(text$
, 1 + hscroll%
, rightmargin%
- leftmargin%
+ 1)
COLOR c1%
, c2%:
PRINT MID$(texttemp$
, 1, starthighlight%
- hscroll%
- leftmargin%
- 1);
COLOR c3%
, c4%:
PRINT MID$(texttemp$
, starthighlight%
- hscroll%
- leftmargin%
+ 0, ABS(highlight%
- starthighlight%
) + 1);
COLOR c1%
, c2%:
PRINT MID$(texttemp$
, highlight%
- hscroll%
- leftmargin%
+ 1);
IF POS(0) = rightmargin%
THEN PRINT SPACE$(1);
' Only used when highlighting past last character to include one blank space. IF ixx%
< rightmargin%
THEN ixx%
= ixx%
+ 1 RETURN '---------------------------------------------------------------------
ClickhighLight:
j% = 0
texttemp$
= MID$(text$
, 1, POS(0) - leftmargin%
+ 1 + hscroll%
) jClickhighLight%
= LEN(texttemp$
) - i%
- 1 invokestarthighlight%
= POS(0) + hscroll%
- (LEN(texttemp$
) - i%
) + 1 FOR iClickhighLight%
= 1 TO jClickhighLight%
shift% = -1
shift% = 0
invokestarthighlight% = 0: iClickhighLight% = 0: jClickhighLight% = 0
RETURN '---------------------------------------------------------------------
SelectAll:
highlight%
= 0: starthighlight%
= 0:
REM These are
not zeroed
as a ctrl keys bypass remove highlighting
RETURN '---------------------------------------------------------------------
SelectToEnd:
IF mspan%
= 0 THEN mspan%
= POS(0) - leftmargin%
+ 1 + LEN(text$
) FOR iSelectToEnd%
= 1 TO mspan%
mspan% = 0: iSelectToEnd% = 0
RETURN '---------------------------------------------------------------------
SelectToHome:
mspan% = rightmargin% - (leftmargin% - 1) + hscroll%
mspan%
= POS(0) - leftmargin%
+ 1 + hscroll%
FOR iSelectToHome%
= 1 TO mspan%
mspan% = 0: iSelectToHome% = 0
RETURN '---------------------------------------------------------------------
DisplayText:
IF overwrite%
= -1 OR CurAdvance%
= 0 THEN texttemp$
= MID$(text$
, 1, POS(0) - leftmargin%
) + CHR$(mykey%
) + MID$(text$
, POS(0) - leftmargin%
+ 2) texttemp$
= MID$(text$
, 1, POS(0) - leftmargin%
) + CHR$(mykey%
) + MID$(text$
, POS(0) - leftmargin%
+ 1)
IF overwrite%
= -1 OR CurAdvance%
= 0 THEN
IF POS(0) - leftmargin%
+ hscroll%
< textmaxlength%
THEN text$
= MID$(text$
, 1, POS(0) + (hscroll%
) - leftmargin%
) + CHR$(mykey%
) + MID$(text$
, POS(0) + hscroll%
- leftmargin%
+ 2) flagtext%
= -1:
EXIT DO 'To Return
REM Evaluate Horizontal Scroll
hscroll% = hscroll% + 1
text$
= MID$(text$
, 1, POS(0) + hscroll%
- leftmargin%
) + CHR$(mykey%
) + MID$(text$
, POS(0) + hscroll%
- leftmargin%
+ 1) flagtext% = 0
flagtext% = -1
IF flagtext%
= -1 THEN EXIT DO ' To Return REM flagtext% is set to zero upon return and exit.
REM Evaluate Horizontal Scroll
hscroll% = hscroll% + 1
' Print to form input line.-------------------------------------->
LOCATE , leftmargin%:
PRINT MID$(text$
, (hscroll%
+ 1), rightmargin%
- (leftmargin%
- 1));
' <---------------------------------------------------------------
IF CurAdvance%
= 1 AND positioncursor%
- leftmargin%
+ 1 < rightmargin%
- leftmargin%
+ 1 THEN LOCATE , positioncursor%
+ CurAdvance%
RETURN '---------------------------------------------------------------------
BackspaceDelete:
REM Adjust
for horizontal scroll
countcolumnsmoved% = hscroll%
jBackspaceDelete% = (rightmargin% - (leftmargin% - 1)) * .33
IF jBackspaceDelete%
< 3 AND rightmargin%
- (leftmargin%
- 1) > 3 THEN jBackspaceDelete%
= 3:
REM Set minimum scroll back.
FOR iBackspaceDelete%
= 1 TO jBackspaceDelete%
LOCATE , holdcursor%
+ countcolumnsmoved%
- hscroll%
- 1 countcolumnsmoved% = 0: iBackspaceDelete% = 0: jBackspaceDelete% = 0
text$
= MID$(text$
, 1, POS(0) - leftmargin%
+ hscroll%
) + MID$(text$
, POS(0) - leftmargin%
+ hscroll%
+ 2) texttemp$
= MID$(text$
, hscroll%
+ 1, rightmargin%
- (leftmargin%
- 1)) LOCATE iyy%
, leftmargin%:
PRINT texttemp$
+ STRING$((rightmargin%
- (leftmargin%
- 1)) - LEN(texttemp$
), linecharacter%
);
RETURN '---------------------------------------------------------------------
cutcopy:
_CLIPBOARD$ = MID$(text$
, starthighlight%
- leftmargin%
, highlight%
- starthighlight%
+ 1)
IF mykey%
= 88 OR mykey%
= 120 OR mykey%
= 8 OR mykey%
= 21248 THEN ' ctrl + x (cut), delete, backspace. positioncursor% = starthighlight% - 1 - hscroll%
texttemp$
= MID$(text$
, 1, starthighlight%
- leftmargin%
- 1) + MID$(text$
, highlight%
- leftmargin%
+ 1) text$ = texttemp$
hscroll%
= hscroll%
- ABS(highlight%
- starthighlight%
) IF hscroll%
< 0 THEN hscroll%
= 0 RETURN '---------------------------------------------------------------------
PasteClipboard:
IF positioncursor%
> rightmargin%
THEN hscroll% = hscroll% + positioncursor% - rightmargin%
positioncursor% = rightmargin%
RETURN '---------------------------------------------------------------------
InsertOverwrite:
overwrite% = -1
overwrite% = 0
' End Key Controls-------------------------------------------------------
mouseroutine:
IF shiftclick%
> 0 THEN mykey%
= 19712: shiftclick%
= shiftclick%
- 1 ELSE mykey%
= 19200: shiftclick%
= shiftclick%
+ 1
IF my%
> margin.t
+ page.h
OR my%
<= margin.t
THEN IF my%
> margin.t
+ page.h
+ 2 AND hlf%
THEN ' Unhighlight file in display window. j%
= -999:
GOSUB highlightfile
' hlf% is in statement above tabx% = 2
LOCATE w1%
+ w3%
- 4 - 3, w2%
+ 15, 1 ' Move to text input field.
IF oldsmode2
THEN ' doctype dropdown menu is open. GOSUB clearbuttons: tabx%
= 2 LOCATE w1%
+ w3%
- 4 - 3, w2%
+ 15 closepop% = -1
LOCATE w1%
+ w3%
- 4 - 3, w2%
+ 15, 1 closepop% = 0
CASE 3 ' doctypedropdown menu open. IF my%
= doctypey%
(i%
) AND mx%
>= ABS(doctypex%
(i%
)) AND mx%
< ABS(doctypex%
(i%
)) + LEN(doctype$
(i%
)) THEN doctypex%(i%) = -doctypex%(i%)
doctypex%
(i%
) = ABS(doctypex%
(i%
)) j% = 0
IF my%
= formbuttony%
(i%
) AND mx%
>= ABS(formbuttonx%
(i%
)) AND mx%
< ABS(formbuttonx%
(i%
)) + LEN(formbutton$
(i%
)) THEN COLOR 0, 3:
LOCATE formbuttony%
(i%
), formbuttonx%
(i%
), 0 formbuttonx%(i%) = -formbuttonx%(i%)
j% = -1
formbuttonx%
(i%
) = ABS(formbuttonx%
(i%
)) COLOR 1, 7:
LOCATE formbuttony%
(i%
), formbuttonx%
(i%
), 0 IF formbuttonx%
(i%
) < 0 THEN j%
= -1 ' Used below to designate a button is highlighted.
COLOR 0, 3:
LOCATE formbuttony%
(tabx%
- 2), ABS(formbuttonx%
(tabx%
- 2)), 0 PRINT formbutton$
(tabx%
- 2);
102
IF oldsmode2
THEN ' Doctype dropdown menu is open. GOSUB close_doctype_dropdown
doctypex%
(i%
) = ABS(doctypex%
(i%
))
FOR i%
= 1 TO UBOUND(formbutton$
) ' Check control buttons. IF my%
= formbuttony%
(i%
) AND mx%
>= ABS(formbuttonx%
(i%
)) AND mx%
<= ABS(formbuttonx%
(i%
)) + LEN(formbutton$
(i%
)) THEN formbuttonx%
(i%
) = ABS(formbuttonx%
(i%
)) CASE 1 ' Open doctype dropdown menu. action$ = "open file"
action$ = "save as"
'''myfile$ = text$
action$
= "cancel":
EXIT DO ' To Return.
click_l% = -1
CASE IS > POS(0): mykey%
= 19712: shiftclick%
= mx%
- POS(0) - 1 CASE IS < POS(0): mykey%
= 19200: shiftclick%
= mx%
- POS(0) + 1 IF click_l%
= -1 THEN click_l%
= 1: drag%
= 0
drag% = -1
' Cursor was already placed in popup sub.
LOCATE my%
, mx%
' Click in input field. '''''''' DOESN'T mx% NEED TO BE LIMITED IN OLD ROUTINE, TOO???
shift% = -1
IF my%
> margin.t
AND my%
- margin.t
<= page.h
AND mx%
> margin.l
AND mx%
< margin.l
+ page.w
THEN tabx%
= 1:
GOSUB clearbuttons
lbdown% = -1
row
= my%
- margin.t: j%
= 0:
GOSUB highlightfile
i%
= my%:
IF i%
- margin.t
> 0 THEN row
= row
- 1: j%
= 0:
GOSUB highlightfile
i%
= my%:
IF i%
- margin.t
<= page.h
THEN row
= row
+ 1: j%
= 0:
GOSUB highlightfile
' ------------------------------------Mouse----------------------------------
IF locked%
< 0 THEN ' Mouse effects on mouse lock. key press effects are determined at inkey$ input, as key variable cannot be evaluated here, due to b$ = "" manipulations in the keypress routine.
IF mb.w
THEN ' Determine if wheel is being used to scroll highlighted or unhighlighted text. tabx% = 1 ' Reset tab index when mouse wheel is engaged.
locked% = 2 ' 2 is lock scrollbar, no highlighting permitted.
tabx% = 1
' Scrollbar routine.
IF mx%
>= scrb.l
- 1 AND mx%
<= scrb.l
+ 1 AND my%
- (scrb.t
+ 1) >= scrb.x
AND my%
- (scrb.t
+ 1) <= scrb.x
+ scrb.s
- 1 THEN draglock%
= -1
IF draglock%
= -1 AND my%
> scrb.t
AND my%
< scrb.b
OR mx%
= scrb.l
AND scrb.s
<> 0 AND my%
>= scrb.t
AND my%
<= scrb.b
AND mb.w
= 0 OR scrbardrag%
<> 0 AND my%
> scrb.t
AND my%
< scrb.b
AND mb.w
= 0 OR mb.w
> 0 AND scrb.x
+ scrb.s
< scrb.h
OR mb.w
< 0 AND scrb.x
> 0 THEN ' Mouse on scrollbar, doing a bar cursor drag or using the scroll wheel. locked% = 2 ' Locked on scrollbar
IF my%
= scrb.t
AND scrb.x
> 0 OR my%
= scrb.b
AND scrb.x
+ scrb.s
< scrb.h
OR mb.w
<> 0 AND scr
+ page.h
< noe
THEN ' Mouse on a scrollbar arrow. IF my%
= scrb.t
AND mb.w
= 0 OR mb.w
< 0 THEN scrb.x
= scrb.x
- 1: h%
= -1 ELSE scrb.x
= scrb.x
+ 1: h%
= -2 ' Top or bottom arrow. j%
= INT(scrb.x
* ((noe
- scrb.d
) / (scrb.h
- scrb.s
)))
IF j%
>= 0 THEN ' Condition exists unless j% is negative such as doc is blank and mouse wheel is rolled downward. scrb.i = j%
scr = scrb.i
'''h% = 0: CALL scrollbar_update(h%, scrb, noe, row, scr) ' Positions scrollbar box.
ELSEIF my%
- (scrb.t
+ 1) >= scrb.x
AND my%
- (scrb.t
+ 1) <= scrb.x
+ scrb.s
- 1 AND scrbardrag%
= 0 THEN ' Mouse on scrollbar block. scrbardrag% = -1: scrb.adjust = (my% - (scrb.t + 1)) - scrb.x
ELSEIF draglock%
= -1 AND my%
> scrb.t
AND my%
< scrb.b
OR my%
> scrb.t
AND my%
< scrb.b
THEN ' Mouse on scrollbar between scrollbar arrow and cursor. IF draglock%
= -1 AND my%
> scrb.t
AND my%
< scrb.b
OR my%
- (scrb.t
+ 1) - scrb.adjust
>= 0 AND my%
- (scrb.t
+ 1) + scrb.s
- scrb.adjust
<= scrb.h
AND scrbardrag%
<> -1 OR scrbardrag%
= 0 THEN IF scrbardrag%
= 0 THEN ' No drag, so adjust for cursor length for a click inside the scrollbar above or below the current scrollbar cursor position. IF my%
- (scrb.t
+ 1) > scrb.x
THEN scrb.adjust = (my% - (scrb.t + 1)) - scrb.x - 1: h% = -1
scrb.adjust = (my% - (scrb.t + 1)) - scrb.x + 1: h% = -2
scrb.x = my% - (scrb.t + 1) - scrb.adjust
scrb.i
= INT(scrb.x
* ((noe
- scrb.d
) / (scrb.h
- scrb.s
)))
scr = scrb.i
'''h% = 0: CALL scrollbar_update(h%, scrb, noe, row, scr)
ELSE ' Scrollbar is at top or bottom and mouse cursor is moving vertically along the scrollbar cursor. This allows the variable to readjust. IF mx%
= scrb.l
THEN scrbardrag%
= 0: scrb.adjust
= 0: draglock%
= 0 ' =======================================================
delay.
on!
= 0 ' Toggle off.
scrbardrag% = 0: scrb.adjust = 0: draglock% = 0
RETURN '---------------------------------------------------------------------
file_display_keys:
' Key commands for form input line.
row = row - 1
LOCATE margin.t
+ row
, margin.l
+ 1 j%
= 0:
GOSUB highlightfile
scr = scr - 1
j%
= 0:
GOSUB highlightfile
row = row + 1
j%
= 0:
GOSUB highlightfile
LOCATE margin.t
+ row
, margin.l
+ 1 scr = scr + 1
j%
= 0:
GOSUB highlightfile
' Arrow down key is highlighted by tabx%. Now open the doctype dropdown menu.
autokey% = -1
k% = page.h - 1 + row - 2
autokey% = -1
k% = (page.h - 1) + (page.h - row) - 1
FOR j%
= 1 TO page.h
- row
row = 1
scr = 0
LOCATE margin.t
+ 1, margin.l
+ 1 j%
= 0:
GOSUB highlightfile
row = page.h
scr = noe - row
LOCATE margin.t
+ 1, margin.l
+ 1 row = page.h
LOCATE margin.t
+ row
, margin.l
+ 1 j%
= 0:
GOSUB highlightfile
row = noe
LOCATE margin.t
+ row
, margin.l
+ 1 j%
= 0:
GOSUB highlightfile
RETURN '---------------------------------------------------------------------
'-------------------------------Nested Gosubs-----------------------------
scrollscrn:
LOCATE margin.t
+ i%
, margin.l
+ 1 LOCATE row
+ margin.t
, margin.l
+ 1
'''h% = 1: CALL scrollbar_update(h%, scrb, noe, row, scr)
RETURN '---------------------------------------------------------------------
highlightfile:
IF j%
= -999 THEN ' Unhighlight text only. LOCATE margin.t
+ hlf%
, margin.l
+ 1, 0 hlf% = 0
LOCATE margin.t
+ hlf%
, margin.l
+ 1, 0 LOCATE margin.t
+ row
, margin.l
+ 1, 0 hlf% = row
RETURN '---------------------------------------------------------------------
wash:
starthighlight% = 0
highlight% = 0
texttemp$
= MID$(text$
, (hscroll%
+ 1), rightmargin%
- (leftmargin%
- 1)) PRINT texttemp$
+ STRING$(rightmargin%
- (leftmargin%
- 1) - LEN(texttemp$
), linecharacter%
);
RETURN '---------------------------------------------------------------------
clearbuttons:
LOCATE formbuttony%
(k%
), ABS(formbuttonx%
(k%
)), 0 formbuttonx%
(k%
) = ABS(formbuttonx%
(k%
)) ' Remove button active (neg) designation. RETURN '---------------------------------------------------------------------
displaybutton: ' Gosub parameters (i%)
GOSUB clearbuttons
' Clear all buttons of highlighting first... formbuttonx%
(ABS(i%
)) = -ABS(formbuttonx%
(ABS(i%
))) RETURN '---------------------------------------------------------------------
fileselected:
text$ = xfull$(row + scr)
' Ready to change diretories.
action$ = "change dir"
' Text input line.
LOCATE w1%
+ w3%
- 4 - 3, w2%
+ 15, 1:
PRINT MID$(text$
, 1, w4%
- 18);
' Display it. hlf% = 0
ELSE ' No files found in DIR to select. RETURN '---------------------------------------------------------------------
popfiletypes:
LOCATE w1%
+ w3%
- 4 - 3, w2%
+ 15, 0 oldsmode2 = SMODE
SMODE
= 3:
PCOPY oldsmode2
, SMODE:
SCREEN 0, 0, SMODE
, SMODE
doctypey%(1) = w1% + 16: doctypex%(1) = w2% + 15
doctypey%(2) = w1% + 17: doctypex%(2) = w2% + 15
LOCATE w1%
+ 16, w2%
+ 15 ' Text input line. RETURN '---------------------------------------------------------------------
doctype_selected:
IF doctype$
<> doctype$
(1) THEN '''doctype$ = doctype$(1): CALL displayfiles(doctype$, x$(), xfull$(), scrb, noe, row, scr)
doctype$ = doctype$(1)
IF doctype%
= 2 THEN SWAP doctype$
(1), doctype$
(2) doctype% = 1
LOCATE w1%
+ 16, w2
+ w4%
+ 4 ' .txt or *.* all files arrow down button location. formbuttony%
(1) = CSRLIN: formbuttonx%
(1) = POS(0): formbutton$
(1) = CHR$(25)
i%
= 1:
GOSUB displaybutton
LOCATE w1%
+ w3%
- 4 - 3, w2%
+ 15, 1 ' File name input field.
IF doctype$
<> doctype$
(2) THEN '''doctype$ = doctype$(2): CALL displayfiles(doctype$, x$(), xfull$(), scrb, noe, row, scr)
doctype$ = doctype$(2)
IF doctype%
= 1 THEN SWAP doctype$
(1), doctype$
(2) doctype% = 2
LOCATE w1%
+ w3%
- 4 - 3, w2%
+ 15, 1 ' File name input field.
RETURN '---------------------------------------------------------------------
close_doctype_dropdown:
' Note - Do not use i% in this routine. It would change a perviouly set value i one of the routines that calls this one.
SMODE
= oldsmode2:
SCREEN 0, 0, SMODE
, SMODE: oldsmode2
= 0 LOCATE w1%
+ 16, w2%
+ w4%
- 4 LOCATE w1%
+ w3%
- 4 - 3, w2%
+ 15, 1 ' File name input field. RETURN '---------------------------------------------------------------------
margin.t = 5
margin.l = 5
dwidth = 68
page.h = 6
row = 1
noe = 13
x$
(1) = "We the People of the United States, in Order to form a more perfect " + CHR$(10) x$
(2) = "Union, establish Justice, insure domestic Tranquility, provide for " + CHR$(10) x$
(3) = "the common defence, promote the general Welfare, and secure the " + CHR$(10) x$
(4) = "Blessings of Liberty to ourselves and our Posterity, do ordain and " + CHR$(10) x$
(5) = "establish this Constitution for the United States of America." + CHR$(10) x$
(7) = "Article I" + CHR$(10) x$
(9) = "Section 1: Congress" + CHR$(10) x$
(11) = "All legislative Powers herein granted shall be vested in a Congress " + CHR$(10) x$
(12) = "of the United States, which shall consist of a Senate and House of " + CHR$(10) x$
(13) = "Representatives." + CHR$(10)
IF scr
+ page.h
< noe
THEN row
= page.h: scr
= scr
+ 1:
GOSUB displaydoc:
GOSUB finder
displaydoc:
LOCATE margin.t
+ i%
, margin.l
+ 1
finder:
LOCATE margin.t
+ i%
, margin.l
+ seed%
seed%
= seed%
+ LEN(find$
)
winmode$ = "2"
SCRNSIZE% = SCRNSIZE% + ENL%
style$ = "MONOSPACE"
fontsize% = SCRNSIZE% + 13
IF fontsize%
< 14 THEN winmode$
= "" IF fontsize%
< 18 THEN style$
= style$
+ ", BOLD" fontpath$
= ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
nofull:
ChangeFont:
_FONT 16 'select inbuilt 8x16 default font currentf&
= _LOADFONT(fontpath$
, fontsize%
, style$
)
f& = currentf&