Title : textfield
Author : b32
Posted : 1+ years ago
Description : This graphic control works a bit like notepad. You can use a string for filtering the input characters. You can copy/paste text, however then, any character is allowed. For the use of the clipbaord, you need the decls from jim brown.
Code :
;keywords are defined at the bottom, it doesn't recognize strings "". Comments are lines that start with //
;-------------------------------------------------------------------------------------------------------
; Globals etc
;-------------------------------------------------------------------------------------------------------
;allowed characters
Global abc$ = "<>{}1234567890-=QWERTYUIOP[]ASDFGHJKL;'XCVBNM,./* 789-456+1230.,/?!@#$%^&():" + Chr$(34)
;number of lines
Global numlines
Global ActiveText.TTextField
Global Cursor_X, Cursor_Y
Global curx, cury, curline.TLine
Dim Cursor_Hit(2)
;highlighted keywords (see ReadKeyWords)
Type KeyWord
Field s$
End Type
;selection type
Type TSelection
Field l.Tline
Field c
End Type
Dim tsel.TSelection(2)
For i = 1 To 2
tsel(i) = New TSelection
Next
;storage of lines
Type TStorage
Field s$
Field id
Field t.TTextField
End Type
;line type
Type TLine
Field s$
Field id
End Type
;textfield type
Type TTextField
Field x
Field y
Field width
Field height
Field font
Field CharWidth
Field CharHeight
Field ofx, ofy
Field passwordmask$
Field limitchars
Field noenter
Field curx, cury
Field curline.TLine
Field backgroundcolor
Field bordercolor
Field textcolor
Field sel_backgroundcolor
Field sel_textcolor
Field cursorcolor
Field commentcolor
Field keywordcolor
Field idle
End Type
ReadKeyWords()
;-------------------------------------------------------------------------------------------------------
; Test Program
;-------------------------------------------------------------------------------------------------------
Graphics 800, 600, 0, 2
SetBuffer BackBuffer()
;create textfield
t2.TTextField = CreateTextField(50, 320, 80, 15, 10, "*", 1)
t1.TTextField = CreateTextField(50, 50, 700, 240)
;main loop
Repeat
Cls
DrawTextFields()
;F1/F2
If KeyHit(59) Then SaveTextFile("test.txt")
If KeyHit(60) Then LoadTextFile("test.txt")
Flip
Until KeyHit(1)
End
;-------------------------------------------------------------------------------------------------------
; DrawTextFields()
;-------------------------------------------------------------------------------------------------------
Function DrawTextFields()
Cursor_X = MouseX()
Cursor_Y = MouseY()
Cursor_Hit(1) = MouseHit(1)
test = 0
For t.TTextField = Each TTextField
DrawTextField(t)
If RectsOverlap(Cursor_X, Cursor_Y, 1, 1, tx, ty, twidth, theight) And Cursor_Hit(1) Then
SetActiveText t
test = 1
End If
Next
If Cursor_Hit(1) And (test = 0) Then SetActiveText Null
End Function
;-------------------------------------------------------------------------------------------------------
; CreateTextField()
;-------------------------------------------------------------------------------------------------------
Function CreateTextField.TTextField(x, y, ww$, hh$, limitchars = 0, pwmask$ = "", noenter = 0)
t.TTextField = New TTextField
;position
tx = x
ty = y
twidth = ww
theight = hh
;font
tfont = LoadFont("Blitz")
SetFont tfont
;font size
tCharWidth = StringWidth("X")
tCharHeight = StringHeight("X")
;scroll
tofx = 0
tofy = 0
tlimitchars = limitchars
tpasswordmask$ = pwmask$
t
oenter = noenter
tackgroundcolor = $225588
tordercolor = $555555
t extcolor = $FFFFFF
tkeywordcolor = $AADDFF
tsel_backgroundcolor = $DDAA77
tsel_textcolor = $000000
tcursorcolor = $DDAA77
tcommentcolor = $FFEE00
tidle = CreateImage(twidth, theight)
SetMarker(1, 0, 0)
SetMarker(2, 0, 0)
SetActiveText t
Return t
End Function
;-------------------------------------------------------------------------------------------------------
; DrawTextField()
;-------------------------------------------------------------------------------------------------------
Function DrawTextField(t.TTextField, update = 0)
If (t <> ActiveText) And (Not update) Then
DrawBlock tidle, tx, ty
Return
End If
limitchars = tlimitchars
curline.TLine = tcurline
curx = tcurx
cury = tcury
If limitchars > 0 Then If curx > limitchars Then curx = limitchars
If t
oenter Then If cury > 0 Then cury = 0
;max width/height in characters
maxchar = (twidth / tCharWidth)
maxlines = (theight / tCharHeight)
;scroll textfield
If cury - tofy >= maxlines Then tofy = cury - maxlines + 1
If cury - tofy < 0 Then tofy = cury
If curx - tofx < 0 Then tofx = curx
If curx - tofx >= maxchar Then tofx = curx - maxchar + 1
;draw frame
Color 0, 0, tackgroundcolor
Rect tx, ty, twidth, theight
Color 0, 0, tordercolor
Rect tx, ty, twidth, theight, 0
Viewport tx, ty, twidth, theight
;determine bottom
bottom = ty + theight
;get selection
If tsel(1)l <> Null Then
sel1y = tsel(1)lid
sel1x = tsel(1)c - tofx
Else
sel1y = 0
sel1x = 0
End If
If tsel(2)l <> Null Then
sel2y = tsel(2)lid
sel2x = 0
Else
sel2y = 0
sel2x = 0
End If
sel2x = tsel(2)c - tofx
If sel1x < 0 Then sel1x = 0
If sel1x > maxchar Then sel1x = maxchar
If sel2x < 0 Then sel2x = 0
If sel2x > maxchar Then sel2x = maxchar
;determine order
If sel2y < sel1y Then
tempx = sel1x
tempy = sel1y
sel1x = sel2x
sel1y = sel2y
sel2x = tempx
sel2y = tempy
End If
If sel1y = sel2y Then
If sel2x < sel1x Then
tempx = sel1x
tempy = sel1y
sel1x = sel2x
sel1y = sel2y
sel2x = tempx
sel2y = tempy
End If
End If
;delete lines if needed
For l.TLine = Each TLine
If t
oenter Then If l <> First TLine Then Delete l
Next
;draw text area
SetFont tfont
iy = ty - tofy * tCharHeight
init = 0
For l.TLine = Each TLine
If limitchars > 0 Then If Len(ls$ > limitchars) Then ls$ = Left$(ls$, limitchars)
If lid = tofy Then init = 1
linetext$ = ls$
If tpasswordmask$ <> "" Then linetext$ = String$(tpasswordmask$, Len(ls$))
If init Then
;draw text
If (lid > sel1y) And (lid < sel2y) Then
SelText t, tx, iy, Mid$(linetext$, tofx + 1, maxchar)
ElseIf (lid = sel1y) And (lid < sel2y) Then
d$ = Mid$(linetext$, tofx + 1, maxchar)
d1$ = Left$(d$, sel1x)
d2$ = Mid$(d$, sel1x + 1)
;BoxText t, tx, iy, d1$
BoxText2 t, tx, iy, linetext$, tofx + 1, sel1x
SelText t, tx + Len(d1$) * tCharWidth, iy, d2$
ElseIf (lid > sel1y) And (lid = sel2y) Then
d$ = Mid$(linetext$, tofx + 1, maxchar)
d1$ = Left$(d$, sel2x)
d2$ = Mid$(d$, sel2x + 1)
;BoxText t, tx + Len(d1$) * tCharWidth, iy, d2$
BoxText2 t, tx + Len(d1$) * tCharWidth, iy, linetext$, tofx + 1 + sel2x, maxchar - sel2x
SelText t, tx, iy, d1$
ElseIf (lid = sel1y) And (lid = sel2y) Then
d$ = Mid$(linetext$, tofx + 1, maxchar)
d2$ = Mid$(d$, sel1x + 1, sel2x - sel1x)
BoxText2 t, tx, iy, linetext$, tofx + 1, maxchar
;BoxText t, tx, iy, d$
SelText t, tx + (sel1x * tCharWidth), iy, d2$
Else
;BoxText t, tx, iy, Mid$(linetext$, tofx + 1, maxchar)
BoxText2 t, tx, iy, linetext$, tofx + 1, maxchar
End If
End If
iy = iy + tCharHeight
If iy + tCharHeight > bottom Then Exit
Next
;get cursor line
curline.TLine = GetLine(cury)
maxdd = Len(curlines$)
;draw cursor
cgx = tx + (tCharWidth * (curx - tofx))
cgy = ty + (tCharHeight * (cury - tofy))
Color 0, 0, tsel_backgroundcolor
If Not update Then Line cgx, cgy, cgx, cgy + tCharHeight
; Color 255, 255, 255
; Text cgx, cgy, Mid$(curlines$, curx + 1, 1)
;shift hit
If KeyHit(42) Then
SetMarker(1, cury, curx)
SetMarker(2, cury, curx)
End If
; ;current line size
; maxdd = Len(curlines$)
;ctrl
ctrl = KeyDown(29)
If ctrl Then
;CTRL+A
If KeyHit(30) Then
SetMarker(1, 0, 0)
l.TLine = GetLine(numlines - 1)
SetMarker(2, numlines - 1, Len(ls$))
FlushKeys()
End If
;CTRL+D
If KeyHit(32) Then
SetMarker(1, 0, 0)
SetMarker(2, 0, 0)
FlushKeys()
End If
;CTRL+X
If KeyHit(45) Then
WriteClipBoardText(GetSelection$())
DeleteSel()
ResetSel()
FlushKeys()
End If
;CTRL+C
If KeyHit(46) Then
WriteClipBoardText(GetSelection$())
ResetSel()
FlushKeys()
End If
;CTRL+V
If MyKeyHit(47) Then
If CheckSelected() Then DeleteSel(): ResetSel(1)
rok$ = ReadClipBoardText$()
InsertLines(rok$, curx, cury, tlimitchars)
curline = GetLine(cury)
maxdd = Len(curlines$)
ResetSel()
End If
;home
If KeyHit(199) Then
curx = 0
cury = 0
curline = GetLine(cury)
maxdd = Len(curlines$)
ResetSel
End If
;end
If KeyHit(207) Then
cury = numlines - 1
curline = GetLine(cury)
maxdd = Len(curlines$)
curx = maxdd
ResetSel
End If
Else
;KEYBOARD INPUT
ok = GetKey()
;INSERT
If MyKeyHit(210) Then ok = 32
;A-Z keys
If ok <> 0 Then
If curx < 0 Then curx = 0
If cury < 0 Then cury = 0
;check against abc$
If Instr(abc$, Upper$(Chr$(ok))) > 0 Then
DeleteSel()
;add character
curlines$ = Left$(curlines$, curx) + Chr$(ok) + Mid$(curlines$, curx + 1)
maxdd = Len(curlines$)
curx = curx + 1
ResetSel(1)
End If
End If
;tab
If MyKeyHit(15) Then
If CheckSelected() Then
TabSelected(0)
Else
;add tab
curlines$ = Left$(curlines$, curx) + " " + Mid$(curlines$, curx + 1)
maxdd = Len(curlines$)
curx = curx + 4
ResetSel(1)
End If
End If
;enter
If MyKeyHit(28) Then
DeleteSel()
nl$ = Mid$(curlines$, curx + 1)
curlines$ = Left$(curlines$, curx)
l.TLine = AddLine(nl$)
Insert l After curline
cury = cury + 1
curx = 0
curline = l
maxdd = Len(curlines$)
UpdateLines()
ResetSel(1)
End If
;backspace
If MyKeyHit(14) Then
If CheckSelected() Then
DeleteSel()
ResetSel(1)
Else
If curx > 0 Then
curlines$ = Left$(curlines$, curx - 1) + Mid$(curlines$, curx + 1)
curx = curx - 1
maxdd = Len(curlines$)
ResetSel(1)
Else
If cury > 0 Then
l.TLine = GetLine(cury - 1)
curx = Len(ls$)
ls$ = ls$ + curlines$
Delete curline
numlines = numlines - 1
UpdateLines()
cury = cury - 1
curline = l
maxdd = Len(ls$)
ResetSel(1)
End If
End If
End If
End If
;home/end
If KeyHit(199) Then curx = 0: ResetSel
If KeyHit(207) Then curx = maxdd: ResetSel
End If
;pgup
If MyKeyHit(201) Then
ncury = cury - maxlines
If ncury < 0 Then ncury = 0
cury = ncury
curline = GetLine(cury)
maxdd = Len(curlines$)
ResetSel
End If
;pgdn
If MyKeyHit(209) Then
ncury = cury + maxlines
If ncury >= numlines Then ncury = numlines - 1
cury = ncury
curline = GetLine(cury)
maxdd = Len(curlines$)
ResetSel
End If
;left
If MyKeyHit(203) Then
If ctrl Then
Repeat
curx = curx - 1
If curx < 1 Then Exit
If Mid$(curlines$, curx, 1) = " " Then Exit
Forever
Else
curx = curx - 1
End If
If curx < 0 Then
If cury > 0 Then
cury = cury - 1
curline.TLine = GetLine(cury)
maxdd = Len(curlines$)
curx = maxdd
Else
curx = 0
End If
End If
ResetSel
End If
;right
If MyKeyHit(205) Then
If ctrl Then
Repeat
curx = curx + 1
If curx >= maxdd Then Exit
If Mid$(curlines$, curx, 1) = " " Then Exit
Forever
Else
curx = curx + 1
End If
If curx > maxdd Then
If cury < numlines - 1 Then
curx = 0
cury = cury + 1
curline = GetLine(cury)
maxdd = Len(curlines$)
End If
End If
ResetSel
End If
;up
If MyKeyHit(200) Then
cury = cury - 1
If cury < 0 Then cury = 0
curline.TLine = GetLine(cury)
maxdd = Len(curlines$)
ResetSel
End If
;down
If MyKeyHit(208) Then
cury = cury + 1
If cury >= numlines Then cury = numlines - 1
curline.TLine = GetLine(cury)
maxdd = Len(curlines$)
ResetSel
End If
If curx > maxdd Then curx = maxdd
;delete knop
If KeyHit(211) Then
If CheckSelected() Then
DeleteSel(): ResetSel(1)
Else
If curx >= 0 Then
curlines$ = Left$(curlines$, curx) + Mid$(curlines$, curx + 2)
maxdd = Len(curlines$)
ResetSel(1)
End If
End If
End If
tcurline = curline
tcurx = curx
tcury = cury
Viewport 0, 0, GraphicsWidth(), GraphicsHeight()
End Function
;-------------------------------------------------------------------------------------------------------
; AddLine()
;-------------------------------------------------------------------------------------------------------
Function AddLine.TLine(s$)
l.TLine = New TLine
ls$ = s$
UpdateLines()
Return l
End Function
;-------------------------------------------------------------------------------------------------------
; UpdateLines()
;-------------------------------------------------------------------------------------------------------
Function UpdateLines()
id = 0
For l.TLine = Each TLine
lid = id
id = id + 1
Next
numlines = id
; curline.TLine = GetLine(cury)
End Function
;-------------------------------------------------------------------------------------------------------
; SetMarker()
;-------------------------------------------------------------------------------------------------------
Function SetMarker(id, liney, char)
l.TLine = Null
For il.TLine = Each TLine
If ilid = liney Then l = il: Exit
Next
If l = Null Then Return
tsel(id)l = l
tsel(id)c = char
If tsel(1)l = Null Then Return
If tsel(2)l = Null Then Return
End Function
;-------------------------------------------------------------------------------------------------------
; SelText()
;-------------------------------------------------------------------------------------------------------
;draw selected text
Function SelText(t.TTextField, x, y, s$)
ww = StringWidth(s$)
hh = StringHeight(s$)
Color 0, 0, tsel_backgroundcolor
Rect x, y, ww, hh
Color 0, 0, tsel_textcolor
Text x, y, Replace$(s$, Chr$(13), "")
End Function
;-------------------------------------------------------------------------------------------------------
; BoxText()
;-------------------------------------------------------------------------------------------------------
;draw non-selected text
Function BoxText(t.TTextField, x, y, s$)
q$ = Trim$(s$)
If Left$(q$, 2) = "//" Then
Color 0, 0, tcommentcolor
test = 1
Else
Color 0, 0, t extcolor
test = 0
End If
Text x, y, s$
If test Then Return
Color 0, 0, tkeywordcolor
l$ = " " + Lower$(s$) + " "
For k.KeyWord = Each KeyWord
If Instr(l$, Lower$(ks$)) Then
test = 0
Repeat
test = Instr(l$, Lower$(ks$), test + 1)
If test < 1 Then Exit
Text x + (test - 1) * tCharWidth, y, Mid$(s$, test, Len(ks$) - 2)
Forever
End If
Next
End Function
;-------------------------------------------------------------------------------------------------------
; BoxText2()
;-------------------------------------------------------------------------------------------------------
;draw non-selected text
Function BoxText2(t.TTextField, x, y, s$, st, ll)
q$ = Trim$(s$)
If Left$(q$, 2) = "//" Then
Color 0, 0, tcommentcolor
test = 1
Else
Color 0, 0, t extcolor
test = 0
End If
Text x, y, Mid$(s$, st, ll)
If test Then Return
Color 0, 0, tkeywordcolor
l$ = " " + Lower$(s$) + " "
For k.KeyWord = Each KeyWord
If Instr(l$, Lower$(ks$)) Then
test = 0
Repeat
test = Instr(l$, Lower$(ks$), test + 1)
If test < 1 Then Exit
x1 = x + (test - st) * tCharWidth
ll = (Len(ks$) - 2) * tCharWidth
If (x1 + ll >= tx) And (x1 <= tx + twidth) Then
Text x1, y, Mid$(s$, test, Len(ks$) - 2)
End If
Forever
End If
Next
End Function
;-------------------------------------------------------------------------------------------------------
; GetLine()
;-------------------------------------------------------------------------------------------------------
;gets a specific line, else creates it
Function GetLine.TLine(i)
If i < 0 Then i = 0
If i > 65536 Then i = 65536
il.TLine = Null
For l.TLine = Each TLine
If lid = i Then il = l: Exit
Next
If il = Null Then
Repeat
il.TLine = AddLine("")
If ilid = i Then Exit
Until ilid = 65536
End If
Return il
End Function
;-------------------------------------------------------------------------------------------------------
; ResetSel()
;-------------------------------------------------------------------------------------------------------
Function ResetSel(rs = 0)
;shift
If KeyDown(42) And (Not rs) Then
SetMarker(2, cury, curx)
Else
If rs Then
SetMarker(1, 0, 0)
SetMarker(2, 0, 0)
Else
SetMarker(1, cury, curx)
SetMarker(2, cury, curx)
End If
End If
FlushKeys()
End Function
;-------------------------------------------------------------------------------------------------------
; DeleteSel()
;-------------------------------------------------------------------------------------------------------
Function DeleteSel()
;retreive selection
If tsel(1)l <> Null Then sel1y = tsel(1)lid Else Return
If tsel(2)l <> Null Then sel2y = tsel(2)lid Else Return
If (tsel(1)l = tsel(2)l) And (tsel(1)c = tsel(2)c) Then Return
sel1x = tsel(1)c
sel2x = tsel(2)c
If sel1x < 0 Then sel1x = 0
If sel2x < 0 Then sel2x = 0
;determine order
id1 = 1
id2 = 2
If sel2y < sel1y Then
id1 = 2
id2 = 1
tempx = sel1x
tempy = sel1y
sel1x = sel2x
sel1y = sel2y
sel2x = tempx
sel2y = tempy
End If
If sel1y = sel2y Then
If sel2x < sel1x Then
id1 = 2
id2 = 1
tempx = sel1x
tempy = sel1y
sel1x = sel2x
sel1y = sel2y
sel2x = tempx
sel2y = tempy
End If
End If
;reset cursor
curx = tsel(id1)c
cury = tsel(id1)lid
;remove lines in between
For l.TLine = Each TLine
If (lid > sel1y) And (lid < sel2y) Then Delete l
Next
;same line?
If tsel(id1)l = tsel(id2)l Then
If (sel1x = 0) And (sel2x = Len(tsel(id2)ls$)) Then
Delete tsel(id1)l
Else
tsel(id1)ls$ = Left$(tsel(id1)ls$, sel1x) + Mid$(tsel(id1)ls$, sel2x + 1)
End If
Else
test = 1
;cut first line
If sel1x = 0 Then
Delete tsel(id1)l
test = 0
Else
tsel(id1)ls$ = Left$(tsel(id1)ls$, sel1x)
End If
;cut last line
If sel2x = Len(tsel(id2)ls$) Then
Delete tsel(id2)l
test = 0
Else
tsel(id2)ls$ = Mid$(tsel(id2)ls$, sel2x + 1)
End If
;paste together if needed
If test Then
tsel(id1)ls$ = tsel(id1)ls$ + tsel(id2)ls$
Delete tsel(id2)l
End If
End If
;update indexes and reset selection
UpdateLines()
ResetSel(1)
curline = GetLine(cury)
End Function
;-------------------------------------------------------------------------------------------------------
; GetSelection()
;-------------------------------------------------------------------------------------------------------
Function GetSelection$()
;retreive selection
If tsel(1)l <> Null Then sel1y = tsel(1)lid Else Return
If tsel(2)l <> Null Then sel2y = tsel(2)lid Else Return
sel1x = tsel(1)c
sel2x = tsel(2)c
id1 = 1
id2 = 2
;determine order
If sel2y < sel1y Then
id1 = 2
id2 = 1
End If
If sel1y = sel2y Then
If sel2x < sel1x Then
id1 = 2
id2 = 1
End If
End If
;same line ?
If tsel(id1)l = tsel(id2)l Then
If tsel(id1)c = tsel(id2)c Then
Return
Else
ss = tsel(id1)c + 1
ll = tsel(id2)c - ss + 1
Return Mid$(tsel(id1)ls$, ss, ll)
End If
End If
;get selection
s$ = ""
init = 0
For l.TLine = Each TLine
If l = tsel(id2)l Then
s$ = s$ + Left$(tsel(id2)ls$, tsel(id2)c)
init = 0
End If
If init Then
s$ = s$ + ls$ + Chr$(13)
End If
If l = tsel(id1)l Then
s$ = s$ + Mid$(tsel(id1)ls$, tsel(id1)c + 1) + Chr(13)
init = 1
End If
Next
;return selection
Return s$
End Function
;-----------------------------------------------------------------------------------------------------
; WriteClipBoardText()
;-----------------------------------------------------------------------------------------------------
Function WriteClipBoardText(txt$)
If txt$="" Then Return
txt$ = Replace$(txt$, Chr$(13), Chr$(13) + Chr$(10))
Local cb_TEXT=1
If OpenClipboard(0)
EmptyClipboard
SetClipboardData cb_TEXT,txt$
CloseClipboard
EndIf
FreeBank txtbuffer
End Function
;-----------------------------------------------------------------------------------------------------
; ReadClipBoardText()
;-----------------------------------------------------------------------------------------------------
Function ReadClipBoardText$()
Local cb_TEXT=1
Local txt$=""
If OpenClipboard(0)
If ExamineClipboard(cb_TEXT)
txt$=GetClipboardData$(cb_TEXT)
EndIf
CloseClipboard
EndIf
txt$ = Replace$(txt$, Chr$(13) + Chr$(10), Chr$(13))
txt$ = Replace$(txt$, Chr$(9), " ")
Return txt$
End Function
;-----------------------------------------------------------------------------------------------------
; InsertLine()
;-----------------------------------------------------------------------------------------------------
Function InsertLine(r$, x, y)
If Right$(r$, 1) = Chr$(13) Then add = 1: r$ = Left$(r$, Len(r$) - 1)
If y < 0 Then y = 0
If x < 0 Then x = 0
If y > numlines Then y = numlines
l.TLine = GetLine(y)
If add Then
If x > 0 Then
r2$ = Mid$(ls$, x + 1)
ls$ = Left$(ls$, x) + r$
l2.TLine = AddLine(r2$)
Insert l2 After l
curx = 0
cury = cury + 1
Else
l2.TLine = AddLine(r$)
Insert l2 Before l
curx = 0
cury = cury + 1
End If
Else
ls$ = Left$(ls$, x) + r$ + Mid$(ls$, x + 1)
curx = curx + Len(r$)
End If
UpdateLines()
End Function
;-----------------------------------------------------------------------------------------------------
; InsertLines()
;-----------------------------------------------------------------------------------------------------
Function InsertLines(r$, x, y, limitchars = 0)
If Instr(r$, Chr$(13)) > 0 Then
Repeat
cc = Instr(r$, Chr$(13))
If cc = 0 Then Exit
r1$ = Left$(r$, cc)
r2$ = Mid$(r$, cc + 1)
InsertLine(r1$, x, y)
init = 0
x = 0
y = y + 1
r$ = r2$
Forever
End If
InsertLine(r$, x, y)
If limitchars > 0 Then
For l.TLine = Each TLine
If Len(ls$) > limitchars Then ls$ = Left$(ls$, limitchars)
Next
End If
End Function
;-----------------------------------------------------------------------------------------------------
; UpdateText()
;-----------------------------------------------------------------------------------------------------
;grab screenshot to 'idle' image
Function UpdateText(t.TTextField)
DrawTextField t, 1
;store idle
CopyRect tx, ty, twidth, theight, 0, 0, BackBuffer(), ImageBuffer(tidle)
End Function
;-----------------------------------------------------------------------------------------------------
; DeleteTextField()
;-----------------------------------------------------------------------------------------------------
Function DeleteTextField(t.TTextField)
;free image
FreeImage tidle
;delete storage
For st.TStorage = Each TStorage
If st = t Then Delete st
Next
;delete temp lines
If t = ActiveText Then Delete Each TLine
;free font
FreeFont tfont
;delete type
Delete t
End Function
;-----------------------------------------------------------------------------------------------------
; SetActiveText()
;-----------------------------------------------------------------------------------------------------
Function SetActiveText(t.TTextField)
;if another is selected
If ActiveText <> Null Then
;delete storage
For st.TStorage = Each TStorage
If st = ActiveText Then Delete st
Next
;store temp lines
For l.TLine = Each TLine
st.TStorage = New TStorage
sts$ = ls$
stid = lid
st = ActiveText
Next
;store screenshot
UpdateText(ActiveText)
End If
;delete temp lines
Delete Each TLine
;select another text
ActiveText = t
If ActiveText = Null Then Return
;get lines from storage
For st.TStorage = Each TStorage
If st = t Then
l.TLine = New TLine
ls$ = sts$
lid = stid
End If
Next
UpdateLines()
;reset cursor
SetMarker 1, 0, 0
SetMarker 2, 0, 0
End Function
;-----------------------------------------------------------------------------------------------------
; SaveTextFile()
;-----------------------------------------------------------------------------------------------------
Function SaveTextFile(f$)
ff = WriteFile(f$)
For l.TLine = Each TLine
WriteLine ff, ls$
Next
CloseFile ff
End Function
;-----------------------------------------------------------------------------------------------------
; LoadTextFile()
;-----------------------------------------------------------------------------------------------------
Function LoadTextFile(f$)
If FileType(f$) <> 1 Then Return
Delete Each TLine
ff = ReadFile(f$)
While Not(Eof(ff))
AddLine(ReadLine(ff))
Wend
CloseFile ff
UpdateLines()
;reset cursor
SetMarker 1, 0, 0
SetMarker 2, 0, 0
End Function
;-----------------------------------------------------------------------------------------------------
; MyKeyHit()
;-----------------------------------------------------------------------------------------------------
Global toldkey, timestart
Function MyKeyhit(key)
If KeyHit(key) Then
timestart = MilliSecs()
Return 1
End If
If KeyDown(key) Then
Return (MilliSecs() - timestart) > 500
End If
End Function
;-----------------------------------------------------------------------------------------------------
; CheckSelected()
;-----------------------------------------------------------------------------------------------------
Function CheckSelected()
Return (tsel(1)l <> tsel(2)l) Or (tsel(1)c <> tsel(2)c)
End Function
Function TabSelected(tab)
;retreive selection
If tsel(1)l <> Null Then sel1y = tsel(1)lid Else Return
If tsel(2)l <> Null Then sel2y = tsel(2)lid Else Return
sel1x = tsel(1)c
sel2x = tsel(2)c
;determine order
If sel2y < sel1y Then
sel1y = tsel(2)lid
sel2y = tsel(1)lid
End If
Select tab
Case 0
;add tabs
For l.TLine = Each TLine
If (lid >= sel1y) And (lid <= sel2y) Then ls$ = " " + ls$
Next
Case 1
;remove tabs
For l.TLine = Each TLine
If (lid >= sel1y) And (lid <= sel2y) Then
If Left$(ls$, 4) = " " Then ls$ = Mid$(ls$, 5)
End If
Next
End Select
End Function
;-----------------------------------------------------------------------------------------------------
; ReadKeyWord()
;-----------------------------------------------------------------------------------------------------
Function ReadKeyWords()
Restore
Repeat
Read o$
If o$ = "*STOP*" Then Exit
k.KeyWord = New KeyWord
ks$ = " " + o$ + " "
Forever
End Function
Data "Else"
Data "Then"
Data "Position"
Data "Move"
Data "Turn"
Data "Locate"
Data "If"
Data "Print"
Data "Call"
Data "Set"
Data "End"
Data "Return"
Data "{"
Data "}"
Data "*STOP*"
Comments :
Yahfree(Posted 1+ years ago)
Wierid... Alot mroe advanced then mine for sure, i'v yet to understand how DLLs and delcs work completely, i like this, WHERE WAS THIS WHEN I WAS MAKING MINE?!!?Also, win32, whats in that DLL, windows stuff(like their GUI)? and where do i learn how to access it?
b32(Posted 1+ years ago)
I spend a lot more time on this than I was planning .. I rewrote it 5 times before it worked .. :S Never imagined that this would be so complex ..You can find more info on the windows .dll commands in the msdn:http://www.google.com/search?hl=en&q=setcursorpos+site%3Amsdn.microsoft.com&btnG=Google+SearchUsually, however, I learn it from this site, or with the help of a VB example.Here is more info on user32, it is a standard windows dll:<a href="http://www.processlibrary.com/directory/files/user32/" target="_blank">http://www.processlibrary.com/directory/files/user32/</a>
Yahfree(Posted 1+ years ago)
Cool, how do i change the color of the cursor? also is there a way to get rid of some stuff, like for example, i don't want the user to be able to break into a new line.heres some suggestions:*Create a system to see if a key is still being pressed, so the user doesnt have to press backspace over and over to delete*make an option for 2 types of test fields, 1 that just scrolls verticly and doesnt create a new line when enter is pressed, and 2: a notepad type thing like this, where if you get to the boarder it creates a new line. Not just stops.i like being able to change the color scheems though, i'll mess with ti some more, its very niceEdit: also you should include your IgetKey() function to enable the num-pad...
b32(Posted 1+ years ago)
To disable line breaks, search for ;enter (in bb, with ctrl+f) and disable that piece of code.The color scheme is placed in the CreateTextField function, you can change it there or after creating a textfield, by setting the extcolor field etc. The cursor color is the same as the selection background color, search for 'draw cur' to change that, you could make an extra field for the cursor color.Each Textfield can use it's own font and colors, however you can only use fixed-width fonts, else the cursor messes up.Here is the igetkey.bb module, in the code above, uncomment:Include "igetkey.bb" and search for iGetKey() and iFlushKeys() to uncomment them too.;-----------------------------------------------------------------------------------------------------
; **LIB IGETKEY**
;-----------------------------------------------------------------------------------------------------
InitGetKey()
;-----------------------------------------------------------------------------------------------------
; ScanCode Type
;-----------------------------------------------------------------------------------------------------
Type TKeyDown
Field s.ScanCode
End Type
;type to hold scancodes
Type ScanCode
Field code
Field key$
Field upkey$
Field isdown
End Type
;-----------------------------------------------------------------------------------------------------
; InitGetKey()
;-----------------------------------------------------------------------------------------------------
;reads all scancodes into ScanCode type
Function InitGetKey()
;read scancodes
tel = 1
Restore scancodez
Repeat
Read scanc
If scanc = -1 Then Exit
s.ScanCode = New ScanCode
scode = scanc
skey$ = Lower$(Mid$("1234567890-=QWERTYUIOP[]ASDFGHJKL;'XCVBNM,./* 789-456+1230.,/" + Chr$(8) + Chr$(13) + Chr$(13), tel, 1))
supkey$ = Mid$("!@#$%^&*()_+QWERTYUIOP{}ASDFGHJKL:" + Chr$(34) + "|ZXCVBNM<>?* 789-456+1230.,/" + Chr$(8) + Chr$(13) + Chr$(13), tel, 1)
tel = tel + 1
Forever
End Function
Function iFlushKeys()
;read scancodes
For s.ScanCode = Each ScanCode
sisdown = KeyDown(scode)
Next
FlushKeys()
End Function
Global oldkdown
;-----------------------------------------------------------------------------------------------------
; iGetKey()
;-----------------------------------------------------------------------------------------------------
;imitates GetKey() using scancodes
Function iGetKey()
;read scancodes
For s.ScanCode = Each ScanCode
down = KeyDown(scode)
If down And (Not sisdown) Then
tk.TKeyDown = New TKeyDown
tks = s
End If
sisdown = down
Next
tk.TKeyDown = First TKeyDown
If tk = Null Then Return
sel.ScanCode = tks
If sel = Null Then Return
oldkdown = selcode
Delete tk
;shift for uppercase
If KeyDown(42) Or KeyDown(54) Then
sc$ = selupkey$
Else
sc$ = selkey$
End If
;return ascii value of key
Return Asc(sc$)
End Function
;"1234567890-=QWERTYUIOP[]ASDFGHJKL;'XCVBNM,./* 789-456+7890.,/" (no shift)
;"!@#$%^&*()_+QWERTYUIOP{}ASDFGHJKL:"|ZXCVBNM<>?* 789-456+7890.,/" (shift)
.scancodez
Data 2, 3, 4, 5, 6, 7, 8, 9, 10, 11
Data 12, 13, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25
Data 26, 27, 30, 31, 32, 33, 34, 35, 36, 37, 38
Data 39, 40, 43, 44, 45, 46, 47, 48, 49, 50, 51
Data 52, 53, 55, 57, 71, 72, 73, 74, 75, 76, 77
Data 78, 79, 80, 81, 82, 83, 179, 181
Data 14, 28, 156
Data -1
I would also like to include key repetition, and tweak some editing keys so it works more like a 'tmemo' object. I'm not sure where it will end, but if I will update the code if I have something new. If you add anything, feel free to post it.
Vertigo(Posted 1+ years ago)
I toiled with something for weeks very similar. I was tired of popping up hundreds of files in notepad to edit scripts for my game. You just saved my life. Is this public domain? Kudos to you buddy!
Vertigo(Posted 1+ years ago)
Also some simple tweaks.Add fields to the Type TTextFieldField passwordField MaxCharLengthCall Function CreateTextField.TTextField(x, y, width, height, password=False)With optional password field.For the Box and Sel text functions do something like:
If Tpassword=False Then
Text x, y, s$
Else
For starlength= 0 To Len(s$)
startext$ = startext$ + "*"
Next
Text x, y, startext$
End If
b32(Posted 1+ years ago)
I've posted the new version. I've added some sort of syntax highlighting and tweaked it a bit to include the password functions. In case somebody needs the previous version, this is it:;-----------------------------------------------------------------------------------------------------
; **LIB TEXTFIELDS**
;-----------------------------------------------------------------------------------------------------
;-------------------------------------------------------
;make a textfile "user32.decls" in c:program fileslitzuserlibs with the
;following content to be able to use the clipboard:
;-------------------------------------------------------
; Clipboard Text Read / Write
; ===========================
; Syntax Error & Ed from Mars
; userlib declarations - 'user32.decls'
; *********************************************
; .lib "user32.dll"
; OpenClipboard%(hwnd%):"OpenClipboard"
; CloseClipboard%():"CloseClipboard"
; ExamineClipboard%(format%):"IsClipboardFormatAvailable"
; EmptyClipboard%():"EmptyClipboard"
; GetClipboardData$(format%):"GetClipboardData"
; SetClipboardData%(format%,txt$):"SetClipboardData"
; *********************************************
;-------------------------------------------------------
;the clipboard functions are written by Jim Brown:
;-------------------------------------------------------
; ID: 699
; Author: Jim Brown
; Date: 2003-05-21 14:30:46
; Title: Clipboard - Text Copy & Paste
; Description: Two functions to read & write to through the clipboard
; Clipboard Text Read / Write
; ===========================
; Syntax Error & Ed from Mars
;-----------------------------------
;Search: "WriteClipBoardText" and "ReadClipBoardText"
;-------------------------------------------------------------------------------------------------------
; Globals etc
;-------------------------------------------------------------------------------------------------------
; Include "igetkey.bb"
;allowed characters
Global abc$ = "{}1234567890-=QWERTYUIOP[]ASDFGHJKL;'XCVBNM,./* 789-456+1230.,/?!#$%^&():" + Chr$(34)
Global clipboard$
;number of lines
Global numlines
Global ActiveText.TTextField
Global Cursor_X, Cursor_Y
Global curx, cury
Dim Cursor_Hit(2)
;selection type
Type TSelection
Field l.Tline
Field c
End Type
Dim tsel.TSelection(2)
For i = 1 To 2
tsel(i) = New TSelection
Next
;storage of lines
Type TStorage
Field s$
Field id
Field t.TTextField
End Type
;line type
Type TLine
Field s$
Field id
End Type
;textfield type
Type TTextField
Field x
Field y
Field width
Field height
Field font
Field CharWidth
Field CharHeight
Field ofx, ofy
Field curx, cury
Field curline.TLine
Field backgroundcolor
Field bordercolor
Field textcolor
Field sel_backgroundcolor
Field sel_textcolor
Field cursorcolor
Field idle
End Type
;-------------------------------------------------------------------------------------------------------
; Test Program
;-------------------------------------------------------------------------------------------------------
Graphics 800, 600, 0, 2
SetBuffer BackBuffer()
;create textfield
t2.TTextField = CreateTextField(50, 320, 700, 240)
t1.TTextField = CreateTextField(50, 50, 700, 240)
;main loop
Repeat
Cls
DrawTextFields()
If KeyHit(59) Then SaveTextFile("test.txt")
If KeyHit(60) Then LoadTextFile("test.txt")
Flip
Until KeyHit(1)
End
;-------------------------------------------------------------------------------------------------------
; DrawTextFields()
;-------------------------------------------------------------------------------------------------------
Function DrawTextFields()
Cursor_X = MouseX()
Cursor_Y = MouseY()
Cursor_Hit(1) = MouseHit(1)
test = 0
For t.TTextField = Each TTextField
DrawTextField(t)
If RectsOverlap(Cursor_X, Cursor_Y, 1, 1, tx, ty, twidth, theight) And Cursor_Hit(1) Then
SetActiveText t
test = 1
End If
Next
If Cursor_Hit(1) And (test = 0) Then SetActiveText Null
End Function
;-------------------------------------------------------------------------------------------------------
; CreateTextField()
;-------------------------------------------------------------------------------------------------------
Function CreateTextField.TTextField(x, y, width, height)
t.TTextField = New TTextField
;position
tx = x
ty = y
twidth = width
theight = height
;use only fonts with a fixed width (ocr a extended, fixedsys, blitz etc.)
tfont = LoadFont("FixedSys");"Blitz"
SetFont tfont
;font size
tCharWidth = StringWidth("X")
tCharHeight = StringHeight("X")
;scroll
tofx = 0
tofy = 0
tackgroundcolor = $225588
tordercolor = $555555
t extcolor = $DDDDFF
tsel_backgroundcolor = $DDAA77
tsel_textcolor = $000000
tcursorcolor = $DDAA77
tidle = CreateImage(width, height)
SetMarker(1, 0, 0)
SetMarker(2, 0, 0)
SetActiveText t
Return t
End Function
;-------------------------------------------------------------------------------------------------------
; DrawTextField()
;-------------------------------------------------------------------------------------------------------
Function DrawTextField(t.TTextField, update = 0)
If (t <> ActiveText) And (Not update) Then
DrawBlock tidle, tx, ty
Return
End If
curline.TLine = tcurline
curx = tcurx
cury = tcury
;max width/height in characters
maxchar = (twidth / tCharWidth)
maxlines = (theight / tCharHeight)
;scroll textfield
If cury - tofy >= maxlines Then tofy = cury - maxlines + 1
If cury - tofy < 0 Then tofy = cury
If curx - tofx < 0 Then tofx = curx
If curx - tofx >= maxchar Then tofx = curx - maxchar + 1
;draw frame
Color 0, 0, tackgroundcolor
Rect tx, ty, twidth, theight
Color 0, 0, tordercolor
Rect tx, ty, twidth, theight, 0
;determine bottom
bottom = ty + theight
;get selection
If tsel(1)l <> Null Then sel1y = tsel(1)lid Else sel1y = 65536
If tsel(2)l <> Null Then sel2y = tsel(2)lid Else sel2y = -1
sel1x = tsel(1)c - tofx
sel2x = tsel(2)c - tofx
If sel1x < 0 Then sel1x = 0
If sel1x > maxchar Then sel1x = maxchar
If sel2x < 0 Then sel2x = 0
If sel2x > maxchar Then sel2x = maxchar
;determine order
If sel2y < sel1y Then
tempx = sel1x
tempy = sel1y
sel1x = sel2x
sel1y = sel2y
sel2x = tempx
sel2y = tempy
End If
If sel1y = sel2y Then
If sel2x < sel1x Then
tempx = sel1x
tempy = sel1y
sel1x = sel2x
sel1y = sel2y
sel2x = tempx
sel2y = tempy
End If
End If
;draw text area
iy = ty - tofy * tCharHeight
init = 0
For l.TLine = Each TLine
If lid = tofy Then init = 1
If init Then
;draw text
If (lid > sel1y) And (lid < sel2y) Then
SelText t, tx, iy, Mid$(ls$, tofx + 1, maxchar)
ElseIf (lid = sel1y) And (lid < sel2y) Then
d$ = Mid$(ls$, tofx + 1, maxchar)
d1$ = Left$(d$, sel1x)
d2$ = Mid$(d$, sel1x + 1)
BoxText t, tx, iy, d1$
SelText t, tx + Len(d1$) * tCharWidth, iy, d2$
ElseIf (lid > sel1y) And (lid = sel2y) Then
d$ = Mid$(ls$, tofx + 1, maxchar)
d1$ = Left$(d$, sel2x)
d2$ = Mid$(d$, sel2x + 1)
SelText t, tx, iy, d1$
BoxText t, tx + Len(d1$) * tCharWidth, iy, d2$
ElseIf (lid = sel1y) And (lid = sel2y) Then
d$ = Mid$(ls$, tofx + 1, maxchar)
d2$ = Mid$(d$, sel1x + 1, sel2x - sel1x)
BoxText t, tx, iy, d$
SelText t, tx + (sel1x * tCharWidth), iy, d2$
Else
BoxText t, tx, iy, Mid$(ls$, tofx + 1, maxchar)
End If
End If
iy = iy + tCharHeight
If iy + tCharHeight > bottom Then Exit
Next
;get cursor line
curline.TLine = GetLine(cury)
maxdd = Len(curlines$)
;draw cursor
cgx = tx + (tCharWidth * (curx - tofx))
cgy = ty + (tCharHeight * (cury - tofy))
Color 0, 0, tsel_backgroundcolor
If Not update Then Line cgx, cgy, cgx, cgy + tCharHeight
; Color 255, 255, 255
; Text cgx, cgy, Mid$(curlines$, curx + 1, 1)
;shift hit
If KeyHit(42) Then
SetMarker(1, cury, curx)
SetMarker(2, cury, curx)
End If
;max line size
maxdd = Len(curlines$)
;ctrl
If KeyDown(29) Then
;CTRL+A
If KeyHit(30) Then
SetMarker(1, 0, 0)
l.TLine = GetLine(numlines - 1)
SetMarker(2, numlines - 1, Len(ls$))
End If
;CTRL+D
If KeyHit(32) Then
SetMarker(1, 0, 0)
SetMarker(2, 0, 0)
End If
;CTRL+X
If KeyHit(45) Then
WriteClipBoardText(GetSelection$())
DeleteSel()
End If
;CTRL+C
If KeyHit(46) Then
WriteClipBoardText(GetSelection$())
ResetSel()
End If
;CTRL+V
If KeyHit(47) Then
rok$ = ReadClipBoardText$()
InsertLines(rok$, curx, cury)
curline = GetLine(cury)
maxdd = Len(curlines$)
ResetSel()
End If
;home
If KeyHit(199) Then
cury = 0
curline = GetLine(cury)
maxdd = Len(curlines$)
curx = 0
ResetSel
End If
;end
If KeyHit(207) Then
cury = numlines - 1
curline = GetLine(cury)
maxdd = Len(curlines$)
curx = maxdd
ResetSel
End If
Else
;KEYBOARD INPUT
ok = GetKey();iGetKey()
;INSERT
If KeyHit(210) Then ok = 32
;A-Z keys
If ok <> 0 Then
If curx < 0 Then curx = 0
If cury < 0 Then cury = 0
;check against abc$
If Instr(abc$, Upper$(Chr$(ok))) > 0 Then
;add character
curlines$ = Left$(curlines$, curx) + Chr$(ok) + Mid$(curlines$, curx + 1)
maxdd = Len(curlines$)
curx = curx + 1
ResetSel(1)
End If
End If
;enter
If KeyHit(28) Then
nl$ = Mid$(curlines$, curx + 1)
curlines$ = Left$(curlines$, curx)
l.TLine = AddLine(nl$)
Insert l After curline
cury = cury + 1
curx = 0
curline = l
maxdd = Len(curlines$)
UpdateLines()
ResetSel(1)
End If
;backspace
If KeyHit(14) Then
If curx > 0 Then
curlines$ = Left$(curlines$, curx - 1) + Mid$(curlines$, curx + 1)
curx = curx - 1
maxdd = Len(curlines$)
ResetSel(1)
Else
If cury > 0 Then
l.TLine = GetLine(cury - 1)
curx = Len(ls$)
ls$ = ls$ + curlines$
Delete curline
numlines = numlines - 1
UpdateLines()
cury = cury - 1
curline = l
maxdd = Len(ls$)
ResetSel(1)
End If
End If
End If
;home/end
If KeyHit(199) Then curx = 0: ResetSel
If KeyHit(207) Then curx = maxdd: ResetSel
End If
;pgup
If KeyHit(201) Then
ncury = cury - maxlines
If ncury < 0 Then ncury = 0
cury = ncury
curline = GetLine(cury)
maxdd = Len(curlines$)
ResetSel
End If
;pgdn
If KeyHit(209) Then
ncury = cury + maxlines
If ncury >= numlines Then ncury = numlines - 1
cury = ncury
curline = GetLine(cury)
maxdd = Len(curlines$)
ResetSel
End If
;left
If KeyHit(203) Then
curx = curx - 1
If curx < 0 Then
If cury > 0 Then
cury = cury - 1
curline.TLine = GetLine(cury)
maxdd = Len(curlines$)
curx = maxdd
Else
curx = 0
End If
End If
ResetSel
End If
;right
If KeyHit(205) Then
curx = curx + 1
If curx > maxdd Then
If cury < numlines - 1 Then
curx = 0
cury = cury + 1
curline = GetLine(cury)
maxdd = Len(curlines$)
End If
End If
ResetSel
End If
;up
If KeyHit(200) Then
cury = cury - 1
If cury < 0 Then cury = 0
curline.TLine = GetLine(cury)
maxdd = Len(curlines$)
ResetSel
End If
;down
If KeyHit(208) Then
cury = cury + 1
If cury >= numlines Then cury = numlines - 1
curline.TLine = GetLine(cury)
maxdd = Len(curlines$)
ResetSel
End If
If curx > maxdd Then curx = maxdd
;delete knop
If KeyHit(211) Then DeleteSel()
tcurline = curline
tcurx = curx
tcury = cury
End Function
;-------------------------------------------------------------------------------------------------------
; AddLine()
;-------------------------------------------------------------------------------------------------------
Function AddLine.TLine(s$)
l.TLine = New TLine
ls$ = s$
UpdateLines()
Return l
End Function
;-------------------------------------------------------------------------------------------------------
; UpdateLines()
;-------------------------------------------------------------------------------------------------------
Function UpdateLines()
id = 0
For l.TLine = Each TLine
lid = id
id = id + 1
Next
numlines = id
; curline.TLine = GetLine(cury)
End Function
;-------------------------------------------------------------------------------------------------------
; SetMarker()
;-------------------------------------------------------------------------------------------------------
Function SetMarker(id, liney, char)
l.TLine = Null
For il.TLine = Each TLine
If ilid = liney Then l = il: Exit
Next
If l = Null Then Return
tsel(id)l = l
tsel(id)c = char
If tsel(1)l = Null Then Return
If tsel(2)l = Null Then Return
End Function
;-------------------------------------------------------------------------------------------------------
; SelText()
;-------------------------------------------------------------------------------------------------------
;draw selected text
Function SelText(t.TTextField, x, y, s$)
ww = StringWidth(s$)
hh = StringHeight(s$)
Color 0, 0, tsel_backgroundcolor
Rect x, y, ww, hh
Color 0, 0, tsel_textcolor
Text x, y, Replace$(s$, Chr$(13), "")
End Function
;-------------------------------------------------------------------------------------------------------
; BoxText()
;-------------------------------------------------------------------------------------------------------
;draw non-selected text
Function BoxText(t.TTextField, x, y, s$)
Color 0, 0, t extcolor
Text x, y, s$
End Function
;-------------------------------------------------------------------------------------------------------
; GetLine()
;-------------------------------------------------------------------------------------------------------
;gets a specific line, else creates it
Function GetLine.TLine(i)
If i < 0 Then i = 0
If i > 65536 Then i = 65536
il.TLine = Null
For l.TLine = Each TLine
If lid = i Then il = l: Exit
Next
If il = Null Then
Repeat
il.TLine = AddLine("")
If ilid = i Then Exit
Until ilid = 65536
End If
Return il
End Function
;-------------------------------------------------------------------------------------------------------
; ResetSel()
;-------------------------------------------------------------------------------------------------------
Function ResetSel(rs = 0)
;shift
If KeyDown(42) And (Not rs) Then
SetMarker(2, cury, curx)
Else
SetMarker(1, cury, curx)
SetMarker(2, cury, curx)
End If
FlushKeys();iFlushKeys()
End Function
;-------------------------------------------------------------------------------------------------------
; DeleteSel()
;-------------------------------------------------------------------------------------------------------
Function DeleteSel()
;retreive selection
If tsel(1)l <> Null Then sel1y = tsel(1)lid Else Return
If tsel(2)l <> Null Then sel2y = tsel(2)lid Else Return
sel1x = tsel(1)c
sel2x = tsel(2)c
If sel1x < 0 Then sel1x = 0
If sel2x < 0 Then sel2x = 0
;determine order
id1 = 1
id2 = 2
If sel2y < sel1y Then
id1 = 2
id2 = 1
tempx = sel1x
tempy = sel1y
sel1x = sel2x
sel1y = sel2y
sel2x = tempx
sel2y = tempy
End If
If sel1y = sel2y Then
If sel2x < sel1x Then
id1 = 2
id2 = 1
tempx = sel1x
tempy = sel1y
sel1x = sel2x
sel1y = sel2y
sel2x = tempx
sel2y = tempy
End If
End If
;reset cursor
curx = tsel(id1)c
cury = tsel(id1)lid
;remove lines in between
For l.TLine = Each TLine
If (lid > sel1y) And (lid < sel2y) Then Delete l
Next
;same line?
If tsel(id1)l = tsel(id2)l Then
If (sel1x = 0) And (sel2x = Len(tsel(id2)ls$)) Then
Delete tsel(id1)l
Else
tsel(id1)ls$ = Left$(tsel(id1)ls$, sel1x) + Mid$(tsel(id1)ls$, sel2x + 1)
End If
Else
test = 1
;cut first line
If sel1x = 0 Then
Delete tsel(id1)l
test = 0
Else
tsel(id1)ls$ = Left$(tsel(id1)ls$, sel1x)
End If
;cut last line
If sel2x = Len(tsel(id2)ls$) Then
Delete tsel(id2)l
test = 0
Else
tsel(id2)ls$ = Mid$(tsel(id2)ls$, sel2x + 1)
End If
;paste together if needed
If test Then
tsel(id1)ls$ = tsel(id1)ls$ + tsel(id2)ls$
Delete tsel(id2)l
End If
End If
;update indexes and reset selection
UpdateLines()
ResetSel(1)
End Function
;-------------------------------------------------------------------------------------------------------
; GetSelection()
;-------------------------------------------------------------------------------------------------------
Function GetSelection$()
;retreive selection
If tsel(1)l <> Null Then sel1y = tsel(1)lid Else Return
If tsel(2)l <> Null Then sel2y = tsel(2)lid Else Return
sel1x = tsel(1)c
sel2x = tsel(2)c
id1 = 1
id2 = 2
;determine order
If sel2y < sel1y Then
id1 = 2
id2 = 1
End If
If sel1y = sel2y Then
If sel2x < sel1x Then
id1 = 2
id2 = 1
End If
End If
;same line ?
If tsel(id1)l = tsel(id2)l Then
If tsel(id1)c = tsel(id2)c Then
Return
Else
ss = tsel(id1)c + 1
ll = tsel(id2)c - ss + 1
Return Mid$(tsel(id1)ls$, ss, ll)
End If
End If
;get selection
s$ = ""
init = 0
For l.TLine = Each TLine
If l = tsel(id2)l Then
s$ = s$ + Left$(tsel(id2)ls$, tsel(id2)c)
init = 0
End If
If init Then
s$ = s$ + ls$ + Chr$(13)
End If
If l = tsel(id1)l Then
s$ = s$ + Mid$(tsel(id1)ls$, tsel(id1)c + 1) + Chr(13)
init = 1
End If
Next
;return selection
Return s$
End Function
;-----------------------------------------------------------------------------------------------------
; WriteClipBoardText()
;-----------------------------------------------------------------------------------------------------
Function WriteClipBoardText(txt$)
If txt$="" Then Return
txt$ = Replace$(txt$, Chr$(13), Chr$(13) + Chr$(10))
;-(A)--------------------------------------------------------------windows clipboard------------------
Local cb_TEXT=1
If OpenClipboard(0) ;if you get an error here, read the manual above or use alternative code below
EmptyClipboard
SetClipboardData cb_TEXT,txt$
CloseClipboard
EndIf
FreeBank txtbuffer
;--(B)--------------------------------------------------------------string as clipboard----------------
;alternative
; clipboard$ = txt$
End Function
;-----------------------------------------------------------------------------------------------------
; ReadClipBoardText()
;-----------------------------------------------------------------------------------------------------
Function ReadClipBoardText$()
;---(A)--
Local cb_TEXT=1
Local txt$=""
If OpenClipboard(0)
If ExamineClipboard(cb_TEXT)
txt$=GetClipboardData$(cb_TEXT)
EndIf
CloseClipboard
EndIf
;---(B)--
;alternative
; txt$ = clipboard$
;-----
txt$ = Replace$(txt$, Chr$(13) + Chr$(10), Chr$(13))
txt$ = Replace$(txt$, Chr$(9), " ")
Return txt$
End Function
;-----------------------------------------------------------------------------------------------------
; InsertLine()
;-----------------------------------------------------------------------------------------------------
Function InsertLine(r$, x, y)
If Right$(r$, 1) = Chr$(13) Then add = 1: r$ = Left$(r$, Len(r$) - 1)
If y < 0 Then y = 0
If x < 0 Then x = 0
If y > numlines Then y = numlines
l.TLine = GetLine(y)
If add Then
If x > 0 Then
r2$ = Mid$(ls$, x + 1)
ls$ = Left$(ls$, x) + r$
l2.TLine = AddLine(r2$)
Insert l2 After l
curx = 0
cury = cury + 1
Else
l2.TLine = AddLine(r$)
Insert l2 Before l
curx = 0
cury = cury + 1
End If
Else
ls$ = Left$(ls$, x) + r$ + Mid$(ls$, x + 1)
curx = curx + Len(r$)
End If
UpdateLines()
End Function
;-----------------------------------------------------------------------------------------------------
; InsertLines()
;-----------------------------------------------------------------------------------------------------
Function InsertLines(r$, x, y)
If Instr(r$, Chr$(13)) > 0 Then
Repeat
cc = Instr(r$, Chr$(13))
If cc = 0 Then Exit
r1$ = Left$(r$, cc)
r2$ = Mid$(r$, cc + 1)
InsertLine(r1$, x, y)
init = 0
x = 0
y = y + 1
r$ = r2$
Forever
End If
InsertLine(r$, x, y)
End Function
;-----------------------------------------------------------------------------------------------------
; UpdateText()
;-----------------------------------------------------------------------------------------------------
;grab screenshot to 'idle' image
Function UpdateText(t.TTextField)
DrawTextField t, 1
;store idle
CopyRect tx, ty, twidth, theight, 0, 0, BackBuffer(), ImageBuffer(tidle)
End Function
;-----------------------------------------------------------------------------------------------------
; DeleteTextField()
;-----------------------------------------------------------------------------------------------------
Function DeleteTextField(t.TTextField)
;free image
FreeImage tidle
;delete storage
For st.TStorage = Each TStorage
If st = t Then Delete st
Next
;delete temp lines
If t = ActiveText Then Delete Each TLine
;free font
FreeFont tfont
;delete type
Delete t
End Function
;-----------------------------------------------------------------------------------------------------
; SetActiveText()
;-----------------------------------------------------------------------------------------------------
Function SetActiveText(t.TTextField)
;if another is selected
If ActiveText <> Null Then
;delete storage
For st.TStorage = Each TStorage
If st = ActiveText Then Delete st
Next
;store temp lines
For l.TLine = Each TLine
st.TStorage = New TStorage
sts$ = ls$
stid = lid
st = ActiveText
Next
;store screenshot
UpdateText(ActiveText)
End If
;delete temp lines
Delete Each TLine
;select another text
ActiveText = t
If ActiveText = Null Then Return
;get lines from storage
For st.TStorage = Each TStorage
If st = t Then
l.TLine = New TLine
ls$ = sts$
lid = stid
End If
Next
UpdateLines()
;reset cursor
SetMarker 1, 0, 0
SetMarker 2, 0, 0
End Function
;-----------------------------------------------------------------------------------------------------
; SaveTextFile()
;-----------------------------------------------------------------------------------------------------
Function SaveTextFile(f$)
ff = WriteFile(f$)
For l.TLine = Each TLine
WriteLine ff, ls$
Next
CloseFile ff
End Function
;-----------------------------------------------------------------------------------------------------
; LoadTextFile()
;-----------------------------------------------------------------------------------------------------
Function LoadTextFile(f$)
Delete Each TLine
ff = ReadFile(f$)
While Not(Eof(ff))
AddLine(ReadLine(ff))
Wend
CloseFile ff
UpdateLines()
;reset cursor
SetMarker 1, 0, 0
SetMarker 2, 0, 0
End Function