Well don't get to excited. I may have fell off the SCREEN 0 wagon, temporarily, but this example is just a limited text input routine, in pure graphics mode. Because it allows for italicized and bold text, you'll need to download the attached zip folder and extract the fonts to whatever folder you decide to run this routine in.
You know my regular SCREEN 0 routines had url capabilities, but I only had the option of differentiating the links by color. No italics, and no underlining ability in a text mode screen. Now I could have used hardware graphics in SCREEN 0 to make a hybrid, instead of going all in on graphics, but like I stated in my message header, I got really, really drunk for the 17th. Oh, that reminds me. I used about a half a dozen line statements in the following code, but I'm not sure if any are straight.
Updated 3/22/24 to include more mouse features including clicking hypertext.
Updated 3/24/24 to include cut, copy, paste from keyboard.
Updated 3/28/24 to include ctrl + arrow keys to highlight words. Optimized highlighting for cursor and home/end keys. That was fun, but ctrl + arrows, I'll pass on optimizing that for now.
BIG UPDATE 4/2/24 to include POPUP window for cut/copy/paste/delete/select all/hypertext.
BIGGER UPDATE 4/7/24 to include text formatting buttons. Keys still work, too, and affect the buttons, accordingly.
4/9/24 Finished length restrictions, paste and universal button font changes.
BIGGEST UPDATE 4/19/24 Okay, so now we can make and save 1 page of text with up to 255 links on the page. Use the Enter key to go to a new line of text like an editor or IDE. Note there is no word wrap. Use CTRL + N for a new project, CTRL + S to save a project, and CTRL to O to open a saved project. This release does not check to see if you want to save your work before starting a new project. It also does not compare your present project with a saved version, so until I get around to addressing these and other file management issues, well, just be aware they are not yet available. Oh, I also removed link restrictions, so make sure if you want to go to a website, you start your input with http:// or https:// followed by the url like https://qb64phoenix.com. By removing that restriction we can now input things like "Notepad" and it will open notepad when clicked. Notepad and some other registered Windows apps can be found by SHELL without the inclusion of a drive and path, but other programs you want to launch, using this method, will require you include the drive and path followed by the app name.
Updated 4/20/24 Delete key can now delete a blank line to move lines below it up. Backspace cannot be used this way and will not be modified until wrap is added. Also, fixed one issue with multiple shell instances when dragging over a link.
Updated 4/22/24 Links can now be removed or edited. Right click on link and select to edit or remove.
Updated 4/24/24 Text scrolling with Enter key, arrow up/down keys, or mouse wheel.
Updated 5/25/24 Bug fix.
Pete
- 5 out of 6 Russians recommend Russian Roulette to their gamblers who play Russian Roulette.
You know my regular SCREEN 0 routines had url capabilities, but I only had the option of differentiating the links by color. No italics, and no underlining ability in a text mode screen. Now I could have used hardware graphics in SCREEN 0 to make a hybrid, instead of going all in on graphics, but like I stated in my message header, I got really, really drunk for the 17th. Oh, that reminds me. I used about a half a dozen line statements in the following code, but I'm not sure if any are straight.
Updated 3/22/24 to include more mouse features including clicking hypertext.
Updated 3/24/24 to include cut, copy, paste from keyboard.
Updated 3/28/24 to include ctrl + arrow keys to highlight words. Optimized highlighting for cursor and home/end keys. That was fun, but ctrl + arrows, I'll pass on optimizing that for now.
BIG UPDATE 4/2/24 to include POPUP window for cut/copy/paste/delete/select all/hypertext.
BIGGER UPDATE 4/7/24 to include text formatting buttons. Keys still work, too, and affect the buttons, accordingly.
4/9/24 Finished length restrictions, paste and universal button font changes.
BIGGEST UPDATE 4/19/24 Okay, so now we can make and save 1 page of text with up to 255 links on the page. Use the Enter key to go to a new line of text like an editor or IDE. Note there is no word wrap. Use CTRL + N for a new project, CTRL + S to save a project, and CTRL to O to open a saved project. This release does not check to see if you want to save your work before starting a new project. It also does not compare your present project with a saved version, so until I get around to addressing these and other file management issues, well, just be aware they are not yet available. Oh, I also removed link restrictions, so make sure if you want to go to a website, you start your input with http:// or https:// followed by the url like https://qb64phoenix.com. By removing that restriction we can now input things like "Notepad" and it will open notepad when clicked. Notepad and some other registered Windows apps can be found by SHELL without the inclusion of a drive and path, but other programs you want to launch, using this method, will require you include the drive and path followed by the app name.
Updated 4/20/24 Delete key can now delete a blank line to move lines below it up. Backspace cannot be used this way and will not be modified until wrap is added. Also, fixed one issue with multiple shell instances when dragging over a link.
Updated 4/22/24 Links can now be removed or edited. Right click on link and select to edit or remove.
Updated 4/24/24 Text scrolling with Enter key, arrow up/down keys, or mouse wheel.
Updated 5/25/24 Bug fix.
Code: (Select All)
Rem Note if code is expanded to include word wrap, the disallow length too long routines need to be updated to wrap routines.
Dim Shared debug As Integer
On Error GoTo pete
$Color:32
_ControlChr Off
Type fontvar
nof As Integer ' Number of Fonts.
fsn As Integer ' Font Selection Number 1 reg, 2 Bold, 3 Italic, 4 Bold Italic.
size As Integer ' Font Size.
max_fontheight As Integer ' The Largest Font Size on any Line of Text.
End Type
Dim ft As fontvar
Type textvar
maxchrs As Integer ' The Max Characters of a Text String. IMPORTANT: Cannot be over 255.
noa As Integer ' Number of Text Attributes.
tm As Integer ' Top Margin by Pixel.
bm As Integer ' Bottom Margin by Pixel.
lm As Integer ' Left Margin by Pixel.
rm As Integer ' Right Margin by Pixel.
ln As Integer ' Line number.
row As Integer ' Row by Pixel.
scr As Integer ' Scroll Number.
eop As Integer ' End of Page (The Last Display Line).
nol As Integer ' Total Number of Text Lines.
ccol As Integer ' Numeric Column of a Character.
oldccol As Integer ' Numeric Column of the Previous Cursor Position.
pixcol As Integer ' The Pixel Column the Cursor is On Currently.
insreg As Integer ' Causes a Delay in Changing the Cursor Appearance When the Insert Key is Rapidly Pressed.
reprnt As Integer ' Only Reprints a Row of Characters When Non-zero.
ovr As Integer ' Overwrite mode When Non-zero, Otherwise Insert Mode.
xl As Integer ' Pixel Column for a Character that is Part of a Link.
mindex As Integer ' Numeric Matrix Index.
underline As Integer ' Underline Text.
link As Integer ' Hyperlink Text.
c_wdth As Integer ' Cursor Width in Pixels
c_hght As Integer ' Cursor Height in Pixels.
numchrs As Integer ' Number of Characters in the Line of Text.
sa As Integer ' Special Attributes for Paragraph, Highlighting Markers, etc.
cchr As String ' Cursor Character.
t As String ' Row of Text.
m As String ' Text and Attributes to be Saved in an RA File.
url As String ' URL Link to Follow.
shift As Integer ' Shift Keys.
autoshift As Integer ' Used for Instances Like Mouse Highlighting to Mimic Keyboard Highighting.
ctrl As Integer ' Ctrl key.
alt As Integer ' Alt Key.
hl As Integer ' Highlighting Left (-1) or Right (+1)
arrows As Integer ' Aids the Cursor Update Subroutine When Arrows are Used to Highliht Text.
button_row As Integer ' Row Occupied by the Text Formatting Buttons.
button_status As Integer ' > 0 Mouse Click, < 0 Hotkey. 999 Cycle Termination Code for both. -999 Hotkey Default Status and Terminate Cycle.
prior_colorHL As Integer ' The Prior Color to be Reinstated After Highlighting the Text is Completed.
newproject As Integer ' Creates a new project.
openfile As String ' Forces a redo of varibles and selects the file to open.
tcopy As String ' Copied Text
mcopy As String ' Copied Text Matrix
map_rows As String ' Screen Memory for Text Rows.
map_buttons As String ' Screen Memory for Buttons.
map_links As String ' Screen Memory for Links.
End Type
Dim tx As textvar
Type mousevar
mx As Integer ' Row.
my As Integer ' Column.
wh As Integer ' Wheel.
lb As Integer ' Left Button.
rb As Integer ' Right Button.
lb_status As Integer ' Left Button Status.
rb_status As Integer ' Right Button Status.
CursorStyle As Integer ' 0 Default, 1 Link style. (Hand).
mousekey As String ' Auto Keyboard Input.
End Type
Dim m As mousevar
Type popup
setup As Integer ' Single Use to Initiate Popup Variables.
status As Integer ' 0 Not in Use, 1 Initiated, -1 Displayed, 2 Closed.
nmi As Integer ' Number of Items in the Menu.
pr1 As Integer ' Top Row.
pr2 As Integer ' Bottom Row.
pc1 As Integer ' Left Column.
pc2 As Integer ' Right Column.
phshadow As Integer ' Horizontal shadow.
pvshadow As Integer ' Vertical Shadow.
pwdth As Integer ' Popup Width.
phght As Integer ' Popup Height.
pbgcolor As Integer ' Background Color.
pbbxcolor As Integer ' Box Border Color.
pbshdcolor As Integer ' Shadow Color.
col_matrix As String ' Column.
row_matrix As String ' Row.
chr_wdth As Integer ' Character Width in Pixels.
chr_hght As Integer ' Character Height in Pixels.
restrict As String ' Limits Access to Unavailable Items in Menu.
End Type
Dim pop As popup
Dim Shared bit As _Bit
main ft, tx, m, pop
pete:
_ControlChr Off: _AutoDisplay
Beep: Beep: _Delay 1: Sleep
_Font 16: Color Black, White: Cls
Print "Debug ="; debug
Print "SCR ="; tx.scr
Print "Line ="; tx.ln
Print "column: ="; tx.ccol
Print "Max Chrs ="; tx.maxchrs
Print "tx.numchrs ="; tx.numchrs
Print "# of Lines ="; tx.nol
Print "EOP = "; tx.eop
Print "matrix index ="; tx.mindex
Print "tx.mindex + tx.noa ="; tx.mindex + tx.noa
Print "tx.t$ = "; "|"; Mid$(tx.t$, 1, tx.numchrs); "|"
Print "tx.scr + tx.ln ="; tx.scr + tx.ln
Print "mtx$() = |"; mtx$(tx.scr + tx.ln); "|"
Print "---------------------"
Print "tx.m$ front = |" + Mid$(tx.m$, 1, tx.maxchrs); "|"
Print "---------------------"
Print "Special att = |" + Mid$(tx.m$, tx.maxchrs, 10); "|"
Print "---------------------"
Print "tx.m$ back = |" + Mid$(tx.m$, tx.maxchrs + 11, 300); "|"
Print "Error and Error Line: "; Err, _ErrorLine
Do: _Limit 10: Loop Until InKey$ = Chr$(27)
End
' Matrix: 1-tx.maxchrs text, tx.maxchrs + 1 to tx.maxchrs + 10 Special attributes, tx.maxchrs + 11 on are attributes each tx.noa spaces long.
' Example: tx.maxchrs = 255. tx.noa = 12. 1-255 text, 256-265 special attributes, 266-277 attributes for 1st character in text string, 278-289 2nd, etc.
Sub main (ft As fontvar, tx As textvar, m As mousevar, pop As popup)
Static initiate%
If initiate% = 0 Then
Screen _NewImage(1050, 600, 32)
_Display ' Turn off autodisplay.
Color Black, _RGB32(255, 255, 255, 255)
Cls
_Delay .1
_ScreenMove _Middle
_Delay .1
_Clipboard$ = ""
initiate% = -1
End If
Do
_Limit 60
load_font ft, fnum&()
mouse m
keyboard tx, m, b$
text_input ft, tx, m, pop, b$, fnum&(), mtx$(), mylink$(), index_col(), default_cl%(), default_bc%(), cl%(), bc%()
popup_main ft, tx, m, pop
text_buttons tx, m, b$
Loop
End Sub
Sub load_font (ft As fontvar, fnum() As Long)
' Set DEFAULT FONT SIZE at line #7.
Static oldfontsize%
If ft.size = 0 Or ft.size <> oldfontsize% Then
ft.nof = 4 ' Number of Fonts to Load into Memory.
ft.size = oldfontsize% ' Font Size.
If ft.size = 0 Then ft.size = 18 ' Default font size.
ft.fsn = 1 ' Default font style number.
ft.max_fontheight = ft.size
ReDim fnum(ft.nof) As Long
fnum(0) = -1 ' See remark above.
fnum(1) = _LoadFont("RobotoMono-regular.ttf", ft.size)
fnum(2) = _LoadFont("RobotoMono-bold.ttf", ft.size)
fnum(3) = _LoadFont("RobotoMono-italic.ttf", ft.size)
fnum(4) = _LoadFont("RobotoMono-bolditalic.ttf", ft.size)
For i% = 1 To ft.nof
If fnum(i%) <= 0 Then ' Try to load the Windows Lucida Console font.
fnum(1) = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", ft.size)
Exit For
End If
Next
If fnum(1) <= 0 Then
ft.size = 16 ' Default 8 x 16 font.
fnum(1) = ft.size
End If
oldfontsize% = ft.size
End If
End Sub
Sub mouse (m As mousevar)
' Local vars: i%,j%
Static oldmx As Integer, oldmy As Integer
If m.wh Then m.wh = 0
While _MouseInput
m.wh = m.wh + _MouseWheel
Wend
m.mx = _MouseX
m.my = _MouseY
m.lb = _MouseButton(1)
m.rb = _MouseButton(2)
Select Case m.lb
Case 0
Select Case m.lb_status
Case -2
m.lb_status = 0 ' The clicked event and the release triggered any event structured to occur on release.
Case -1
m.lb_status = -2 ' The clicked event triggered any event structured to occur when the button is released.
Case 0
' Button has not been pressed yet.
Case 1
m.lb_status = -1 ' Rare but button was released before the next required cycle, so cycle is continued here.
Case 2
m.lb_status = 0 ' The drag event is over because the button was released.
End Select
Case -1
Select Case m.lb_status ' Note drag is determined in the text highlighting routine.
Case -1
' An event occurred and the button is still down.
If oldmx <> m.mx Or oldmy <> m.my Then m.lb_status = 2 ' Drag.
Case 0
m.lb_status = 1 ' Left button was just pressed.
Case 1
m.lb_status = -1 ' The button is down and triggered any event structured to occur on initial press. The status will remain -1 as long as the button is depressed.
End Select
End Select
Select Case m.rb
Case 0
Select Case m.rb_status
Case -2
m.rb_status = 0 ' The clicked event and the release triggered any event structured to occur on release.
Case -1
m.rb_status = -2 ' The clicked event triggered any event structured to occur when the button is released.
Case 0
' Button has not been pressed yet.
Case 1
m.rb_status = -1 ' Rare but button was released before the next required cycle, so cycle is continued here.
Case 2
m.rb_status = 0 ' The drag event is over because the button was released.
End Select
Case -1
Select Case m.rb_status
Case -1
' An event occurred and the button is still down.
Case 0
m.rb_status = 1 ' button was just pressed.
Case 1
m.rb_status = -1 ' The button is down and triggered any event structured to occur on initial press. The status will remain -1 as long as the button is depressed.
End Select
End Select
oldmx = m.mx: oldmy = m.my
End Sub
Sub keyboard (tx As textvar, m As mousevar, b$)
' Local vars: oldfsn, cur_arrows, fill$, ex_keys%.
Def Seg = 0
i% = Peek(1047) Mod 16
If InStr(Chr$(1) + Chr$(2) + Chr$(5) + Chr$(6) + Chr$(9) + Chr$(10), Chr$(i%)) Then tx.shift = -1 Else tx.shift = 0
If i% = 3 Or i% = 4 Then tx.ctrl = -1 Else tx.ctrl = 0
If i% = 7 Or i% = 8 Then tx.alt = -1 Else tx.alt = 0
Def Seg
If Len(m.mousekey$) Then ' Used to pass automated key response, especially from the mouse routine.
b$ = m.mousekey$: tx.shift = tx.autoshift: m.mousekey$ = "": tx.autoshift = 0
Else
b$ = InKey$
End If
If tx.alt Then
Rem Reserved for Alt key.
_KeyClear
Exit Sub
End If
If tx.ctrl Then
Rem Reserved for Crrl key.
End If
End Sub
Sub text_input (ft As fontvar, tx As textvar, m As mousevar, pop As popup, b$, fnum() As Long, mtx$(), mylink$(), index_col(), default_cl%(), default_bc%(), cl%(), bc%())
Static initiate%, rbx%, rby%, cc!, z1!, oldb$
' Locale vars: i%, cc!
If initiate% = 0 Or Len(tx.openfile) Or tx.newproject = -1 Then
_Font fnum(1) ' Default font.
tx.scr = 0
tx.nol = 0 ' Resets when new or file gets loaded.
' Text and link arrays.
ReDim mtx$(1)
ReDim index_col(tx.maxchrs)
ReDim mylink$(0)
' Color Arrays and Variables.
ReDim cl%(3), bc%(3)
ReDim default_cl%(3), default_bc%(3)
default_cl%(1) = 0: default_cl%(2) = 0: default_cl%(3) = 0
default_bc%(1) = 255: default_bc%(2) = 255: default_bc%(3) = 255
cl%(1) = default_cl%(1): cl%(2) = default_cl%(2): cl%(3) = default_cl%(3)
bc%(1) = default_bc%(1): bc%(2) = default_bc%(2): bc%(3) = default_bc%(3)
' Matrix variables.
tx.maxchrs = 255 ' IMPORTANT: Can't be > 255. If <, error 9 in index_col() possible and line length issues, which are regulated in pixels, not characters.
tx.noa = 12 ' Number of character attributes.
tx.sa = 10 ' Number of special attributes.
' Border variables.
tx.lm = 100 ' Margins in pixels.
tx.tm = 80
tx.bm = tx.tm + (6 + _FontHeight) * 20 - 6
tx.rm = _Width - tx.lm
' Draw text border.
Line (tx.lm - 5, tx.tm - 5)-(tx.rm + 5, tx.bm + 5 + 6), Gray, B ' Text input field.
initiate% = -1
_Font fnum(1) 'Start with default font.
tx.ln = 1 ' Start at text line #1.
tx.row = tx.tm ' Current row in pixels set to the top margin.
GoSub blank_text_area
GoSub set_maps: GoSub set_text_vars
debug = 306: text_reprint ft, tx, fnum(), mtx$(), index_col(), default_bc%(), cl%()
If tx.newproject Then tx.newproject = 0 ' Note: openfile is zeroed later.
End If
_Font fnum(ft.fsn)
If Len(tx.openfile) Then
' Note: Variables are zeroed at the beginning of this subroutine.
ff1 = FreeFile
Open tx.openfile For Input As #ff1
Line Input #ff1, a$
g% = tx.ln ' It will always be 1 here.
i% = Val(Mid$(a$, InStr(a$, "LEN=") + 4))
j% = Val(Mid$(a$, InStr(a$, "NOL=") + 4))
k% = Val(Mid$(a$, InStr(a$, "LNK=") + 4))
tx.maxchrs = Val(Mid$(a$, InStr(a$, "MAX=") + 4))
Dim temp As String
temp = String$(i%, Chr$(0))
ReDim _Preserve mylink$(k%)
ReDim _Preserve mtx$(j%)
Close #ff1
ff1 = FreeFile
Open tx.openfile For Binary As #ff1
For h% = 1 To k%
Get #ff1, 1 + h% * i%, temp
mylink$(h%) = Mid$(temp, 1, InStr(temp + Chr$(0), Chr$(0)) - 1)
Next
debug = 335: l% = 2: GoSub assign_lines ' Transfers variables g% - l%
Close #ff1
tx.openfile = ""
End If
If pop.status Then
If b$ = Chr$(27) Then pop.status = 2
Exit Sub
End If
Do
' Keyboard text events
Select Case Len(b$) ' Key down suspension routine for F1 - F12 keys.
Case 0 ' Time loop to test for key release.
If Len(oldb$) Then
If Abs(z1! - Timer) > .1 Then
oldb$ = ""
End If
End If
Case 1
' Do nothing so typing characters is not affected.
Case 2
i% = Asc(Right$(b$, 1))
If i% = 133 Or i% = 134 Then ' Function key range.
z1! = Timer
If oldb$ <> b$ Then
oldb$ = b$
Sleep 1 ' Needed to prevent double entry.
Else
b$ = "": _Continue
End If
End If
End Select
If Len(b$) Then ' Special to COPY.
If b$ = Chr$(22) Then
temp_oldm$ = tx.m$
temp_oldt$ = tx.t$
If _Clipboard$ <> tx.tcopy$ Then tx.tcopy$ = "": tx.mcopy$ = "" ' A clipboard addition was made from another program.
End If
If tx.hl Then ' Highlighted text key exceptions. 0 = Remove highlighting, -1 = Keep highlighting.
Select Case Len(b$)
Case 1
Select Case b$
Case Chr$(27), Chr$(1), Chr$(3), Chr$(22), Chr$(24): ex_keys% = -1
End Select
If tx.ctrl Then
If ex_keys% = 0 Then Exit Sub ' Non supported key press.
End If
Case 2
If InStr(";<=>?@ABCD…†", Right$(b$, 1)) Then ' Keys F1 - F12.
ex_keys% = -1 ' Will zero-out automatically when leaving subroutine.
Else
If InStr("MKHPIQOGuwst", Right$(b$, 1)) Then
If tx.shift Then
ex_keys% = -1
Else
debug = 391: GoSub direct_reprinting
End If
End If
End If
End Select
End If
' Special to highlighted text and both highlighted and non-highlighted paste.
If tx.hl And ex_keys% = 0 Or tx.hl And b$ = Chr$(3) Or tx.hl And b$ = Chr$(24) Or b$ = Chr$(22) Then ' A key was pressed, text is highlighted, and no F1-F12 key was used.
i% = Asc(Mid$(tx.m$, tx.maxchrs + 1, 1))
j% = Asc(Mid$(tx.m$, tx.maxchrs + 2, 1))
If b$ = Chr$(22) And tx.hl = 0 Then ' Special to (PASTE).
' No highlighted text to copy, just a straight paste.
If _Clipboard$ = "" Then Exit Sub ' No text copied.
Else ' Copy text. Cut and Copy copying plus empty Paste check.
If b$ = Chr$(3) Or b$ = Chr$(24) Then ' Ctrl + c and Ctrl + x (COPY) (CUT).
tx.tcopy$ = Mid$(tx.t$, i%, j% - i% + 1)
tx.mcopy = Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + (i% - 1) * tx.noa, (j% * tx.noa) - ((i% - 1) * tx.noa))
_Clipboard$ = tx.tcopy$
Select Case b$
Case Chr$(3)
Exit Sub
Case Chr$(24)
tx.hl = 0 ' Clear highlighting upon reprinting. Ctrl + C (COPY) exception.
End Select
Else
If b$ = Chr$(22) Then
If tx.mcopy = "" And _Clipboard$ = "" Then Beep: Exit Sub ' Nothing to paste into highlighted text.
End If
End If
End If
' Special to backspace, delete, Ctrl + X (CUT), and ctrl + V (Paste) over highlighted text.
If b$ = Chr$(8) Or b$ = Chr$(0) + "S" Or b$ = Chr$(24) Or b$ = Chr$(22) And tx.hl Then
fill$ = String$(tx.maxchrs * tx.noa, Chr$(0))
Mid$(fill$, 1, Len(fill$)) = Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa, (i% - 1) * tx.noa) + Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + j% * tx.noa)
Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa) = fill$ ' Blanks out character attributes but leave special attributes.
Mid$(tx.m$, (tx.maxchrs + 1), 2) = Chr$(0) + Chr$(0) ' Blank both highlighting special attributes.
fill$ = String$(tx.maxchrs, Chr$(0)) ' Now redo the text in the front end.
Mid$(fill$, 1, Len(fill$)) = Left$(tx.t$, i% - 1) + Mid$(tx.t$, j% + 1)
tx.t$ = fill$
matrix_update_method% = 2 ' matrix_col% not required here.
debug = 434: text_matrix ft, tx, matrix_update_method%, matrix_col%, b$, cl%(), bc%()
tx.ccol = i%
tx.hl = 0 ' Clear highlighting upon reprinting.
tx.reprnt = -1
If b$ = Chr$(22) Then ' Paste into highlighted text.
debug = 441: GoSub text_paste ' Paste over routine for highlighted text only.
debug = 443: GoSub evaluate_length ' Returns temp_length_check% as 0 or -1.
If temp_length_check% = 0 Then ' Disallow paste, too long. Reestablish initial values of involved variables.
tx.mcopy$ = "": tx.tcopy$ = ""
tx.t$ = temp_oldt$
tx.m$ = temp_oldm$
tx.reprnt = 0 ' Note: Highlighting will be removed via previous tx.hl = 0 statement before the paste condition statement.
debug = 451: GoSub direct_reprinting
Exit Sub
Else
tx.ccol = tx.ccol + Len(tx.tcopy$) ' Advance cursor to last character of pasted text.
End If
End If
b$ = "": _Continue
Else
If b$ <> Chr$(3) Then ' Avoid if copying txt.
If b$ = Chr$(22) Then 'Paste into non-highlighted text.
debug = 463: GoSub text_paste
debug = 465: GoSub evaluate_length ' Returns temp_length_check% as 0 or -1.
If temp_length_check% = -1 Then ' Allow paste.
tx.ccol = tx.ccol + Len(copied_text$)
tx.reprnt = -1
Else ' Disallow paste, too long.
tx.mcopy$ = "": tx.tcopy$ = ""
tx.t$ = temp_oldt$
tx.m$ = temp_oldm$
End If
b$ = "": _Continue
Else ' Replace highlighted text with a typed character.
fill$ = String$(tx.maxchrs * tx.noa, Chr$(0))
Mid$(fill$, 1, Len(fill$)) = Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa, (i% - 1) * tx.noa) + String$(tx.noa, Chr$(0)) + Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + j% * tx.noa)
Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa) = fill$ ' Blanks out character attributes but leave special attributes.
Mid$(tx.m$, tx.maxchrs + 1, 2) = Chr$(0) + Chr$(0) ' Blank both highlighting special attributes.
fill$ = String$(tx.maxchrs, Chr$(0)) ' Now redo the text in the front end.
Mid$(fill$, 1, Len(fill$)) = Left$(tx.t$, i% - 1) + b$ + Mid$(tx.t$, j% + 1)
tx.t$ = fill$
matrix_col% = i%
matrix_update_method% = 1
debug = 487: text_matrix ft, tx, matrix_update_method%, matrix_col%, b$, cl%(), bc%()
tx.ccol = i% + 1
tx.hl = 0
tx.reprnt = -1
b$ = "": _Continue
End If
End If
End If
End If
If b$ = "Edit Link" Then
tx.link = Asc(Mid$(tx.map_links$, (Asc(Mid$(tx.map_rows$, rby% + 1)) - 1) * _Width + rbx% + 1, 1)) ' +1 adjusts for mouse coordinates starting at zero.
tx.url$ = mylink$(tx.link)
follow_link = 4
debug = 502: text_links ft, tx, follow_link, fnum(), default_bc%(), cl%()
If Len(tx.url$) Then
mylink$(tx.link) = tx.url$
Else
' Link was removed.
mylink$(tx.link) = ""
j% = InStr(tx.map_links$, Chr$(tx.link))
Do
If InStr(j%, tx.map_links$, Chr$(tx.link)) Then
Mid$(tx.map_links$, InStr(j%, tx.map_links$, Chr$(tx.link)), 1) = Chr$(0)
Else
Exit Do
End If
j% = j% + 1
Loop
matrix_update_method% = 5 ' matrix_col% not required here.
debug = 520: text_matrix ft, tx, matrix_update_method%, matrix_col%, b$, cl%(), bc%()
mtx$(tx.scr + tx.ln) = tx.m$
debug = 524: GoSub direct_reprinting
_Delay .5
End If
Exit Sub
End If
Select Case Len(b$) ' Keys for standard text.
Case 1
Select Case b$
Case Chr$(27)
System
Case Chr$(13) ' Enter
m.mousekey$ = Chr$(0) + "P"
Exit Sub
Case Chr$(14) ' New.
tx.newproject = -1
Case Chr$(15) ' Open File.
tx.openfile = _OpenFileDialog$("Open File", "", "*.txt", "Text files", -1)
Exit Sub ' Go around and redo setup and trigger open file condition when enterng back into this routine through the main loop.
Case Chr$(19) ' Save / Save As.
a$ = _SaveFileDialog$("Save File", "", "*.txt", "Text files")
If a$ = "" Then Exit Sub ' Cancelled or closed.
If _FileExists(a$) Then Kill a$
j% = 0
temp = String$(tx.maxchrs * (tx.noa + 1) + tx.sa, Chr$(0)) ' tx.m$ STRING LENGTH.
Mid$(temp, 1, tx.maxchrs) = "MAX=" + LTrim$(Str$(tx.maxchrs)) + "|" + "LEN=" + LTrim$(Str$(Len(temp))) + "|" + "NOL=" + LTrim$(Str$(tx.nol)) + "|" + "LNK=" + LTrim$(Str$(UBound(mylink$)))
ff1 = FreeFile
Open a$ For Binary As #ff1
Put #ff1, 1, temp
For i% = 1 To UBound(mylink$)
temp = String$(tx.maxchrs * (tx.noa + 1) + tx.sa, Chr$(0))
Mid$(temp, 1) = mylink$(i%)
Put #ff1, 1 + i% * Len(temp), temp
Next
For j% = 1 To tx.nol
temp = String$(tx.maxchrs * (tx.noa + 1) + tx.sa, Chr$(0))
Mid$(temp, 1) = mtx$(j%)
Put #ff1, 1 + (i% - 1 + j%) * Len(temp), temp
Next
Close #ff1
Exit Sub
Case Chr$(1) ' Ctrl + A (SELECT ALL).
If tx.numchrs > 0 Then
tx.hl = 1
Mid$(tx.m$, tx.maxchrs + 1, 1) = Chr$(1) ' Always the first character.
Mid$(tx.m$, tx.maxchrs + 2, 1) = Chr$(tx.numchrs)
tx.reprnt = -1
tx.ccol = tx.numchrs + 1
If tx.ccol > tx.maxchrs Then tx.ccol = tx.maxchrs
b$ = "": _Continue
End If
Case Chr$(8) ' backspace
If tx.ccol > 1 Then
' Substitute matrix routine. ---------
fill$ = String$(tx.maxchrs * tx.noa, Chr$(0)): Mid$(fill$, 1, Len(fill$)) = Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa, (tx.ccol - 2) * tx.noa) + Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + (tx.ccol - 1) * tx.noa)
Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa) = fill$ ' Blanks out character attributes but leave special attributes.
fill$ = String$(tx.maxchrs, Chr$(0)) ' Now redo the text in the front end.
Mid$(fill$, 1, Len(fill$)) = Mid$(tx.t$, 1, tx.ccol - 2) + Mid$(tx.t$, tx.ccol)
tx.t$ = fill$
Mid$(tx.m$, 1, tx.maxchrs) = tx.t$
'-------------------------------------
'*' No need to update cursor because the entire line gets erased, including overwrite cursor height, during the reprint cycle. Without that line, gosub the update_cursor routine but first reduce tx.numchrs to tx.numchrs - 1 as the string was shortened.
tx.ccol = tx.ccol - 1
matrix_update_method% = 2 ' matrix_col% not required here.
debug = 589: text_matrix ft, tx, matrix_update_method%, matrix_col%, b$, cl%(), bc%()
tx.reprnt = -1
Else
b$ = "": Exit Sub
End If
Case Chr$(32) To Chr$(127) ' Restricted to keyboard nubers, letters, and displayed glyhps.
' Keys to display to the screen start here...
tx.c_wdth = _PrintWidth(b$)
Rem No need to update cursor here because the text line was blanked out in this routine.
If tx.ovr Then
' Evaluate line length.
i% = Len(Mid$(tx.t$, 1, InStr(tx.t$ + Chr$(0), Chr$(0)) - 1))
' Remember that pixcol is tx.lm + index_col(i%)
If tx.ccol > i% Then ' Cursor is past the end of the text.
If tx.pixcol + 2 * tx.c_wdth > tx.rm Then ' Character plus the cursor space.
Sound 500, 1
_KeyClear
Exit Sub
End If
Else ' Cursor is inside the text.
k% = Asc(Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + 2 + (tx.ccol - 1) * tx.noa, 1))
If tx.c_wdth > k% Then
If tx.pixcol + tx.c_wdth - k% > tx.rm Then
Sound 500, 1
_KeyClear
Exit Sub
End If
End If
End If
' If font or color was changed update it here.
If oldfsn <> ft.fsn Then oldfsn = ft.fsn: _Font fnum(ft.fsn)
If oldcolor <> mycolor Then oldcolor = mycolor: Color _RGB32(cl%(1), cl%(2), cl%(3), 255), _RGB32(bc%(1), bc%(2), bc%(3), 255)
Mid$(tx.t$, tx.ccol, 1) = b$
fill$ = String$(tx.maxchrs * tx.noa, Chr$(0))
Mid$(fill$, 1, Len(fill$)) = Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa, (tx.ccol - 1) * tx.noa) + String$(tx.noa, Chr$(0)) + Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + (tx.ccol) * tx.noa)
Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa) = fill$
matrix_col% = tx.ccol
matrix_update_method% = 1
debug = 630: text_matrix ft, tx, matrix_update_method%, matrix_col%, b$, cl%(), bc%()
If tx.pixcol < tx.rm Then
tx.ccol = tx.ccol + 1
Else
tx.oldccol = -tx.ccol ' Disables printing delay due to cursor non-movement.
End If
Else ' Insert mode
If tx.pixcol + tx.c_wdth > tx.rm - tx.c_wdth Then
Sound 500, 1
_KeyClear
Exit Sub
Else
' If font or color was changed update it here.
If oldfsn <> ft.fsn Then oldfsn = ft.fsn: _Font fnum(ft.fsn)
If oldcolor <> mycolor Then oldcolor = mycolor: Color _RGB32(cl%(1), cl%(2), cl%(3), 255), _RGB32(bc%(1), bc%(2), bc%(3), 255)
tx.t$ = Left$(Left$(tx.t$, tx.ccol - 1) + b$ + Right$(tx.t$, Len(tx.t$) - tx.ccol + 1) + Space$(10), tx.maxchrs)
fill$ = String$(tx.maxchrs * tx.noa, Chr$(0))
Mid$(fill$, 1, Len(fill$)) = Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa, (tx.ccol - 1) * tx.noa) + String$(tx.noa, Chr$(0)) + Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + (tx.ccol - 1) * tx.noa)
Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa) = fill$
matrix_col% = tx.ccol
matrix_update_method% = 1
debug = 653: text_matrix ft, tx, matrix_update_method%, matrix_col%, b$, cl%(), bc%()
tx.ccol = tx.ccol + 1 ' Advance cursor.
End If
End If
tx.reprnt = -1 ' Reprint screen next cycle.
Case Else
Beep ' Not supported
b$ = ""
End Select
Case 2
a = Asc(Right$(b$, 1))
Select Case a
Case 72, 80 ' CHR$(0) +"H" Arrow up and CHR$(0) + "P" Arrow down.
If a = 72 And tx.scr + tx.ln > 1 Or a = 80 Then
change_text_line% = tx.ln - 1 + -2 * (a = 80)
tx.oldccol = tx.ccol
debug = 670: GoSub change_text_line
If Len(Mid$(tx.t$, 1, InStr(tx.t$ + Chr$(0), Chr$(0)) - 1)) < tx.oldccol Then ' Line is shorter than cursor column.
m.mousekey$ = Chr$(0) + "O" ' Advanc to the end of the shorter text line.
Else
tx.ccol = tx.oldccol ' Stay in the same column.
End If
Exit Sub
End If
Case 115 ' Ctrl + arrow left CHR$(0) + "s"
If tx.ccol > 1 Then
bit = 0
debug = 683: text_cursor ft, tx, fnum(), index_col(), default_cl%(), default_bc%(), cl%()
h% = tx.ccol
i% = _InStrRev(tx.t$, " ")
If i% = 0 Then
tx.ccol = 1
Else
' BASIC lets us get away with negative mid$ calculations.
tx.ccol = _InStrRev(Mid$(tx.t$, 1, Len(RTrim$(Mid$(tx.t$, 1, _InStrRev(Mid$(tx.t$, 1, tx.ccol - 2), " ") + 1)))), " ") + 1
End If
If tx.shift Then
tx.hl = -1 ' Highlighting occurs to the left.
j% = Asc(Mid$(tx.m$, tx.maxchrs + 1, 1))
k% = Asc(Mid$(tx.m$, tx.maxchrs + 2, 1))
If j% Then ' Previously highlighted text.
Select Case tx.ccol
Case Is < j% ' Continued highlighting or highlighting past retracing like when 1234xxx becomes xxxx567.
If j% < h% Then Mid$(tx.m$, tx.maxchrs + 2, 1) = Chr$(j% - 1)
Mid$(tx.m$, tx.maxchrs + 1, 1) = Chr$(tx.ccol)
Case Is = j% ' Retraced to remove highlighting.
tx.hl = 0
Mid$(tx.m$, tx.maxchrs + 1, 2) = Chr$(0) + Chr$(0) ' Completely remove highlighted text.
Case Is > j% ' Retracing.
Mid$(tx.m$, tx.maxchrs + 1, 1) = Chr$(j%)
Mid$(tx.m$, tx.maxchrs + 2, 1) = Chr$(tx.ccol - 1)
End Select
Else ' Unhighlighted text to be highlighted.
Mid$(tx.m$, tx.maxchrs + 1, 1) = Chr$(tx.ccol)
Mid$(tx.m$, tx.maxchrs + 2, 1) = Chr$(h% - 1) ' Where h% is the previous cursor column.
End If
tx.reprnt = -1
End If
End If
Case 116 ' Ctrl + arrow right CHR$(0) + "t"
If tx.ccol < tx.numchrs + 1 Then
bit = 0
debug = 720: text_cursor ft, tx, fnum(), index_col(), default_cl%(), default_bc%(), cl%()
h% = tx.ccol ' Only needed for highlighting.
i% = InStr(tx.ccol, tx.t$, " ")
If i% = 0 Then ' No more spaces.
tx.ccol = tx.numchrs + 1: If tx.ccol > tx.maxchrs Then tx.ccol = tx.maxchrs
Else
j% = Len(Mid$(tx.t$, i%))
k% = Len(LTrim$(Mid$(tx.t$, i%)))
tx.ccol = i% + j% - k%
End If
If tx.shift Then
j% = Asc(Mid$(tx.m$, tx.maxchrs + 1, 1))
k% = Asc(Mid$(tx.m$, tx.maxchrs + 2, 1))
If j% Then ' Previously highlighted text.
If k% < h% Then ' Continued highlighting or highlighting past retracing text.
If k% < h% Then Mid$(tx.m$, tx.maxchrs + 1, 1) = Chr$(j%)
Mid$(tx.m$, tx.maxchrs + 2, 1) = Chr$(tx.ccol - 1)
Else
If tx.ccol - 1 = k% Then ' Retraced to unhighlight.
tx.hl = 0
Mid$(tx.m$, tx.maxchrs + 1, 2) = Chr$(0) + Chr$(0) ' Completely remove highlighted text.
Else ' Retracing.
If tx.ccol > k% Then
Mid$(tx.m$, tx.maxchrs + 2, 1) = Chr$(tx.ccol - 1)
Mid$(tx.m$, tx.maxchrs + 1, 1) = Chr$(k% + 1)
Else
Mid$(tx.m$, tx.maxchrs + 1, 1) = Chr$(tx.ccol)
Mid$(tx.m$, tx.maxchrs + 2, 1) = Chr$(k%)
End If
End If
End If
j% = Asc(Mid$(tx.m$, tx.maxchrs + 1, 1))
k% = Asc(Mid$(tx.m$, tx.maxchrs + 2, 1))
Else ' Highlight unhighlighted text.
Mid$(tx.m$, tx.maxchrs + 1, 1) = Chr$(h%) ' Previous cursor column.
Mid$(tx.m$, tx.maxchrs + 2, 1) = Chr$(tx.ccol - 1)
End If
tx.hl = 1 ' Highlighting occurs to the right.
tx.reprnt = -1
End If
End If
Case 71, 79 ' Home End
If a = 71 Then xx = 1 Else xx = 0
If tx.ccol > 1 And xx = 1 Or tx.ccol < tx.numchrs + 1 And tx.pixcol <= tx.rm And xx = 0 Then
If tx.shift Then
tx.hl = -1 + xx * 2
j% = Asc(Mid$(tx.m$, tx.maxchrs + 1, 1))
k% = Asc(Mid$(tx.m$, tx.maxchrs + 2, 1))
If j% Then ' Previously highlighted text.
If j% < tx.ccol And xx = 1 Or j% > tx.ccol - 1 And xx = 0 Then
If j% = 1 And k% = tx.numchrs Then ' Retrace all to unhighlight text.
tx.hl = 0
Mid$(tx.m$, tx.maxchrs + 1, 2) = Chr$(0) + Chr$(0) ' Completely remove highlighted text.
Else ' Retrace
Mid$(tx.m$, tx.maxchrs + 1 + xx, 1) = Chr$(Asc(Mid$(tx.m$, tx.maxchrs + 2 - xx, 1)) + 1 - xx * 2)
Mid$(tx.m$, tx.maxchrs + 2 - xx, 1) = Chr$(tx.numchrs * (xx Xor 1) + (xx Xor 0))
End If
Else ' Continue highlighting to end.
Mid$(tx.m$, tx.maxchrs + 2 - xx, 1) = Chr$(tx.numchrs * (xx Xor 1) + (xx Xor 0))
End If
Else ' Highlight text.
Mid$(tx.m$, tx.maxchrs + 1 + xx, 1) = Chr$(tx.ccol - xx) ' Highlight from current cursor column to home or end.
Mid$(tx.m$, tx.maxchrs + 2 - xx, 1) = Chr$(tx.numchrs * (xx Xor 1) + (xx Xor 0))
End If
tx.reprnt = -1
Else
bit = 0
debug = 789: text_cursor ft, tx, fnum(), index_col(), default_cl%(), default_bc%(), cl%()
End If
tx.ccol = tx.numchrs * (xx Xor 1) + 1 ' Home or End column.
End If
Case 82 ' Ins
If tx.insreg = 0 Then
bit = 0 ' Hide old cursor style.
debug = 798: text_cursor ft, tx, fnum(), index_col(), default_cl%(), default_bc%(), cl%()
tx.ovr = tx.ovr Xor 1
tx.insreg = 1 ' Initiate delay going to -1 after the cursor gets changed in next sub call.
End If
Case 83 ' Del CHR$(0) + "S"
If tx.numchrs And tx.ccol <= tx.numchrs Then
tx.t$ = Mid$(tx.t$, 1, tx.ccol - 1) + Mid$(tx.t$, tx.ccol + 1)
tx.oldccol = -tx.ccol
fill$ = String$(tx.maxchrs * tx.noa, Chr$(0))
Mid$(fill$, 1, Len(fill$)) = Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa, (tx.ccol - 1) * tx.noa) + Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + tx.ccol * tx.noa)
Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa) = fill$
matrix_update_method% = 2 ' matrix_col% not required here.
debug = 812: text_matrix ft, tx, matrix_update_method%, matrix_col%, b$, cl%(), bc%()
' No need to sub update_cursor here because cursor doesn't get moved with delete.
tx.reprnt = -1 ' Now reprint the changed text.
ElseIf tx.numchrs = 0 And tx.ccol = 1 Then
If tx.scr + tx.ln < tx.nol Then
' Delete up text line below but bypass if on the last line to avoid an empty matrix error.
debug = 820: GoSub blank_text_area
While InStr(tx.map_rows$, Chr$(tx.ln + 1)) > 0
j% = InStr(tx.map_rows$, Chr$(tx.ln + 1)) ' Update row map.
Mid$(tx.map_rows$, j%, 1) = Chr$(0)
Wend
tx.nol = tx.nol - 1
g% = tx.ln
j% = tx.nol
temp% = tx.row ' Okay to use k% here but it might cause debug confusion in the upcoming gosub routine. k% is used in that sub by another calling routine.
debug = 826: l% = 1: GoSub assign_lines ' Transfers variables g% - l%
' Reestablish current text line, row, and matrix components.
ReDim _Preserve mtx$(tx.nol)
tx.ln = g%
tx.row = temp%
tx.m$ = mtx$(tx.scr + g%)
tx.t$ = String$(tx.maxchrs, Chr$(0))
Mid$(tx.t$, 1, tx.maxchrs) = Mid$(tx.m$, 1, InStr(tx.m$ + Chr$(0), Chr$(0)) - 1)
debug = 836: text_reprint ft, tx, fnum(), mtx$(), index_col(), default_bc%(), cl%()
Exit Sub
End If
End If
Case 59 To 67, 133 To 134
Select Case a
Case 59 ' F1 ' Regular font.
oldfsn = ft.fsn: ft.fsn = 1: _Font fnum(ft.fsn)
If tx.button_status = 0 Then tx.button_status = -999 ' Default status.
If tx.hl Then GoSub button_universal_replace
Exit Sub
Case 60 ' F2 ' Bold font.
oldfsn = ft.fsn: ft.fsn = 2: _Font fnum(ft.fsn)
If tx.button_status = 0 Then tx.button_status = -11
If tx.hl Then GoSub button_universal_replace
Exit Sub
Case 61 ' F3 ' Italic font.
oldfsn = ft.fsn: ft.fsn = 3: _Font fnum(ft.fsn)
If tx.button_status = 0 Then tx.button_status = -12
If tx.hl Then GoSub button_universal_replace
Exit Sub
Case 62 ' F4 ' Bold+Italic font
oldfsn = ft.fsn: ft.fsn = 4: _Font fnum(ft.fsn)
If tx.button_status = 0 Then tx.button_status = -22
If tx.hl Then GoSub button_universal_replace
Exit Sub
Case 63 ' F5 Underline. (Toggle).
If tx.button_status = 0 Then
tx.button_status = -3
tx.underline = 1
Else
tx.underline = 1 - tx.underline
End If
If tx.hl Then GoSub button_universal_replace
Exit Sub
Case 64 ' F6 ' Black (Default)
oldcolor = mycolor: mycolor = 0
cl%(1) = 0: cl%(2) = 0: cl%(3) = 0
bc%(1) = default_bc%(1): bc%(2) = default_bc%(2): bc%(3) = default_bc%(3)
If tx.button_status = 0 Then tx.button_status = -4
If tx.hl Then GoSub button_universal_replace
Exit Sub
Case 65 ' F7 Blue.
oldcolor = mycolor: mycolor = 1
cl%(1) = 0: cl%(2) = 0: cl%(3) = 200
bc%(1) = default_bc%(1): bc%(2) = default_bc%(2): bc%(3) = default_bc%(3)
If tx.button_status = 0 Then tx.button_status = -5
If tx.hl Then GoSub button_universal_replace
Exit Sub
Case 66 ' F8 Red.
oldcolor = mycolor: mycolor = 2
cl%(1) = 200: cl%(2) = 0: cl%(3) = 0
bc%(1) = default_bc%(1): bc%(2) = default_bc%(2): bc%(3) = default_bc%(3)
If tx.button_status = 0 Then tx.button_status = -6
If tx.hl Then GoSub button_universal_replace
Exit Sub
Case 67 ' F9 Highlighted.
oldcolor = mycolor: mycolor = 3
cl%(1) = 0: cl%(2) = 0: cl%(3) = 0
bc%(1) = 255: bc%(2) = 255: bc%(3) = 100
If tx.button_status = 0 Then tx.button_status = -7
If tx.hl Then GoSub button_universal_replace
Exit Sub
Case 133 ' F11 URL
' Check for highlight special attributes or in an edit situation, check for mouse cursor hand.
If Mid$(tx.m$, (tx.maxchrs + 1), 2) <> Chr$(0) + Chr$(0) Or m.CursorStyle = 1 Then
follow_link = 1 ' 1 = input link. 0 = follow link.
debug = 905: text_links ft, tx, follow_link, fnum(), default_bc%(), cl%()
If Len(tx.url$) Then
For i% = 1 To UBound(mylink$)
If Len(mylink$(i%)) = 0 Then i% = -i%: Exit For
Next
If i% > 0 Then
tx.link = tx.link + 1
ReDim _Preserve mylink$(tx.link)
Else
tx.link = Abs(i%)
End If
' Format hypertext.
matrix_update_method% = 4
debug = 920: text_matrix ft, tx, matrix_update_method%, matrix_col%, b$, cl%(), bc%()
mylink$(tx.link) = tx.url$
debug = 924: GoSub direct_reprinting
b$ = "": _Continue
End If
If tx.button_status = 0 Then tx.button_status = -8
Else
Beep ' Nothing highlighted to link.
End If
Exit Sub
Case 134 ' F12 Follow link.
debug = 935: j% = 1: GoSub openlink
Exit Sub
End Select
Case 75, 77
cur_arrows = tx.ccol + (a = 75) - (a = 77) ' Arrow right or left.
If cur_arrows > 0 And cur_arrows <= tx.numchrs + 1 And tx.pixcol + pop.chr_wdth < tx.rm Then
If tx.shift Then
If cur_arrows > tx.ccol Then xx = 1 Else xx = 0 ' 1 cursor right, 0 cursor left.
tx.hl = -1 + xx * 2
tx.arrows = -1 + xx * 2
If Asc(Mid$(tx.m$, (tx.maxchrs + 1), 1)) Then
If cur_arrows - xx >= Asc(Mid$(tx.m$, (tx.maxchrs + 1), 1)) And cur_arrows - xx <= Asc(Mid$(tx.m$, (tx.maxchrs + 2), 1)) Then
If cur_arrows - xx = Asc(Mid$(tx.m$, (tx.maxchrs + 1 + xx), 1)) Then
tx.hl = 0 ' Fully retraced. Highlighting off.
Mid$(tx.m$, (tx.maxchrs + 1), 2) = Chr$(0) + Chr$(0)
Else
Mid$(tx.m$, tx.maxchrs + 2 - xx, 1) = Chr$(Asc(Mid$(tx.m$, tx.maxchrs + 2 - xx, 1)) - 1 + xx * 2) ' Retracing.
End If
Else
Mid$(tx.m$, tx.maxchrs + 1 + xx, 1) = Chr$(cur_arrows - xx) ' Continuing highlighting left.
End If
Else
Mid$(tx.m$, tx.maxchrs + 1, 2) = Chr$(cur_arrows - xx) + Chr$(cur_arrows - xx)
End If
End If
bit = 0
debug = 963: text_cursor ft, tx, fnum(), index_col(), default_cl%(), default_bc%(), cl%()
tx.ccol = cur_arrows ' Update to current cursor position.
End If
Case Else
Beep ' Not supported.
Exit Sub
End Select
End Select
End If
' Mouse events.
If m.wh Then ' Mouse wheel check.
If m.wh > 0 Then m.mousekey$ = Chr$(0) + "P" Else m.mousekey$ = Chr$(0) + "H"
Exit Sub
End If
If m.rb_status = 1 Then rbx% = m.mx: rby% = m.my
j% = Asc(Mid$(tx.map_rows$, m.my + 1)) ' Check if on a text row.
If tx.hl = 0 And j% And Mid$(tx.map_links$, (j% - 1) * _Width + m.mx, 1) <> Chr$(0) Then ' Last condition prevents activting while dragging over hyperlink.
_MouseShow "LINK": m.CursorStyle = 1
ElseIf m.CursorStyle = 1 Then ' Hyperlink mouseover event. 1 = hyperlink -1 is for buttons.
_MouseShow "DEFAULT": m.CursorStyle = 0
End If
If m.lb_status > 0 Then ' For events 1 = Click and 2 = Drag.
If m.mx >= tx.lm And m.mx <= tx.rm And m.my >= tx.row And m.my <= tx.row + tx.c_hght Or m.lb_status = 2 Then ' True when mouse cursor on text line within margins and anywhere when dragging.
' Click events on text line. See further in code for (Click occurred off the text line).
Select Case m.CursorStyle
Case 0
Select Case m.lb_status
Case 1
If tx.hl Then ' Highlighted text with a mouse click.
debug = 994: GoSub direct_reprinting ' Removes highlighting due to mouse click on text line.
_Delay .1
End If
j% = tx.lm
For i% = 1 To tx.numchrs
j% = j% + Asc(Mid$(tx.m$, tx.sa + (tx.maxchrs + 1) + 2 + tx.noa * (i% - 1), 1))
If j% >= m.mx Then Exit For ' Sets i% to determine the right or left direction for the highlighting drag.
Next
bit = 0
debug = 1005: text_cursor ft, tx, fnum(), index_col(), default_cl%(), default_bc%(), cl%()
tx.ccol = i%
Case 2 ' Drag to highlight text.
j% = tx.lm
For i% = 1 To tx.numchrs
j% = j% + Asc(Mid$(tx.m$, tx.sa + (tx.maxchrs + 1) + 2 + tx.noa * (i% - 1), 1))
If j% >= m.mx Then Exit For ' Sets i% to determine the right or left direction for the highlighting drag.
Next
If i% > tx.ccol Then
m.mousekey$ = Chr$(0) + "M": tx.autoshift = -1
ElseIf i% < tx.ccol Then
m.mousekey$ = Chr$(0) + "K": tx.autoshift = -1
ElseIf i% = tx.ccol Then
' Do nothing.
End If
End Select
Case 1
If m.lb_status = 1 Then ' Do not allow drag events (2) to open links. This prevents opening many instances.
debug = 1025: j% = 2: GoSub openlink ' Also occurs, with drag event excluded by a prior statement, when off the text line. See further down in code.
End If
Exit Sub
End Select
ElseIf m.lb_status = 1 Then ' Click off text line. Drag event is not processed here.
' IMPORTANT: Add any other exceptions for new clickable features not in text areas like buttons.
If m.my >= tx.tm And m.my <= tx.bm And m.mx >= tx.lm And m.mx <= tx.rm Then ' Cursor is within text area and not above at buttons, top menu, etc.
Select Case m.CursorStyle
Case 0
If tx.hl Then ' Remove highlighted text.
debug = 1037: GoSub direct_reprinting
_Delay .1
End If
' Regular text or highlighting removed above. Move up or down.
j% = Asc(Mid$(tx.map_rows$, m.my + 1, 1))
If j% Then
change_text_line% = j%
debug = 1046: GoSub change_text_line
Exit Sub
Else ' Allow for a mouse click to move down if there is text in the current line.
change_text_line% = 0
For i% = 1 To m.my
k% = Asc(Mid$(tx.map_rows$, i%, 1))
If k% > change_text_line% Then change_text_line% = k%
Next
change_text_line% = change_text_line% + 1
debug = 1057: GoSub change_text_line
Exit Sub
End If
Case 1
debug = 1063: j% = 2: GoSub openlink ' Note dragging isn't processed here. See elseif statement several lines above.
Exit Sub
End Select
End If
End If
End If
' Cursor and text reprinting events.
If tx.reprnt Then
debug = 1073: text_reprint ft, tx, fnum(), mtx$(), index_col(), default_bc%(), cl%()
End If
tx.mindex = (tx.maxchrs + 1) + tx.sa + (tx.ccol - 1) * tx.noa
If tx.ccol > tx.numchrs Then
tx.c_wdth = _PrintWidth("A")
tx.c_hght = _FontHeight
Else
tx.c_wdth = Asc(Mid$(tx.m$, tx.mindex + 2, 1))
tx.c_hght = Asc(Mid$(tx.m$, tx.mindex + 3, 1))
End If
If tx.insreg = -1 Then
If Timer > cc! Then
cc! = Timer + .25: If cc! > 86400 Then cc! = .25
tx.insreg = 0
debug = 1089: bit = -1: text_cursor ft, tx, fnum(), index_col(), default_cl%(), default_bc%(), cl%()
Else
_KeyClear: bit = 0: Exit Sub
End If
Else
If tx.insreg = 1 Then tx.insreg = -1 ' Cursor was changed. Now lock out any button held down ins events until a cursor cycle gets completed.
If m.lb_status <> 2 Then ' Disable cursor flashing during drag events.
If Timer > cc! Or tx.oldccol <> tx.ccol Or Len(b$) Or tx.arrows <> 0 Then
If tx.arrows Then tx.arrows = 0: bit = -1
bit = bit Xor 1
cc! = Timer + .25: If cc! > 86400 Then cc! = .25
debug = 1102: text_cursor ft, tx, fnum(), index_col(), default_cl%(), default_bc%(), cl%() ' Cursor flashing subroutine.
End If
Else
bit = 0 ' Hide cursor while dragging.
debug = 1108: text_cursor ft, tx, fnum(), index_col(), default_cl%(), default_bc%(), cl%()
End If
End If
tx.oldccol = tx.ccol
b$ = ""
Loop Until tx.reprnt = 0
Exit Sub ' --------------------------------------->
blank_text_area:
Line (tx.lm, tx.row)-(tx.rm, tx.bm), _RGB32(255, 255, 255, 255), BF ' Blank text area.
Return
assign_lines: ' IMPORTANT: Uses temporary variables g%-l% from calling routines.
tbit` = -1
For h% = g% To j%
Select Case l%
Case 0: ' Do nothing, just reprinting while scrolling.
Case 1
If UBound(mtx$) > tx.scr + h% Then
mtx$(tx.scr + h%) = mtx$(tx.scr + h% + 1) ' Line Deletion
Else
ReDim _Preserve mtx$(tx.scr + h%)
mtx$(tx.scr + h%) = String$(tx.maxchrs * (tx.noa + 1) + tx.sa, Chr$(0))
End If
Case 2
Get #ff1, 1 + (k% + h%) * i%, temp
mtx$(tx.scr + h%) = temp ' Variable temp needed. Cannot load binry directly as an array.
End Select
If tbit` Then ' Prevents printing below bottom margin.
tx.m$ = mtx$(tx.scr + h%)
tx.t$ = String$(tx.maxchrs, Chr$(0))
Mid$(tx.t$, 1, tx.maxchrs) = Mid$(tx.m$, 1, InStr(tx.m$ + Chr$(0), Chr$(0)) - 1)
debug = 1134: text_reprint ft, tx, fnum(), mtx$(), index_col(), default_bc%(), cl%()
If h% < j% And tx.row + 6 + _FontHeight < tx.bm Then
tx.ln = tx.ln + 1
tx.row = tx.row + 6 + _FontHeight ' IMPORTANT: Unfinished for max height when different size fonts are added.
Else
If tx.row + 6 + _FontHeight >= tx.bm Then tbit` = 0
End If
End If
Next
tbit` = 0
Return
set_maps:
tx.map_rows$ = String$(_Height, Chr$(0)) ' Blank map to detect text and mouse row.
tx.map_links$ = String$(_Width * _Height \ 4, Chr$(0)) ' Blank map to detect hyperlinked text and control mouseover. _height \ 4 for size 4 smallest allowed font.
Return
set_text_vars:
tx.ccol = 1: tx.oldccol = tx.ccol
tx.m$ = String$(tx.sa + tx.maxchrs * (tx.noa + 1), Chr$(0)) ' Algorithm makes a 1 string field, 10 ID fields for highlighting, paragraph, plain text line, etc., and tx.noa attributes fields.
tx.t$ = String$(tx.maxchrs, Chr$(0)) ' Our text.
ReDim index_col(tx.maxchrs)
tx.numchrs = 0
Return
evaluate_length:
' Evaluate length before displaying text.
i% = Len(Mid$(tx.t$, 1, InStr(tx.t$ + Chr$(0), Chr$(0)) - 1))
j% = Asc(Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + 2 + (i% - 1) * tx.noa, 1)) ' Width of the last character.
temp_length_check% = tx.lm ' Set to left margin.
For h% = 1 To i%
temp_length_check% = temp_length_check% + Asc(Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + 2 + (h% - 1) * tx.noa, 1))
Next
If temp_length_check% + j% > tx.rm Then
Sound 500, 1
temp_length_check% = 0 ' Too long to display. 0 = abort on return.
Else
temp_length_check% = -1 ' Okay to display.
End If
Return
change_text_line:
bit = 0: text_cursor ft, tx, fnum(), index_col(), default_cl%(), default_bc%(), cl%()
flag = 0
mtx$(tx.scr + tx.ln) = tx.m$
tx.ln = change_text_line%
Do ' Falx loop
If change_text_line% = 0 And tx.scr > 0 Then flag = 1: Exit Do
If InStr(tx.map_rows$, Chr$(tx.ln)) Then flag = 2: Exit Do
j% = InStr(tx.map_rows$, Chr$(tx.ln - 1))
If j% And j% + 6 + _FontHeight < tx.bm Then flag = 3: Exit Do
flag = 4: Exit Do
Loop
Select Case flag
Case 1
debug = 1191: GoSub blank_text_area
debug = 1193: GoSub set_text_vars
tx.ln = 1: tx.row = tx.tm: tx.scr = tx.scr - 1
For i = 1 To tx.eop
tx.m$ = mtx$(tx.scr + tx.ln)
tx.t$ = Mid$(tx.m$, 1, tx.maxchrs)
tx.numchrs = InStr(tx.t$ + Chr$(0), Chr$(0)) - 1
debug = 1201: text_reprint ft, tx, fnum(), mtx$(), index_col(), default_bc%(), cl%()
If i <> tx.eop Then tx.ln = tx.ln + 1: tx.row = tx.row + 6 + _FontHeight
Next
tx.ln = 1
tx.row = tx.tm
tx.m$ = mtx$(tx.scr + tx.ln)
tx.t$ = Mid$(tx.m$, 1, tx.maxchrs)
debug = 1210: text_reprint ft, tx, fnum(), mtx$(), index_col(), default_bc%(), cl%()
Case 2
tx.m$ = mtx$(tx.scr + tx.ln)
tx.t$ = Mid$(tx.m$, 1, tx.maxchrs)
tx.row = InStr(tx.map_rows$, Chr$(tx.ln))
tx.numchrs = InStr(tx.t$ + Chr$(0), Chr$(0)) - 1
j% = tx.lm
For i% = 1 To tx.numchrs
j% = j% + Asc(Mid$(tx.m$, tx.sa + (tx.maxchrs + 1) + 2 + tx.noa * (i% - 1), 1))
If j% >= m.mx Then Exit For ' Sets i% to determine the right or left direction for the highlighting drag.
Next
tx.ccol = i%
ReDim index_col(tx.maxchrs)
For i% = 1 To tx.numchrs
j% = (tx.maxchrs + 1) + tx.sa + (i% - 1) * tx.noa
k% = Asc(Mid$(tx.m$, j% + 2, 1))
index_col(i%) = index_col(i% - 1) + k%
Next
Case 3
debug = 1231: GoSub set_text_vars
tx.row = InStr(tx.map_rows$, Chr$(tx.ln - 1)) + 6 + _FontHeight
debug = 1235: text_reprint ft, tx, fnum(), mtx$(), index_col(), default_bc%(), cl%()
Case 4
debug = 1239: GoSub blank_text_area
debug = 1241: GoSub set_text_vars
tx.ln = 1: tx.row = tx.tm: tx.scr = tx.scr + 1
For i% = 1 To tx.eop - 1
tx.m$ = mtx$(tx.scr + tx.ln)
tx.t$ = Mid$(tx.m$, 1, tx.maxchrs)
debug = 1248: text_reprint ft, tx, fnum(), mtx$(), index_col(), default_bc%(), cl%()
tx.ln = tx.ln + 1: tx.row = tx.row + 6 + _FontHeight
Next
If tx.scr + tx.ln >= tx.nol Then ' New line.
debug = 1254: GoSub set_text_vars
Else ' Scrolled up line on bottom margin.
tx.m$ = mtx$(tx.scr + tx.ln)
tx.t$ = Mid$(tx.m$, 1, tx.maxchrs)
End If
debug = 1261: text_reprint ft, tx, fnum(), mtx$(), index_col(), default_bc%(), cl%()
End Select
change_text_line% = 0
Return
button_universal_replace: ' highlighted text changed by format button press or click.
i% = Asc(Mid$(tx.m$, tx.maxchrs + 1, 1))
j% = Asc(Mid$(tx.m$, tx.maxchrs + 2, 1))
temp_b$ = b$ ' Set up temporary variables to test length.
temp_oldm$ = tx.m$
For h% = i% To j% ' Create a test matrix.
b$ = Mid$(tx.t$, h%, 1)
matrix_col% = h%
matrix_update_method% = 3
debug = 1277: text_matrix ft, tx, matrix_update_method%, matrix_col%, b$, cl%(), bc%()
Next
GoSub evaluate_length ' Returns temp_length_check% as 0 or -1.
If temp_length_check% = -1 Then
b$ = temp_b$ ' Allow. Revert to original key entry.
debug = 1286: GoSub direct_reprinting
Else ' Disallow. IMPORTANT: Note that the button used is still active.
tx.hl = 0 ' Results too long. Disallow, revert to prior, and remove highlighting
tx.m$ = temp_oldm$
debug = 1292: GoSub direct_reprinting
End If
Return
direct_reprinting:
tx.hl = 0 ' Turns highllighting off.
Mid$(tx.m$, (tx.maxchrs + 1), 2) = Chr$(0) + Chr$(0) ' Blank both highlighting special attributes.
debug = 1301: text_reprint ft, tx, fnum(), mtx$(), index_col(), default_bc%(), cl%() ' Reprints text line.
tx.mindex = (tx.maxchrs + 1) + tx.sa + (tx.ccol - 1) * tx.noa ' Reestablish the current cursor location in the matrix after reprinting.
Return
text_paste:
tx.t$ = Mid$(tx.t$ + Chr$(0), 1, InStr(tx.t$, Chr$(0)) - 1)
Select Case Len(tx.tcopy$)
Case 0 ' Paste directly from the clipboard.
copied_text$ = _Clipboard$
tx.t$ = Left$(tx.t$, tx.ccol - 1) + _Clipboard$ + Mid$(tx.t$, tx.ccol)
fill$ = String$(tx.maxchrs * tx.noa, Chr$(0))
Mid$(fill$, 1, Len(fill$)) = Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa, (tx.ccol - 1) * tx.noa) + String$(Len(_Clipboard$) * tx.noa, Chr$(0)) + Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + (tx.ccol - 1) * tx.noa)
Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa) = fill$ ' Blanks out character attributes but leave special attributes.
Mid$(tx.m$, (tx.maxchrs + 1), 2) = Chr$(0) + Chr$(0) ' Blank both highlighting special attributes.
fill$ = String$(tx.maxchrs, Chr$(0)) ' Now redo the text in the front end.
Mid$(fill$, 1, Len(fill$)) = tx.t$ ' Chopped from first line.
tx.t$ = fill$
matrix_col% = tx.ccol
matrix_update_method% = 3
For k% = 1 To (Len(copied_text$))
debug = 1323: text_matrix ft, tx, matrix_update_method%, matrix_col%, b$, cl%(), bc%()
matrix_col% = matrix_col% + 1
Next
Case Else ' Paste from the screen.
copied_text$ = tx.tcopy$
tx.t$ = Left$(tx.t$, tx.ccol - 1) + copied_text$ + Mid$(tx.t$, tx.ccol)
fill$ = String$(tx.maxchrs * tx.noa, Chr$(0))
Mid$(fill$, 1, Len(fill$)) = Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa, (tx.ccol - 1) * tx.noa) + tx.mcopy$ + Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + (tx.ccol - 1) * tx.noa)
Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa) = fill$ ' Blanks out character attributes but leave special attributes.
Mid$(tx.m$, (tx.maxchrs + 1), 2) = Chr$(0) + Chr$(0) ' Blank both highlighting special attributes.
fill$ = String$(tx.maxchrs, Chr$(0)) ' Now redo the text in the front end.
Mid$(fill$, 1, Len(fill$)) = tx.t$ ' Chopped from first line.
tx.t$ = fill$
End Select
fill$ = String$(tx.maxchrs, Chr$(0))
Mid$(fill$, 1, Len(tx.t$)) = tx.t$
Mid$(tx.m$, 1, tx.maxchrs) = fill$
Return
openlink:
Select Case j%
Case 1 ' Key press.
k% = Asc(Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + 11 + tx.noa * (tx.ccol - 1), 1))
Case 2 ' Mouse click.
k% = Asc(Mid$(tx.map_links$, (Asc(Mid$(tx.map_rows$, m.my + 1)) - 1) * _Width + m.mx + 1, 1)) ' +1 adjusts for mouse coordinates starting at zero.
End Select
If k% Then
Shell _DontWait mylink$(k%)
_Delay .2
End If
Return
End Sub
Sub text_reprint (ft As fontvar, tx As textvar, fnum() As Long, mtx$(), index_col(), default_bc%(), cl%())
' Local vars: i%, j%, k%, linkpresent` (bit)
tx.numchrs = InStr(tx.t$ + Chr$(0), Chr$(0)) - 1
ReDim index_col(tx.maxchrs)
Mid$(tx.map_links$, (tx.ln - 1) * _Width, _Width) = String$(_Width, Chr$(0))
'*' Line blanks input line, but will need to be updated when different font heights are added to the routine. Update tx.c_hght to a variable that represents the highest font character in the line.
' Note +3 adds a little extra to remove trailing overwrite right cursor edge.
Line (tx.lm, tx.row)-(tx.rm + 3, tx.row + tx.c_hght), _RGB32(255, 255, 255, 255), BF
j% = Asc(Mid$(tx.m$, tx.maxchrs + 1, 1)) ' Check for highlighted text.
k% = Asc(Mid$(tx.m$, tx.maxchrs + 2, 1))
For i% = 1 To tx.numchrs
tx.mindex = (tx.maxchrs + 1) + tx.sa + (i% - 1) * tx.noa
c$ = Mid$(tx.t$, i%, 1)
Rem font_size = Asc(Mid$(tx.m$, tx.mindex + 1, 1))
_Font fnum(Asc(Mid$(tx.m$, tx.mindex, 1)))
index_col(i%) = index_col(i% - 1) + Asc(Mid$(tx.m$, tx.mindex + 2, 1))
If Asc(Mid$(tx.m$, tx.mindex + 11, 1)) Then ' Special for links.
linkpresent` = -1
tx.xl = index_col(i% - 1): tx.cchr$ = c$
follow_link = 3 ' Show link and redo map for text changes.
debug = 1380: text_links ft, tx, follow_link, fnum(), default_bc%(), cl%()
Else ' non-linked text.
If i% >= j% And i% <= k% Then
Color White, Blue
Else
Color _RGB32(Asc(Mid$(tx.m$, tx.mindex + 4, 1)), Asc(Mid$(tx.m$, tx.mindex + 5, 1)), Asc(Mid$(tx.m$, tx.mindex + 6, 1)), 255), _RGB32(Asc(Mid$(tx.m$, tx.mindex + 7, 1)), Asc(Mid$(tx.m$, tx.mindex + 8, 1)), Asc(Mid$(tx.m$, tx.mindex + 9, 1)), 255)
End If
_PrintString (tx.lm + index_col(i% - 1), tx.row), c$ ' Note the first character is set at zero character width (i% - 1).
End If
If Asc(Mid$(tx.m$, tx.mindex + 10, 1)) Then Line (tx.lm + index_col(i% - 1), tx.row + tx.c_hght)-(tx.lm + index_col(i% - 1) + tx.c_wdth, tx.row + ft.max_fontheight), Black
Next
If linkpresent` = 0 Then
Mid$(tx.m$, tx.maxchrs + 3, 1) = Chr$(0) ' Remove any link reference that may have vanished due to various deletion methods, backspace, del, cut, etc.
End If
If tx.numchrs Then tx.pixcol = tx.lm + index_col(tx.numchrs) Else tx.pixcol = tx.lm ' Left margin when no characters exist in the string.
_Font fnum(ft.fsn)
If tx.scr + tx.ln > UBound(mtx$) Then ' ubound instead of tx.nol to avoid redimming when loading a file.
tx.nol = tx.scr + tx.ln
ReDim _Preserve mtx$(tx.nol) ' Array increased by 1.
End If
If tx.ln > tx.eop Then tx.eop = tx.ln
Mid$(tx.map_rows$, tx.row, ft.max_fontheight) = String$(ft.max_fontheight, Chr$(tx.ln))
mtx$(tx.scr + tx.ln) = tx.m$
tx.reprnt = 0
End Sub
Sub text_matrix (ft As fontvar, tx As textvar, matrix_update_method%, matrix_col%, b$, cl%(), bc%())
' Local vars: fill$
' Matrix Explained: 1 to tx.maxchrs is text, tx.maxchrs + 1 to tx.maxchrs + 10 Special attributes, maxchrs + 11 to 11 + tx.noa are character attributes.
' Special Attributes: 1 = begin highlight col. 2 = End highlight column. 3 = Link number.
' Example: tx.maxchrs = 255. tx.noa = 12. 1-255 text, 256-265 special attributes, 266-277 attributes for 1st character in text string, 278-289 2nd, etc.
Select Case matrix_update_method%
Case 1
GoSub backend
GoSub frontend ' The text portion index 1-255 of the matrix.
Case 2 ' Highlighted text changes from button press/click does not require updating the text characters, only the attributes.
GoSub frontend
Case 3
GoSub backend
Case 4
i% = Asc(Mid$(tx.m$, tx.maxchrs + 1, 1))
j% = Asc(Mid$(tx.m$, tx.maxchrs + 2, 1))
Rem Not used temp$ = Mid$(tx.t$, i%, j% - i% + 1) ' Highlighted text.
For k% = 0 To j% - i% ' Update matrix for hyperlinks.
Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + (i% - 1 + k%) * tx.noa + 11, 1) = Chr$(tx.link)
Next
Case 5
i% = 0
Do
If Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + i% * tx.noa + 11, 1) = Chr$(tx.link) Then
Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + i% * tx.noa + 11, 1) = Chr$(0)
End If
i% = i% + 1
Loop Until (tx.maxchrs + 1) + tx.sa + i% * tx.noa + 11 > Len(tx.m$)
End Select
Exit Sub ' ----------------------------------->
frontend:
fill$ = String$(tx.maxchrs, Chr$(0))
Mid$(fill$, 1, Len(tx.t$)) = tx.t$
Mid$(tx.m$, 1, tx.maxchrs) = fill$
Return
backend:
tx.mindex = tx.sa + (tx.maxchrs + 1) + (matrix_col% - 1) * tx.noa ' Index location in the matrix string.
Mid$(tx.m$, tx.mindex, 1) = Chr$(ft.fsn) ' Font style number chr$(1-4) 1 Reg, 2 Bold, 3 Italics, 4 Bold Italics.
Mid$(tx.m$, tx.mindex + 1, 1) = Chr$(ft.size) ' Font size.
Mid$(tx.m$, tx.mindex + 2, 1) = Chr$(_PrintWidth(b$)) ' Measures width of character typed in pixels. See index_col() for use.
Mid$(tx.m$, tx.mindex + 3, 1) = Chr$(_FontHeight) ' Height of font for the typed character.
Mid$(tx.m$, tx.mindex + 4, 1) = Chr$(cl%(1)) ' Text foreground colors _RGB32().
Mid$(tx.m$, tx.mindex + 5, 1) = Chr$(cl%(2))
Mid$(tx.m$, tx.mindex + 6, 1) = Chr$(cl%(3))
Mid$(tx.m$, tx.mindex + 7, 1) = Chr$(bc%(1)) ' Text background colors _RGB32().
Mid$(tx.m$, tx.mindex + 8, 1) = Chr$(bc%(2))
Mid$(tx.m$, tx.mindex + 9, 1) = Chr$(bc%(3))
Mid$(tx.m$, tx.mindex + 10, 1) = Chr$(tx.underline) ' chr$(1) for underline.
Rem Mid$(tx.m$, tx.mindex + 11, 1) Links are handled in a separate function.
Return
End Sub
Sub text_cursor (ft As fontvar, tx As textvar, fnum() As Long, index_col(), default_cl%(), default_bc%(), cl%())
' Local vars: temp%, temp2%, k%.
' bit state: 1 Cursor Visible, 0 Cursor Invisible.
If tx.ccol > tx.numchrs Then ' Cursor at end of text line.
If bit Then ' Show cursor.
If tx.ovr Then
Line (tx.lm + index_col(tx.ccol - 1), tx.row)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth, tx.row + ft.max_fontheight), _RGB32(0, 0, 0, 255), BF
Else
Line (tx.lm + index_col(tx.ccol - 1), tx.row + tx.c_hght - 2)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth - 2, tx.row + tx.c_hght - 2), _RGB32(default_cl%(1), default_cl%(2), default_cl%(3), 255) ' Show blinking insert cursor.
End If
Else ' Hide cursor.
If tx.ovr Then
Line (tx.lm + index_col(tx.ccol - 1), tx.row)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth, tx.row + ft.max_fontheight), _RGB32(255, 255, 255, 255), BF
Else
Line (tx.lm + index_col(tx.ccol - 1), tx.row + tx.c_hght - 2)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth - 2, tx.row + tx.c_hght - 2), _RGB32(default_bc%(1), default_bc%(2), default_bc%(3), 255) ' Hide blinking insert cursor.
End If
End If
Else ' Cursor within text.
temp% = Asc(Mid$(tx.m$, (tx.maxchrs + 1) + tx.sa + (tx.ccol - 1) * tx.noa, 1))
_Font fnum(temp%)
If bit Then ' Show cursor.
If tx.ovr Then
If Asc(Mid$(tx.m$, tx.mindex + 11, 1)) Then
tx.xl = index_col(tx.ccol - 1): tx.cchr$ = Mid$(tx.t$, tx.ccol, 1)
follow_link = 2 ' Show any links at cursor.
text_links ft, tx, follow_link, fnum(), default_bc%(), cl%()
Else
Color _RGB32(Asc(Mid$(tx.m$, tx.mindex + 7, 1)), Asc(Mid$(tx.m$, tx.mindex + 8, 1)), Asc(Mid$(tx.m$, tx.mindex + 9, 1)), 255), _RGB32(Asc(Mid$(tx.m$, tx.mindex + 4, 1)), Asc(Mid$(tx.m$, tx.mindex + 5, 1)), Asc(Mid$(tx.m$, tx.mindex + 6, 1)), 255)
_PrintString (tx.lm + index_col(tx.ccol - 1), tx.row), Mid$(tx.t$, tx.ccol, 1)
If Asc(Mid$(tx.m$, tx.mindex + 10, 1)) Or Asc(Mid$(tx.m$, tx.mindex + 11, 1)) Then Line (tx.lm + index_col(tx.ccol - 1), tx.row + tx.c_hght)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth, tx.row + ft.max_fontheight), Black
End If
Line (tx.lm + index_col(tx.ccol - 1), tx.row)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth, tx.row + ft.max_fontheight), _RGB32(Asc(Mid$(tx.m$, tx.mindex + 4, 1)), Asc(Mid$(tx.m$, tx.mindex + 5, 1)), Asc(Mid$(tx.m$, tx.mindex + 6, 1)), 0)
Else
Line (tx.lm + index_col(tx.ccol - 1), tx.row + tx.c_hght - 2)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth - 2, tx.row + tx.c_hght - 2), _RGB32(Asc(Mid$(tx.m$, tx.mindex + 4, 1)), Asc(Mid$(tx.m$, tx.mindex + 5, 1)), Asc(Mid$(tx.m$, tx.mindex + 6, 1)), 255)
End If
Else ' Hide cursor and reestablish character.
If tx.ovr Then
Color _RGB32(Asc(Mid$(tx.m$, tx.mindex + 4, 1)), Asc(Mid$(tx.m$, tx.mindex + 5, 1)), Asc(Mid$(tx.m$, tx.mindex + 6, 1)), 255), _RGB32(Asc(Mid$(tx.m$, tx.mindex + 7, 1)), Asc(Mid$(tx.m$, tx.mindex + 8, 1)), Asc(Mid$(tx.m$, tx.mindex + 9, 1)), 255)
Else
Line (tx.lm + index_col(tx.ccol - 1), tx.row + tx.c_hght - 2)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth - 2, tx.row + tx.c_hght - 2), _RGB32(Asc(Mid$(tx.m$, tx.mindex + 7, 1)), Asc(Mid$(tx.m$, tx.mindex + 8, 1)), Asc(Mid$(tx.m$, tx.mindex + 9, 1)), 255)
Color _RGB32(Asc(Mid$(tx.m$, tx.mindex + 4, 1)), Asc(Mid$(tx.m$, tx.mindex + 5, 1)), Asc(Mid$(tx.m$, tx.mindex + 6, 1)), 255), _RGB32(Asc(Mid$(tx.m$, tx.mindex + 7, 1)), Asc(Mid$(tx.m$, tx.mindex + 8, 1)), Asc(Mid$(tx.m$, tx.mindex + 9, 1)), 255)
End If
If Asc(Mid$(tx.m$, tx.mindex + 11, 1)) Then
tx.xl = index_col(tx.ccol - 1): tx.cchr$ = Mid$(tx.t$, tx.ccol, 1)
follow_link = 2 ' Show any link at cursor.
text_links ft, tx, follow_link, fnum(), default_bc%(), cl%()
Else
If tx.ccol >= Asc(Mid$(tx.m$, (tx.maxchrs + 1), 1)) And tx.ccol <= Asc(Mid$(tx.m$, (tx.maxchrs + 2), 1)) Then
Color White, Blue
End If
_PrintString (tx.lm + index_col(tx.ccol - 1), tx.row), Mid$(tx.t$, tx.ccol, 1)
If Asc(Mid$(tx.m$, tx.mindex + 10, 1)) Then Line (tx.lm + index_col(tx.ccol - 1), tx.row + tx.c_hght)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth, tx.row + ft.max_fontheight), Black
End If
If tx.ccol < tx.numchrs And tx.hl = 0 Then ' Print over second character to eliminate possibility of pixel overwritting, but pass when highlighting.
k% = (tx.maxchrs + 1) + tx.sa + (tx.ccol - 1) * tx.noa
If Asc(Mid$(tx.m$, k% + 11, 1)) Then
tx.xl = index_col(tx.ccol): tx.cchr$ = Mid$(tx.t$, tx.ccol + 1, 1)
follow_link = 2 ' Show any link at cursor.
text_links ft, tx, follow_link, fnum(), default_bc%(), cl%()
Else
temp2% = Asc(Mid$(tx.m$, k%, 1))
_Font fnum(temp2%)
Color _RGB32(Asc(Mid$(tx.m$, k% + 4, 1)), Asc(Mid$(tx.m$, k% + 5, 1)), Asc(Mid$(tx.m$, k% + 6, 1)), 255), _RGB32(Asc(Mid$(tx.m$, k% + 7, 1)), Asc(Mid$(tx.m$, k% + 8, 1)), Asc(Mid$(tx.m$, k% + 9, 1)), 255)
_PrintString (tx.lm + index_col(tx.ccol), tx.row), Mid$(tx.t$, tx.ccol + 1, 1)
If Asc(Mid$(tx.m$, k% + 10, 1)) Then Line (tx.lm + index_col(tx.ccol), tx.row + tx.c_hght)-(tx.lm + index_col(tx.ccol) + tx.c_wdth, tx.row + ft.max_fontheight), Black
End If
End If
End If
_Font fnum(ft.fsn) ' Reestablish current font.
End If
_Display
End Sub
Sub text_links (ft As fontvar, tx As textvar, follow_link, fnum() As Long, default_bc%(), cl%())
' follow_link non-zero follows the link, otherwise the link is displayed as hypertext.
' Local vars: i%, j%
Select Case follow_link
Case 1
tx.url$ = _InputBox$("Link Manager", "Link URL:")
follow_link = 0
Case 2 ' Link reprinting.
GoSub showlink
Case 3 ' Link creation.
GoSub showlink
Mid$(tx.m$, tx.maxchrs + 3, 1) = "*" ' Assign link present symbol to (3) of matric special attributes.
j% = _PrintWidth(tx.cchr$) ' Make/update a link mouse map.
Mid$(tx.map_links$, (tx.ln - 1) * _Width + tx.lm + tx.xl, j%) = String$(j%, Mid$(tx.m$, tx.mindex + 11, 1))
Case 4 ' Link Editing.
tx.url$ = _InputBox$("Link Manager", "Link URL:", tx.url$)
follow_link = 0
End Select
Exit Sub ' ---------------------------->
showlink:
_Font fnum(3) ' Use italicized font for links.
If tx.ccol >= Asc(Mid$(tx.m$, (tx.maxchrs + 1), 1)) And tx.ccol <= Asc(Mid$(tx.m$, (tx.maxchrs + 2), 1)) Then
Color White, Red ' Special highlighting over hypertext.
Else
If tx.ovr = 1 And bit = -1 And follow_link = 2 Then ' Invert colors for block cursor appearance but not when reprinting text (follow_link = 3).
Color _RGB32(Asc(Mid$(tx.m$, tx.mindex + 7, 1)), Asc(Mid$(tx.m$, tx.mindex + 8, 1)), Asc(Mid$(tx.m$, tx.mindex + 9, 1)), 255), _RGB32(Asc(Mid$(tx.m$, tx.mindex + 4, 1)), Asc(Mid$(tx.m$, tx.mindex + 5, 1)), Asc(Mid$(tx.m$, tx.mindex + 6, 1)), 255)
Else
Color _RGB32(0, 0, 200, 255), _RGB32(default_bc%(1), default_bc%(2), default_bc%(3))
End If
End If
_PrintString (tx.lm + tx.xl, tx.row), tx.cchr$
Line (tx.lm + tx.xl, tx.row + tx.c_hght)-(tx.lm + tx.xl + tx.c_wdth, tx.row + ft.max_fontheight), _RGB32(0, 0, 200, 255)
_Font fnum(ft.fsn)
Color _RGB32(cl%(1), cl%(2), cl%(3), 255), _RGB32(default_bc%(1), default_bc%(2), default_bc%(3), 255)
Return
End Sub
Sub text_buttons (tx As textvar, m As mousevar, b$)
Static initialize
' IMPORTANT: m.CursorStyle is -1 for buttons and 1 for text field.
If initialize = 0 Or tx.button_status Or Len(tx.openfile) Or tx.newproject = -1 Then
oldfont = _Font ' Do not add any EXIT SUB statements between here and where font is restored.
j% = _LoadFont("RobotoMono-regular.ttf", 14) ' Font size 14 required for proper button appearance.
k% = _LoadFont("RobotoMono-italic.ttf", 14)
a = 100: b = 30: c = 26 ' a = left margin, b = row, c = spacing between buttons.
tx.button_row = b
If tx.button_status <= 0 Then tx.map_buttons$ = String$(_Width, Chr$(0))
For i% = 1 To 8
If Asc(Mid$(tx.map_buttons$, a, 1)) > 126 Then
Line (a, b)-(a + 17, b + 17), Black, B
Line (a + 2, b + 2)-(a - 2 + 17, b - 2 + 17), _RGB32(255, 255, 255, 255), BF
Else
Line (a, b)-(a + 17, b + 17), DarkGray, B
Line (a + 2, b + 2)-(a - 2 + 17, b - 2 + 17), _RGB32(230, 230, 230, 255), BF
End If
Line (a + 17 + 1, b + 3)-(a + 17 + 2, b + 17), _RGB32(210, 210, 210, 255), BF
Line (a + 3, b + 17 + 1)-(a + 17 + 1, b + 17 + 2), _RGB32(210, 210, 210, 255), BF
a = a + c
Next
a = 100: b = 30: c = 26
_Font j%
If Asc(Mid$(tx.map_buttons$, a, 1)) > 126 Then
Color _RGB32(0, 0, 0, 255), _RGB32(255, 255, 255, 0)
Else
Color _RGB32(0, 0, 0, 255), _RGB32(230, 230, 230, 0)
End If
For i% = 1 To 8
Select Case i%
Case 1
_PrintString (a + (i% - 1) * c + 5, b + 2), "B"
Case 2
_Font k%
_PrintString (a + (i% - 1) * c + 5, b + 2), "I"
Case 3
_Font j%
_PrintString (a + (i% - 1) * c + 5, b + 1), "u"
Line (a + (i% - 1) * c + 5, b + 17 - 2)-(a + (i% - 1) * c + 13, b + 17 - 2), Black, B
Case 4
Line (a + (i% - 1) * c + 5, b + 5)-(a + (i% - 1) * c + 12, b + 17 - 5), Black, BF
Case 5
Line (a + (i% - 1) * c + 5, b + 5)-(a + (i% - 1) * c + 12, b + 17 - 5), Blue, BF
Case 6
Line (a + (i% - 1) * c + 5, b + 5)-(a + (i% - 1) * c + 12, b + 17 - 5), Red, BF
Case 7
Line (a + (i% - 1) * c + 4, b + 4)-(a + (i% - 1) * c + 14, b + 17 - 4), Yellow, BF
_PrintString (a + (i% - 1) * c + 5, b + 2), "h"
Case 8
Color Blue, _RGB32(210, 210, 210, 0)
_PrintString (a + (i% - 1) * c + 5, b + 2), "ì"
End Select
' Make mouse map.
If tx.button_status <= 0 Then
Mid$(tx.map_buttons$, a + (i% - 1) * c, c) = String$(17, Chr$(i%)) + String$(c - 17, Chr$(0))
End If
Next
If initialize = 0 Or Len(tx.openfile) Or tx.newproject = -1 Then
' Set default button.
a = tx.lm + (4 - 1) * c
Line (a, b)-(a + 17, b + 17), Black, B ' Default black text button.
Line (a + 2, b + 2)-(a - 2 + 17, b - 2 + 17), _RGB32(255, 255, 255, 0), BF
Mid$(tx.map_buttons$, tx.lm + (4 - 1) * c, c) = String$(17, Chr$(4 + 216))
initialize = -1
End If
If tx.button_status = 999 Then tx.button_status = 0 ' Hotkey action was completed. Note: Mouse completion cycle is in the text_buttons sub.
_Font oldfont
If tx.button_status > 0 Then tx.button_status = 0: Exit Sub ' Mouse button click cycle completed. Without this statement it would be an endless toggle on-off loop.
End If
If m.my >= tx.button_row And m.my <= tx.button_row + 17 Then
If Mid$(tx.map_buttons$, m.mx, 1) <> Chr$(0) Then
_MouseShow "LINK"
m.CursorStyle = -1 ' Button cursor.
Else
_MouseShow "DEFAULT": m.CursorStyle = 0
End If
ElseIf m.CursorStyle = -1 Then ' Button cursor.
_MouseShow "DEFAULT"
m.CursorStyle = 0
End If
_Display
' Button clicks and hotkey buttons...
If m.lb_status = 1 And m.CursorStyle = -1 Or tx.button_status < 0 Then ' Mouse click on button or a button hotkey.
If tx.button_status < 0 Then ' Hotkeys.
i% = Abs(tx.button_status)
tx.button_status = 999 ' Mouse or hotkey status is now ready for termination after cycle is completed.
Select Case i%
Case 999 ' Default.
For k% = 1 To 4 ' Turns off bold, italic, and underline fonts.
Mid$(tx.map_buttons$, tx.lm + (k% - 1) * 26, 17) = String$(17, Chr$(k%))
Next
tx.underline = 0
Exit Sub
Case 11
For k% = 1 To 3 ' Turns off bold and italic fonts.
Mid$(tx.map_buttons$, tx.lm + (k% - 1) * 26, 17) = String$(17, Chr$(k%))
Next
' Turns on bold font.
Mid$(tx.map_buttons$, tx.lm + (1 - 1) * 26, 17) = String$(17, Chr$(1 + 126))
Exit Sub
Case 12
For k% = 1 To 3 ' Turns off bold and italic fonts.
Mid$(tx.map_buttons$, tx.lm + (k% - 1) * 26, 17) = String$(17, Chr$(k%))
Next
' Turns on italic font.
Mid$(tx.map_buttons$, tx.lm + (2 - 1) * 26, 17) = String$(17, Chr$(2 + 126))
Exit Sub
Case 22 ' Bold and Italic.
For k% = 1 To 2 ' Turns on bold and italic. Turns off underline.
Mid$(tx.map_buttons$, tx.lm + (k% - 1) * 26, 17) = String$(17, Chr$(k% + 126))
Next
Mid$(tx.map_buttons$, tx.lm + (3 - 1) * 26, 17) = String$(17, Chr$(3))
tx.underline = 0
Exit Sub
Case Else ' F5 - F9
If Asc(Mid$(tx.map_buttons$, tx.lm + (i% - 1) * 26, 1)) > 126 Then
tx.button_status = 0 ' The same key was pressed again or is being held down so it gets ignored here.
Exit Sub
End If
j% = i% + 126 ' Turn button on.
End Select
Else ' Mouse click on a button.
' Button toggle routine.
i% = Asc(Mid$(tx.map_buttons$, m.mx, 1))
If i% > 126 Then ' Button turned off.
i% = i% - 126 ' Locates 1-8 position on map.
j% = i% ' Assigns ascii character to map.
Else ' Button turned on.
j% = i% + 126
End If
tx.button_status = j% ' Controls program flow through the button routine.
End If
Select Case i%
Case 1 ' Bold font on.
Mid$(tx.map_buttons$, tx.lm + (i% - 1) * 26, 17) = String$(17, Chr$(j%))
If j% > 126 Then
If Asc(Mid$(tx.map_buttons$, tx.lm + (2 - 1) * 26, 1)) < 127 Then
m.mousekey$ = Chr$(0) + Chr$(60) ' Bold.
Else
m.mousekey$ = Chr$(0) + Chr$(62) ' Bold + Italic
End If
Else ' Bold font off.
If Asc(Mid$(tx.map_buttons$, tx.lm + (2 - 1) * 26, 1)) > 126 Then
m.mousekey$ = Chr$(0) + Chr$(61) ' Italic.
Else
m.mousekey$ = Chr$(0) + Chr$(59) ' Regular.
End If
End If
Case 2 ' Italic font on.
Mid$(tx.map_buttons$, tx.lm + (i% - 1) * 26, 17) = String$(17, Chr$(j%))
If j% > 126 Then
If Asc(Mid$(tx.map_buttons$, tx.lm + (1 - 1) * 26, 1)) < 127 Then
m.mousekey$ = Chr$(0) + Chr$(61) ' Italic.
Else
m.mousekey$ = Chr$(0) + Chr$(62) ' Bold + Italic.
End If
Else ' Italic font off.
If Asc(Mid$(tx.map_buttons$, tx.lm + (1 - 1) * 26, 1)) > 126 Then
m.mousekey$ = Chr$(0) + Chr$(60) ' Bold.
Else
m.mousekey$ = Chr$(0) + Chr$(59) ' Regular.
End If
End If
Case 3 ' Underline on.
Mid$(tx.map_buttons$, tx.lm + (i% - 1) * 26, 17) = String$(17, Chr$(j%))
m.mousekey$ = Chr$(0) + Chr$(63) ' Underline on/off. It's a togggle.
Case 4, 5, 6 ' Color font.
If Asc(Mid$(tx.map_buttons$, tx.lm + (i% - 1) * 26, 1)) < 127 Then ' Radio style buttons.
For k% = 4 To 7 ' Turns highlighting off, too.
Mid$(tx.map_buttons$, tx.lm + (k% - 1) * 26, 17) = String$(17, Chr$(k%))
Next
m.mousekey$ = Chr$(0) + Chr$(60 + i%) ' Colors F6-F8
Else
m.mousekey$ = Chr$(0) + Chr$(64) ' F6 Default black.
Mid$(tx.map_buttons$, tx.lm + (4 - 1) * 26, 17) = String$(17, Chr$(4 + 126))
End If
Mid$(tx.map_buttons$, tx.lm + (i% - 1) * 26, 17) = String$(17, Chr$(j%))
Case 7 ' Highlighting on.
If Asc(Mid$(tx.map_buttons$, tx.lm + (i% - 1) * 26, 1)) < 127 Then
If Asc(Mid$(tx.map_buttons$, tx.lm + (4 - 1) * 26, 1)) > 126 Then
tx.prior_colorHL = 4
ElseIf Asc(Mid$(tx.map_buttons$, tx.lm + (5 - 1) * 26, 1)) > 126 Then
tx.prior_colorHL = 5
Else
tx.prior_colorHL = 6
End If
For k% = 4 To 6
Mid$(tx.map_buttons$, tx.lm + (k% - 1) * 26, 17) = String$(17, Chr$(k%))
Next
m.mousekey$ = Chr$(0) + Chr$(67) ' F9 highlighting.
Else ' Highlighting off.
m.mousekey$ = Chr$(0) + Chr$(60 + tx.prior_colorHL) ' Restore prior color.
Mid$(tx.map_buttons$, tx.lm + (tx.prior_colorHL - 1) * 26, 17) = String$(17, Chr$(tx.prior_colorHL + 126))
End If
Mid$(tx.map_buttons$, tx.lm + (i% - 1) * 26, 17) = String$(17, Chr$(j%))
Case 8 ' Link. (Make when non-linked and follow when linked).
a = tx.lm + (i% - 1) * 26: b = 30
Line (a, b)-(a + 17, b + 17), Black, B: _Display
_Delay .15
Line (a, b)-(a + 17, b + 17), DarkGray, B: _Display
_Delay .15
m.mousekey$ = Chr$(0) + Chr$(133)
End Select
If tx.button_status < 0 Then m.mousekey$ = "": b$ = "" ' Button press was already completed by keyboard entry.
End If
End Sub
Sub popup_main (ft As fontvar, tx As textvar, m As mousevar, pop As popup)
Static menu_item$(), popfont, oldfont
If tx.button_status Then Exit Sub ' Button routines do not require popups.
Do ' Falx loop.
Select Case pop.status
Case 0
If m.rb_status = 1 Then pop.status = 1 ' Initiate popup from right mouse click.
Exit Sub
Case 1
pop.status = -1 ' Popup event started
PCopy _Display, 1 ' Change display to popup.
If pop.setup = 0 Then
pop.setup = -1
oldfont = _Font
$Color:32
ft.size = 16
popfont = _LoadFont("RobotoMono-regular.ttf", ft.size)
If popfont <= 0 Then ' Try to load the Windows Lucida Console font.
popfont = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", ft.size)
End If
If popfont <= 0 Then
popfont = 16
End If
End If
_Font popfont
pop.chr_wdth = _PrintWidth("A")
pop.chr_hght = _FontHeight
Select Case m.CursorStyle
Case 0
Restore popdata
Case 1
Restore popdata2
End Select
ReDim menu_item$(0): pop.nmi = 0
Do
Read temp$
If LCase$(temp$) = "eof" Then Exit Do
pop.nmi = pop.nmi + 1
ReDim _Preserve menu_item$(pop.nmi)
menu_item$(pop.nmi) = temp$
Loop
temp$ = ""
' Draw popup window.
pop.pbgcolor = 240
pop.pbbxcolor = 190
pop.pbshdcolor = 86
pop.phght = 2 * pop.nmi * pop.chr_hght
pop.pwdth = pop.chr_wdth * 16
pop.pc1 = m.mx + 1: If pop.pc1 + pop.pwdth > _Width - 5 Then pop.pc1 = _Width - 5 - pop.pwdth
pop.pr1 = m.my + 1: If pop.pr1 + pop.phght > _Height - 5 Then pop.pr1 = _Height - 5 - pop.phght
pop.pc2 = pop.pc1 + pop.pwdth
pop.pr2 = pop.pr1 + pop.phght
Line (pop.pc1, pop.pr1)-(pop.pc2, pop.pr2), _RGB32(pop.pbbxcolor, pop.pbbxcolor, pop.pbbxcolor, 255), B
Line (pop.pc1 + 1, pop.pr1 + 1)-(pop.pc2 - 1, pop.pr2 - 1), _RGB32(255, 255, 255, 255), B
Line (pop.pc1 + 2, pop.pr1 + 2)-(pop.pc2 - 2, pop.pr2 - 2), _RGB32(pop.pbgcolor, pop.pbgcolor, pop.pbgcolor, 255), BF
Line (pop.pc2 + 1, pop.pr1 + 7)-(pop.pc2 + 1, pop.pr2 + 0), _RGB32(pop.pbshdcolor, pop.pbshdcolor, pop.pbshdcolor, 180)
Line (pop.pc2 + 2, pop.pr1 + 7)-(pop.pc2 + 2, pop.pr2 + 0), _RGB32(pop.pbshdcolor, pop.pbshdcolor, pop.pbshdcolor, 180)
Line (pop.pc1 + 5, pop.pr2 + 1)-(pop.pc2 + 2, pop.pr2 + 1), _RGB32(pop.pbshdcolor, pop.pbshdcolor, pop.pbshdcolor, 180)
Line (pop.pc1 + 5, pop.pr2 + 2)-(pop.pc2 + 2, pop.pr2 + 2), _RGB32(pop.pbshdcolor, pop.pbshdcolor, pop.pbshdcolor, 180)
pop.col_matrix = String$(_Width, Chr$(0)): pop.row_matrix = pop.col_matrix
popup_restrict tx, m, pop
j% = 2
For i% = 1 To pop.nmi
Mid$(pop.col_matrix, pop.pc1, pop.pwdth) = String$(pop.pwdth, "*")
Mid$(pop.row_matrix, pop.pr1 + pop.chr_hght \ 2 + ((i% - 1) * pop.chr_hght * 2)) = String$(pop.chr_hght, Chr$(i%))
If Mid$(pop.restrict, i%, 1) = "*" Then
Color _RGB32(150, 150, 150, 190), _RGB32(pop.pbgcolor, pop.pbgcolor, pop.pbgcolor, 255)
Else
Color _RGB32(0, 0, 0, 190), _RGB32(pop.pbgcolor, pop.pbgcolor, pop.pbgcolor, 255)
End If
_PrintString (pop.pc1 + pop.chr_wdth * 2, pop.pr1 + pop.chr_hght \ 2 + ((i% - 1) * pop.chr_hght * 2)), menu_item$(i%)
Next
Color _RGB32(230, 190), _RGB32(230, 190)
For i% = 1 To pop.nmi - 1
Line (pop.pc1 + pop.chr_wdth * 2, pop.pr1 + i% * pop.chr_hght * 2)-(pop.pc2 - pop.chr_wdth * 2, pop.pr1 + i% * pop.chr_hght * 2), _RGB32(200, 255)
Next
Exit Do
Case -1
popup_engine m, pop, menu_item$()
_Display
If pop.status = -1 Then Exit Do ' If status changed, go around loop again.
Case 2 ' Close popup occurs here.
popup_engine m, pop, menu_item$() ' Only to clear variables.
pop.status = 0
_Font oldfont
PCopy 1, _Display ' Popup is now closed. Restores underlying screen.
_Display
Exit Do
End Select
Loop
popdata:
Data Cut
Data Copy
Data Paste
Data Delete
Data Select All
Data Hyperlink
Data eof
popdata2:
Data Edit Link
Data eof
End Sub
Sub popup_engine (m As mousevar, pop As popup, menu_item$())
Static c1, r1, c2, r2, oldmenu_item%
If pop.status = 2 Then ' Clear static and matrix variables then exit to close popup.
c1 = 0: c2 = 0: r1 = 0: r2 = 0: oldmenu_item% = 0: pop.col_matrix$ = "": pop.row_matrix$ = ""
Exit Sub
End If
If pop.status = 0 Then Exit Sub
If m.mx < pop.pc1 Or m.mx > pop.pc2 Or m.my < pop.pr1 Or m.my > pop.pr2 Then ' Mouse is outside of popup window.
If m.lb_status = 1 Then pop.status = 2: Exit Sub ' Left click outside of popup will close window.
If m.rb_status = 1 Then m.rb_status = -1: pop.status = 2: Exit Sub ' Right click outside of popup will close wndow.
If oldmenu_item% Then
If m.mx < pop.pc1 Or m.mx > pop.pc2 Or m.my < pop.pr1 Or m.my > pop.pr2 Then
GoSub remove_prior_menu_item_highlighting
End If
End If
Else ' Mouse is inside popup window.
If m.rb_status Then m.rb_status = 0: Exit Sub ' Disables right mouse click insdie menu.
If Mid$(pop.col_matrix, m.mx + 1, 1) = "*" And Mid$(pop.row_matrix, m.my + 1, 1) <> Chr$(0) Then
menu_item% = Asc(Mid$(pop.row_matrix, m.my + 1, 1))
If menu_item% <> oldmenu_item% Or m.lb_status = 1 Then
Select Case m.lb_status
Case -1: Exit Sub ' Do not repeat until mouse button is released.
Case 1: If m.lb_status = 1 Then m.lb_status = -1
End Select
h% = _InStrRev(m.mx, pop.col_matrix, Chr$(0)) + 1
temp$ = Mid$(pop.col_matrix, h%)
temp$ = Mid$(temp$, 1, InStr(temp$, Chr$(0)) - 1)
i% = Len(temp$)
j% = _InStrRev(m.my, pop.row_matrix, Chr$(0)) + 1
temp$ = Mid$(pop.row_matrix, j%)
temp$ = Mid$(temp$, 1, InStr(temp$, Chr$(0)) - 1)
k% = Len(temp$)
GoSub remove_prior_menu_item_highlighting
c1 = h% + pop.chr_wdth \ 2
r1 = j% - pop.chr_hght \ 4
c2 = h% + i% - pop.chr_wdth \ 2
r2 = j% + k% + pop.chr_hght \ 4
If m.lb_status = -1 Then _Display: _Delay .1
If Mid$(pop.restrict, menu_item%, 1) = "*" Then
Line (c1, r1)-(c2, r2), _RGB32(190, 190, 190, 255), BF
Color _RGB32(150, 150, 150, 190), _RGB32(190, 190, 190, 255)
Else
Line (c1, r1)-(c2, r2), _RGB32(0, 170, 250, 255), BF
Color _RGB32(0, 0, 0, 190), _RGB32(0, 170, 250, 255)
End If
_PrintString (pop.pc1 + pop.chr_wdth * 2, pop.pr1 + pop.chr_hght \ 2 + ((menu_item% - 1) * pop.chr_hght * 2)), menu_item$(menu_item%)
If m.lb_status = -1 Then
popup_select m, menu_item%
pop.status = 2 ' Close popup.
oldmenu_item% = 0
Exit Sub
End If
oldmenu_item% = menu_item%
End If
End If
End If
Exit Sub '-------------------------------->
remove_prior_menu_item_highlighting:
If c1 Then Line (c1, r1)-(c2, r2), _RGB32(pop.pbgcolor, 255), BF
If Mid$(pop.restrict, oldmenu_item%, 1) = "*" Then
Color _RGB32(150, 150, 150, 190), _RGB32(pop.pbgcolor, pop.pbgcolor, pop.pbgcolor, 255)
Else
Color _RGB32(0, 0, 0, 190), _RGB32(pop.pbgcolor, pop.pbgcolor, pop.pbgcolor, 255)
End If
_PrintString (pop.pc1 + pop.chr_wdth * 2, pop.pr1 + pop.chr_hght \ 2 + ((oldmenu_item% - 1) * pop.chr_hght * 2)), menu_item$(oldmenu_item%)
Return
End Sub
Sub popup_restrict (tx As textvar, m As mousevar, pop As popup)
pop.restrict = Space$(pop.nmi) ' Matrix for cut/copy/paste/delete/select all/hyperlink. Places an * in the string at the position of the menu item.
If m.CursorStyle = 1 Then ' +1 Hand cursor for links. Note: -1 is for buttons.
pop.restrict = ""
Else
If tx.hl = 0 Then pop.restrict = "** * *"
If _Clipboard$ = "" Then Mid$(pop.restrict, 3, 1) = "*"
If Mid$(tx.t$, 1, 1) = Chr$(0) Then Mid$(pop.restrict, 5, 1) = "*" ' No text so no select all.
End If
End Sub
Sub popup_select (m As mousevar, menu_item%)
Select Case m.CursorStyle
Case 0
Select Case menu_item%
Case 1
m.mousekey$ = Chr$(24) ' Cut.
Case 2
m.mousekey$ = Chr$(3) ' Copy.
Case 3
m.mousekey$ = Chr$(22) ' Paste.
Case 4
m.mousekey$ = Chr$(0) + "S" ' Delete.
Case 5
m.mousekey$ = Chr$(1) ' Select All.
Case 6
m.mousekey$ = Chr$(0) + Chr$(133) ' Link.
End Select
Case 1
m.mousekey$ = "Edit Link"
End Select
End SubPete
- 5 out of 6 Russians recommend Russian Roulette to their gamblers who play Russian Roulette.
![[Image: Textversuche.jpg]](https://i.ibb.co/WP4kcGK/Textversuche.jpg)
![[Image: 29221194-ein-gro%C3%9Fer-grill-mit-versc...eladen.jpg]](https://previews.123rf.com/images/hemeroskopion/hemeroskopion1406/hemeroskopion140600169/29221194-ein-gro%C3%9Fer-grill-mit-verschiedenen-fleisch-geladen.jpg)
