10-24-2025, 08:55 PM
I found many small bugs in the program, so here’s the updated version. The marked text in 256-color mode is now easy to read, and mode 0 (the last function parameter), which should only display character 249 instead of the actual text, now works properly. I need it for another program, and I realized I had to fix this one first.
Code: (Select All)
'repaired use with Mode 0 and more small (but visible) repairs
'Done:
'Supported doubleclick for end function
'Supported Insert key
'Supported BackSpace key
'Supported bordering with LINE
'Supported Home and End keys
'Supported Delete key
'Support deleting selected area using BackSpace
'repaired text lenght (now is as LENGHT paramater (in characters))
'repaired delete and backspace string deleting if part of the text is selected (add condition above)
'Supported copying selected text to clipboard
'Supported for inserting text from clipboard (3 methods):
' -insert clipboard string to middle the string if cursor is in middle and nothing is slected
' -insert clipboard string to the end the string if cursor is at the end
' -delete selected area and insert clipboard string to this area in string
'Supported cursor position set in text with mouse
'Supported Shift + Home and Shift + End text selecting
'Supported text selecting with mouse
'can be used for 8 bit and 32 bit screens (both tested)
Dim Shared INSERT
Screen _NewImage(1024, 768, 256)
Cls
'inputString$ = Cursor$(500, 400, 25, 1, _RGB32(255), 2) '32 bit - try set box (4th) parameter to zero. Then is possible using this to blank form.
InputString$ = Cursor$(50, 100, 25, 1, 7, 1) '8 bit - before test this, do not forgot change SCREEN to 256 colors
Print "InputString$ value: "; InputString$
End
Function Cursor$ (Xs, Ys, Lenght, Box, BoxColor~&, Mode)
Static Active, C$, Selected, SelectStart, SelectEnd, OldK$, OGPos, OmPos, LB
'function create cursor on selected position with expected behavior
'Xs - left upper x corner
'Ys - left upper y corner
'Lenght - how lenght string is expected (in characters)
'Box - draw box (Line, B) around? 0 = No, 1 = Yes
'BoxColor~& - if Box is allowed, so Box color
'Mode - print characters to screen (1, 2) or not (0) - then it print CHR$(249). 1 Print cursor as "_", 2 Print it as "ł"
Bck~& = _CopyImage(0)
GLen = Lenght * _FontWidth 'maximal text lenght in pixels
If Gpos = 0 Then Gpos = Xs 'cursor graphics position (X axis)
Dim As _Unsigned Long OnCursorColor, OffCursorColor, SelectColor
Select Case _PixelSize
Case 1
If Box Then Line (Xs - 5, Ys - 5)-(Xs + GLen, Ys + _FontHeight + 5), BoxColor~&, B
OnCursorColor = 15
OffCursorColor = 0
SelectColor = 68
Case 4
If Box Then Line (Xs - 5, Ys - 5)-(Xs + GLen, Ys + _FontHeight + 5), BoxColor~&, B
OnCursorColor = _RGB32(255)
OffCursorColor = _RGB32(0)
SelectColor = _RGBA32(255, 255, 0, 150)
End Select
Do Until Done
While _MouseInput
Wend
MX = _MouseX
MY = _MouseY
LB = _MouseButton(1)
'click to the cursor's area and activate it until you press enter or escape
If MX >= Xs And MX <= Xs + GLen Then
If MY >= Ys And MY <= Ys + _FontHeight Then
_MouseShow "text"
'click twice and function return output and end
If LB = -1 Then
If Active Then
If OmPos = 0 Then 'function can not exit when mouse select text
If Timer - t < .3 Then
Cursor$ = C$
Exit Function
End If
End If
End If
Active = 1
'calculate graphic cursor position
If Gpos = 0 Then Gpos = Xs + Len(C$) * _FontWidth 'default
If OmPos = 0 Then
'can not use cursor GPOS value here, because mouse use own coordinate
chars = (MX - Xs) \ _FontWidth
OmPos = chars * _FontWidth + Xs
If OmPos < Xs Then OmPos = Xs
If OmPos > Xs + _PrintWidth(C$) Then OmPos = Xs + _PrintWidth(C$)
'lock default cursor position for mouse selecting
End If
'zde posledni vklad: oznacit text mysi
If Abs(OmPos - Gpos) > _FontWidth \ 2 Then 'if track with mouse is minimal 1 character, select this area
mSelected = 1
SelectStart = OmPos
chars = (MX - Xs) \ _FontWidth
SelectEnd = chars * _FontWidth + Xs
If SelectEnd < Xs Then SelectEnd = Xs
If SelectEnd > Xs + _PrintWidth(C$) Then SelectEnd = Xs + _PrintWidth(C$)
Selected = mSelected
End If
'here - calculate the position for the possibility to set the position of the cursor by clicking in the text
If Len(C$) Then
If MX > Xs + _PrintWidth(C$) Then Gpos = Xs + _PrintWidth(C$)
If MX < Xs Then Gpos = Xs
If MX > Xs And MX < Xs + _PrintWidth(C$) Then
'calculate pixels from Xs
chars = (MX - Xs) \ _FontWidth
Gpos = Xs + chars * _FontWidth
End If
End If
t = Timer
If OmPos = 0 Then ResetLB
Else
OmPos = 0 'reset mouse graphic cursor position used for text selecting
If mSelected = 1 Then
mSelected = 0
End If
End If
End If
End If
'move to other area and deactivate cursor without function output
If MX >= Xs And MX <= Xs + GLen and_
MY >= Ys And MY <= Ys + _FontHeight Then_
_mouseshow "text" else _mouseshow "default"
'text insert is possible until is not clicked to other location
If MX < Xs or MX > Xs + GLen and_
MY < Ys - 20 or MY > Ys + _FontHeight and_
LB = -1 then Active = 0
Select Case Active
Case 0
_PrintMode _FillBackground
Case 1
_PrintMode _KeepBackground
k$ = InKey$
If Len(k$) Then
Select Case Asc(k$)
Case 31 To 127 ' string is created with text
If Gpos - Xs = _PrintWidth(C$) Then 'add character this way if cursor is on the end of the string only
If Len(C$) < Lenght - 1 Then C$ = C$ + k$
Selected = 0
Else ' ' add character inside string if cursor is inside
If INSERT Then 'ok
T1$ = Left$(C$, (Gpos - Xs) \ _FontWidth) ' the left part of the string
T2$ = Right$(C$, Len(C$) - Len(T1$) - 1) ' right part of the string
C$ = T1$ + k$ + T2$
If Len(C$) > Lenght - 1 Then C$ = Mid$(c$1, 1, Lenght - 1)
Else
T1$ = Left$(C$, (Gpos - Xs) \ _FontWidth) 'the left part of the string
T2$ = Right$(C$, Len(C$) - Len(T1$)) ' right part of the string
If Len(C$) < Lenght - 1 Then C$ = T1$ + k$ + T2$
End If
End If
If Gpos < Xs + (Lenght - 1) * _FontWidth Then Gpos = Gpos + _FontWidth
Case 13 ' enter end function and return string
Cursor$ = C$
Selected = 0
Gpos = 0
Exit Function
Case 27 ' escape end function and return empty string
Cursor$ = ""
Selected = 0
Gpos = 0
Exit Function
Case 8 ' backspace
If Len(C$) > 0 And Selected = 0 Then
If Gpos = Xs Then _Continue
T1$ = Left$(C$, (Gpos - Xs) \ _FontWidth - 1) 'the left part of the string
T2$ = Right$(C$, Len(C$) - Len(T1$) - 1) 'right part of the string
C$ = T1$ + T2$
Gpos = Gpos - _FontWidth
If Gpos < Xs Then Gpos = Xs
End If
'condition for text select
If Selected Then
StringStart = (SelectStart - Xs) \ _FontWidth
StringEnd = (SelectEnd - Xs) \ _FontWidth
If StringStart > StringEnd Then Swap StringStart, StringEnd
'delete selected area in string
T1$ = Mid$(C$, 1, StringStart)
T2$ = Mid$(C$, StringEnd + 1, Len(C$))
C$ = T1$ + T2$
If Gpos > Xs + _PrintWidth(C$) Then Gpos = Xs + _PrintWidth(C$)
End If
Case 22 'Ctrl + V
' if none text is marked and the cursor is at the end, the input is added to the end of the string
' if the text is not marked and the cursor is in the middle of the text, the insert is inserted between
' if the text is marked, the marked part is deleted and overwritten with an insert (inserted between)
If Selected = 0 Then
If Gpos = Xs + _PrintWidth(C$) Then
C$ = C$ + _Clipboard$
If Len(C$) > Lenght Then C$ = Mid$(C$, 1, Lenght): Gpos = _PrintWidth(C$) 'insert clipboard to end if is cursor at the end
Else
T1$ = Mid$(C$, 1, (Gpos - Xs) \ _FontWidth) 'insert clipboard middle to text (to cursor position)
T2$ = Mid$(C$, 1 + (Gpos - Xs) \ _FontWidth, Len(C$))
C$ = T1$ + LTrim$(_Clipboard$) + T2$
If Len(C$) > Lenght Then C$ = Mid$(C$, 1, Lenght)
End If
Else 'part in text is selected - delete inserted part and place to this place clipboard
'test ok
StringStart = (SelectStart - Xs) \ _FontWidth
StringEnd = (SelectEnd - Xs) \ _FontWidth
If StringStart > StringEnd Then Swap StringStart, StringEnd
'delete selected area in string
T1$ = Mid$(C$, 1, StringStart)
T2$ = Mid$(C$, StringEnd + 1, Len(C$))
C$ = T1$ + _Clipboard$ + T2$
If Len(C$) > Lenght Then C$ = Mid$(C$, 1, Lenght)
If Gpos > Xs + _PrintWidth(C$) Then Gpos = Xs + _PrintWidth(C$)
End If
Case 3 'Ctrl + C 'this copy selected text to clipboard
StringStart = (SelectStart - Xs) \ _FontWidth
StringEnd = (SelectEnd - Xs) \ _FontWidth
If StringStart > StringEnd Then Swap StringStart, StringEnd
_Clipboard$ = Mid$(C$, StringStart + 1, StringEnd - StringStart) 'bug repaired
End Select
If Len(k$) > 1 Then
Select Case Asc(k$, 2)
Case 75 'left arrow
Gpos = Gpos - _FontWidth
If Gpos < Xs + 1 Then Gpos = Xs + 1
If _KeyDown(100303) = 0 And _KeyDown(100304) = 0 Then
OGPos = 0 'Shift + Home; Shift + End reset (OGpos is previous cursor GPOS graphics variable)
Selected = 0
SelectStart = 0
SelectEnd = 0
Else
Selected = 1
If SelectStart = 0 Then
SelectStart = Gpos + _FontWidth
If SelectStart < Xs + 1 Then SelectStart = Xs + 1
End If
SelectEnd = Gpos
End If
Case 77 'right arrow
Gpos = Gpos + _FontWidth
If Gpos > Xs + _PrintWidth(C$) Then Gpos = Xs + _PrintWidth(C$)
If _KeyDown(100303) = 0 And _KeyDown(100304) = 0 Then
OGPos = 0 'Shift + Home; Shift + End reset
Selected = 0
SelectStart = 0
SelectEnd = 0
Else
Selected = 1
If SelectStart = 0 Then
SelectStart = Gpos - _FontWidth
If SelectStart > Xs + _PrintWidth(C$) Then SelectStart = Xs + _PrintWidth(C$)
End If
SelectEnd = Gpos
End If
Case 82
INSERT = Not INSERT 'text insert switch
Case 83 'Delete
If Len(C$) > 0 And Selected = 0 Then
T1$ = Left$(C$, (Gpos - Xs) \ _FontWidth) 'the left part of the string
T2$ = Right$(C$, Len(C$) - Len(T1$) - 1) 'right part of the string
C$ = T1$ + T2$
End If
If Selected Then
StringStart = (SelectStart - Xs) \ _FontWidth
StringEnd = (SelectEnd - Xs) \ _FontWidth
If StringStart > StringEnd Then Swap StringStart, StringEnd
'delete selected area in string
T1$ = Mid$(C$, 1, StringStart)
T2$ = Mid$(C$, StringEnd + 1, Len(C$))
C$ = T1$ + T2$
Gpos = SelectStart
If Gpos > Xs + _PrintWidth(C$) Then Gpos = Xs + _PrintWidth(C$)
Selected = 0
End If
Case 71 'Home key
If OGPos = 0 Then OGPos = Gpos
Gpos = Xs
Case 79 'End key
If OGPos = 0 Then OGPos = Gpos
Gpos = Xs + _PrintWidth(C$)
End Select
End If
End If 'If LEN (K$) condition
'select mode for selecting part of the text
kj& = _KeyDown(100304) 'lshift
kk& = _KeyDown(100303) 'rshift
If Len(k$) Then OldK$ = k$
If kk& = -1 Or kj& = -1 Then
If Len(OldK$) = 2 Then
If Asc(OldK$, 2) = 77 Or Asc(OldK$, 2) = 75 Then 'if is arrow and shift pressed
Selected = 1
If SelectStart = 0 Then SelectStart = Gpos 'here its in graphical coordinates
SelectEnd = Gpos
End If
End If
End If
If Len(k$) = 1 Then 'reset selected area to none if is something (CHR$ 31 to 127) pressed
OldK$ = ""
Selected = 0
SelectEnd = 0
SelectStart = 0
ExtraPress = 0
OGPos = 0
End If
'support for Shift + Home
kl& = _KeyDown(18176) 'home
km& = _KeyDown(20224) 'end
If kk& = -1 And kl& = -1 Or kj& = -1 And kl& = -1 Then 'Shift + HOME
If Len(C$) Then
SelectStart = Xs - 1
SelectEnd = OGPos - 1
Selected = 1
Gpos = Xs
End If
End If
If kk& = -1 And km& = -1 Or kj& = -1 And km& = -1 Then 'Shift + END
If Len(C$) Then
SelectStart = OGPos - 1
SelectEnd = Xs + _PrintWidth(C$) - 1
Selected = 1
Gpos = Xs + _PrintWidth(C$)
End If
End If
_PrintMode _FillBackground
'cursor print
Line (Xs - 1, Ys)-(Xs + GLen - 1, Ys + _FontHeight), OffCursorColor, BF
Select Case INSERT
Case 0 ' standard cursor, insert mode is disabled
Select Case Mode ' cursor in mode 1 is line on bottom _
Case 0, 1
If Timer * 10 Mod 10 < 5 Then
Line (Gpos - 1, Ys + _FontHeight)-(Gpos + _FontWidth - 1, Ys + _FontHeight), OnCursorColor
Else
Line (Gpos - 1, Ys + _FontHeight)-(Gpos + _FontWidth - 1, Ys + _FontHeight), OffCursorColor
End If
Case 2 ' cursor in mode 2 is vertical line |
If Timer * 10 Mod 10 < 5 Then
Line (Gpos - 1, Ys)-(Gpos - 1, Ys + _FontHeight - 1), OnCursorColor
Else
Line (Gpos - 1, Ys)-(Gpos - 1, Ys + _FontHeight - 1), OffCursorColor
End If
End Select
Case -1 ' rectangle cursor, insert mode is enabled
_PrintMode _KeepBackground
If Timer * 10 Mod 10 < 5 Then
Line (Gpos - 1, Ys)-(Gpos + _FontWidth - 1, Ys + _FontHeight), OnCursorColor, BF
Else
Line (Gpos - 1, Ys)-(Gpos + _FontWidth - 1, Ys + _FontHeight), OffCursorColor, BF
End If
End Select
If Mode > 0 Then
_PrintMode _KeepBackground
_PrintString (Xs, Ys), C$
_PrintMode _FillBackground
Else
_PrintMode _KeepBackground
_ControlChr Off
_PrintString (Xs, Ys), String$(Len(C$), 249)
_PrintMode _FillBackground
_ControlChr On
End If
If Selected Then
If Len(C$) Then Line (SelectStart - 1, Ys)-(SelectEnd - 1, Ys + _FontHeight), SelectColor, BF 'for 32 bit screens
'tady to je opraveno take
If _PixelSize = 1 Then
StartChar = (SelectStart - Xs) \ _FontWidth
EndChar = (SelectEnd - Xs) \ _FontWidth
If StartChar > EndChar Then Swap StartChar, EndChar
SelX1 = Xs + StartChar * _FontWidth
SelX2 = Xs + EndChar * _FontWidth
Line (SelX1, Ys)-(SelX2, Ys + _FontHeight), SelectColor, BF
_PrintMode _KeepBackground
Color 15, 0
_PrintString (Xs, Ys), C$
Color 0, 15
_PrintString (SelX1, Ys), Mid$(C$, StartChar + 1, EndChar - StartChar)
_PrintMode _FillBackground
Color 15, 0
End If
End If
End Select
_Limit 20
Loop
End Function
Sub ResetLB
MB = _MouseButton(1)
Do Until MB = 0
While _MouseInput
Wend
MB = _MouseButton(1)
Loop
End Sub