04-12-2024, 02:10 AM
Well this is what I came up with to work in fonts of differing heights. Click any of the 12 randomly generated text lines to move the cursor to the beginning of that line.
So to get it working in the project, I need to make a text line array, slightly change the cursor subroutine, and get the Enter key to work like a text editor. Beyond that is vertical scrolling when more lines are added than fits the page.
Pete
Code: (Select All)
$Color:32
Screen _NewImage(1100, 600, 32)
_Display ' Turn off autodisplay.
Color Black, _RGB32(255, 255, 255, 255)
Cls
_Delay .1
_ScreenMove _Middle
_Delay .1
_Clipboard$ = ""
Type textvar
redo As Integer
initiate As Integer ' -1 Indicates the Subroutine has been Initiated.
nof As Integer ' Number of Fonts.
maxchrs As Integer ' The Max Characters of a Text String. IMPORTANT: Cannot be over 255.
fsn As Integer ' Font Selection Number 1 reg, 2 Bold, 3 Italic, 4 Bold Italic.
noa As Integer ' Number of Text Attributes.
lm As Integer ' Left Margin by Pixel.
row As Integer ' Row by Pixel.
rm As Integer ' Right Margin by Pixel.
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.
fsize As Integer ' Font Size.
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.
linkmap As String ' Maps Pixels for Link ID with Mouse.
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.
mouse_button1_row As Integer
button1 As Integer
hold_highlight As Integer
maxhgt As Integer ''''''''''''
tm As Integer
tcopy As String ' Copied Text
mcopy As String ' Copied Text Matrix
button_map1 As String
End Type
Dim tx As textvar
Type mousevar
mx As Integer
my As Integer
wh As Integer
lb As Integer
rb As Integer
lb_status As Integer
rb_status As Integer
oldmx As Integer
CursorStyle As Integer
mousekey As String ' Auto Keyboard Input.
End Type
Dim m As mousevar
Dim Shared bit As _Bit
ReDim Shared cl(3) As Integer, bc(3) As Integer
ReDim Shared default_cl(3), default_bc(3)
tx.nof = 4
tx.fsize = 18
tx.maxchrs = 30 ' IMPORTANT: Cannot be over 255.
ReDim Shared fnum(tx.nof) As Long
ReDim Shared index_col(tx.maxchrs)
default_cl(1) = 0: default_cl(2) = 0: default_cl(3) = 0
default_bc(1) = 255: default_bc(2) = 255: default_bc(3) = 255
tx.fsn = 1 ' Default font style number.
tx.noa = 12 ' Number of character attributes.
''''tx.row = 100 ' Current row in pixels.
tx.lm = 100 ' Left margin in pixels. RIGHT MARGIN is assigned in SKIN subroutine.
tx.sa = 10 ' Number of special attributes.
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)
tx.tm = 100 ' Top margin '''''''''''''''''
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.
tx.linkmap$ = String$(_Width, Chr$(0))
' Matrix: 1-maxchrs text, maxchrs + 1 to maxchrs + 10 Special attributes, maxchrs + 11 on are attributes each tx.noa spaces long.
' Example: 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.
f = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 18)
g = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 22)
h = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 26)
_Font f
y = 100
noa = 2
v$ = String$(_Height, Chr$(0))
tx.ccol = 1
tx.c_wdth = 12
tx.row = tx.tm
For ii = 1 To 12
a$ = "": tx.maxhgt = 0
m$ = String$(500, Chr$(0))
For i = 1 To 30
a$ = a$ + Chr$(Rnd * 25 + 65)
Next
For i = 1 To Len(a$)
c$ = Mid$(a$, i, 1)
_Font f
If Int(Rnd * 8) = 3 Then _Font h
If Int(Rnd * 15) = 3 Then _Font g
If _FontHeight > tx.maxhgt Then tx.maxhgt = _FontHeight
Mid$(m$, 256 + 3, 1) = Chr$(tx.maxhgt)
Mid$(m$, i, 1) = c$
Mid$(m$, 266 + 0 + (i - 1) * noa, 1) = Chr$(_PrintWidth(c$))
Mid$(m$, 266 + 1 + (i - 1) * noa, 1) = Chr$(_FontHeight)
j = j + _PrintWidth(c$)
Next
j = 0
tx.maxhgt = Asc(Mid$(m$, 256 + 3, 1))
For i = 1 To Len(a$)
c$ = Mid$(m$, i, 1)
k = Asc(Mid$(m$, 266 + 1 + (i - 1) * noa, 1))
Select Case k
Case 18: _Font f
Case 22: _Font g
Case 26: _Font h
End Select
_PrintString (y + j, tx.row + tx.maxhgt - k), c$: _Display
j = j + Asc(Mid$(m$, 266 + 0 + (i - 1) * noa, 1))
Next
Mid$(v$, tx.row + 1, tx.maxhgt) = String$(tx.maxhgt, Chr$(ii))
If ii < 12 Then tx.row = tx.row + 6 + tx.maxhgt
Next
Do
Locate 1, 620: Print m.my; " "; ln; " ";: _Display
mouse m
If Mid$(v$, m.my, 1) <> Chr$(0) Then _MouseShow "LINK" Else _MouseShow "DEFAULT"
If m.lb_status = 1 Then
bit = 0: text_cursor tx: bit = -1
ln = Asc(Mid$(v$, m.my + 1))
tx.row = InStr(v$, Chr$(ln)) - 1
End If
If Timer > cc! Then
cc! = Timer + .25: If cc! > 86400 Then cc! = .25
text_cursor tx
bit = bit Xor 1
End If
Loop
Sub mouse (m As mousevar)
' Local vars: i%,j%
If Len(m.mousekey$) And m.lb_status <> 2 Then Exit Sub ' Bypass mouse when an automatic key was issued unless a drag event is occurring.
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 on initial button press.
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.
Case 0
m.lb_status = 1
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 -1
m.rb_status = 0 ' An event occurred and the button was released.
Case 0
' Button has not been pressed yet.
Case 1
m.rb_status = 0 ' Button was released wth no event occurring.
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
Case 1
' The button is still down but no event occurred.
End Select
End Select
m.oldmx = m.mx
End Sub
Sub text_cursor (tx As textvar)
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 + tx.maxhgt), _RGB32(0, 0, 0, 255), BF
Else
Line (tx.lm + index_col(tx.ccol - 1), tx.row + tx.maxhgt - 2)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth - 2, tx.row + tx.maxhgt - 2), _RGB32(default_cl(1), default_cl(2), default_cl(3), 255) ' Show blinking insert cursor.
End If
Else ' Hide cursor.
Line (tx.lm + index_col(tx.ccol - 1), tx.row + tx.maxhgt - 2)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth - 2, tx.row + tx.maxhgt - 2), _RGB32(default_bc(1), default_bc(2), default_bc(3), 255) ' Hide blinking insert cursor.
End If
_Display
End SubSo to get it working in the project, I need to make a text line array, slightly change the cursor subroutine, and get the Enter key to work like a text editor. Beyond that is vertical scrolling when more lines are added than fits the page.
Pete