textfield

This code has been declared by its author to be Public Domain code.

textfield by b32

2007

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.

;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;'\ZXCVBNM,./* 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, t\x, t\y, t\width, t\height) 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
	t\x = x
	t\y = y
	t\width = ww
	t\height = hh
	
	;font
	t\font = LoadFont("Blitz")
	SetFont t\font
	
	;font size
	t\CharWidth = StringWidth("X")
	t\CharHeight = StringHeight("X")
	
	;scroll
	t\ofx = 0
	t\ofy = 0
	
	t\limitchars = limitchars
	t\passwordmask$ = pwmask$
	t\noenter = noenter

	t\backgroundcolor		= $225588
	t\bordercolor			= $555555
	t\textcolor				= $FFFFFF
	t\keywordcolor			= $AADDFF
	t\sel_backgroundcolor	= $DDAA77
	t\sel_textcolor			= $000000
	t\cursorcolor			= $DDAA77
	t\commentcolor			= $FFEE00
		
	t\idle = CreateImage(t\width, t\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 t\idle, t\x, t\y
		Return
	End If
	
	limitchars = t\limitchars

	curline.TLine = t\curline
	curx = t\curx
	cury = t\cury
	If limitchars > 0 Then If curx > limitchars Then curx = limitchars
	If t\noenter Then If cury > 0 Then cury = 0

	;max width/height in characters
	maxchar = (t\width / t\CharWidth)
	maxlines = (t\height / t\CharHeight)

	;scroll textfield
	If cury - t\ofy >= maxlines Then t\ofy = cury - maxlines + 1
	If cury - t\ofy < 0 Then t\ofy = cury
	If curx - t\ofx < 0 Then t\ofx = curx
	If curx - t\ofx >= maxchar Then t\ofx = curx - maxchar + 1
	

	;draw frame	
	Color 0, 0, t\backgroundcolor
	Rect t\x, t\y, t\width, t\height
	Color 0, 0, t\bordercolor
	Rect t\x, t\y, t\width, t\height, 0
	
	Viewport t\x, t\y, t\width, t\height

	;determine bottom	
	bottom = t\y + t\height
		
	;get selection
	If tsel(1)\l <> Null Then 
		sel1y = tsel(1)\l\id
		sel1x = tsel(1)\c - t\ofx
	Else
		sel1y = 0
		sel1x = 0
	End If
	
	If tsel(2)\l <> Null Then 
		sel2y = tsel(2)\l\id
		sel2x = 0
	Else
		sel2y = 0
		sel2x = 0
	End If

	sel2x = tsel(2)\c - t\ofx

	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\noenter Then If l <> First TLine Then Delete l
	Next

	;draw text area
	SetFont t\font
	iy = t\y - t\ofy * t\CharHeight
	init = 0
	For l.TLine = Each TLine
		If limitchars > 0 Then If Len(l\s$ > limitchars) Then l\s$ = Left$(l\s$, limitchars)
		If l\id = t\ofy Then init = 1
		
		linetext$ = l\s$
		If t\passwordmask$ <> "" Then linetext$ = String$(t\passwordmask$, Len(l\s$))
		
		If init Then
		
			;draw text
			If (l\id > sel1y) And (l\id < sel2y) Then

				SelText t, t\x, iy, Mid$(linetext$, t\ofx + 1, maxchar)

			ElseIf (l\id = sel1y) And (l\id < sel2y) Then

				d$ = Mid$(linetext$, t\ofx + 1, maxchar)
								
				d1$ = Left$(d$, sel1x)
				d2$ = Mid$(d$, sel1x + 1)
							
				;BoxText t, t\x, iy, d1$
				BoxText2 t, t\x, iy, linetext$, t\ofx + 1, sel1x
				SelText t, t\x + Len(d1$) * t\CharWidth, iy, d2$

			ElseIf (l\id > sel1y) And (l\id = sel2y) Then

				d$ = Mid$(linetext$, t\ofx + 1, maxchar)
								
				d1$ = Left$(d$, sel2x)
				d2$ = Mid$(d$, sel2x + 1)
							
				;BoxText t, t\x + Len(d1$) * t\CharWidth, iy, d2$
				BoxText2 t, t\x + Len(d1$) * t\CharWidth, iy, linetext$, t\ofx + 1 + sel2x, maxchar - sel2x
				SelText t, t\x, iy, d1$

			ElseIf (l\id = sel1y) And (l\id = sel2y) Then

				d$ = Mid$(linetext$, t\ofx + 1, maxchar)
				d2$ = Mid$(d$, sel1x + 1, sel2x - sel1x)
				
				BoxText2 t, t\x, iy, linetext$, t\ofx + 1, maxchar
				;BoxText t, t\x, iy, d$
				SelText t, t\x + (sel1x * t\CharWidth), iy, d2$

			Else

				;BoxText t, t\x, iy, Mid$(linetext$, t\ofx + 1, maxchar)
				BoxText2 t, t\x, iy, linetext$, t\ofx + 1, maxchar

			End If
						
		End If

		iy = iy + t\CharHeight
		If iy + t\CharHeight > bottom Then Exit

	Next

	;get cursor line
	curline.TLine = GetLine(cury)
	maxdd = Len(curline\s$)
	
	;draw cursor	
	cgx = t\x + (t\CharWidth * (curx - t\ofx))
	cgy = t\y + (t\CharHeight * (cury - t\ofy))
	Color 0, 0, t\sel_backgroundcolor
	If Not update Then Line cgx, cgy, cgx, cgy + t\CharHeight
;	Color 255, 255, 255
;	Text cgx, cgy, Mid$(curline\s$, curx + 1, 1)

	;shift hit
	If KeyHit(42) Then
		SetMarker(1, cury, curx)
		SetMarker(2, cury, curx)
	End If
	
;	;current line size
;	maxdd = Len(curline\s$)
		
	;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(l\s$))
			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, t\limitchars)
			curline = GetLine(cury)
			maxdd = Len(curline\s$)
			ResetSel()
		End If		

		;home
		If KeyHit(199) Then 
			curx = 0
			cury = 0
			curline = GetLine(cury)
			maxdd = Len(curline\s$)
			ResetSel
		End If
		
		;end
		If KeyHit(207) Then 
			cury = numlines - 1
			curline = GetLine(cury)
			maxdd = Len(curline\s$)
			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			
				curline\s$ = Left$(curline\s$, curx) + Chr$(ok) + Mid$(curline\s$, curx + 1)
				maxdd = Len(curline\s$)
				curx = curx + 1
				ResetSel(1)
			End If
		End If
		
		;tab
		If MyKeyHit(15) Then
			If CheckSelected() Then 
				TabSelected(0)
			Else
				;add tab
				curline\s$ = Left$(curline\s$, curx) + "    " + Mid$(curline\s$, curx + 1)
				maxdd = Len(curline\s$)
				curx = curx + 4
				ResetSel(1)
			End If
		End If		
		
		;enter
		If MyKeyHit(28) Then
			DeleteSel()
			nl$ = Mid$(curline\s$, curx + 1)
			curline\s$ = Left$(curline\s$, curx)
			l.TLine = AddLine(nl$)
			Insert l After curline
			cury = cury + 1
			curx = 0
			curline = l
			maxdd = Len(curline\s$)
			UpdateLines()
			ResetSel(1)
		End If
		
		;backspace
		If MyKeyHit(14) Then
			If CheckSelected() Then
				DeleteSel()
				ResetSel(1)
			Else
				If curx > 0 Then
					curline\s$ = Left$(curline\s$, curx - 1) + Mid$(curline\s$, curx + 1)
					curx = curx - 1
					maxdd = Len(curline\s$)
					ResetSel(1)
				Else
					If cury > 0 Then
						l.TLine = GetLine(cury - 1)
						curx = Len(l\s$)
						l\s$ = l\s$ + curline\s$
						Delete curline
						numlines = numlines - 1
						UpdateLines()
						cury = cury - 1
						curline = l
						maxdd = Len(l\s$)
						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(curline\s$)
		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(curline\s$)
		ResetSel
	End If
	
	;left	
	If MyKeyHit(203) Then 
		If ctrl Then
			Repeat
				curx = curx - 1
				If curx < 1 Then Exit
				If Mid$(curline\s$, 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(curline\s$)
				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$(curline\s$, 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(curline\s$)
			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(curline\s$)
		ResetSel
	End If
	
	;down
	If MyKeyHit(208) Then 
		cury = cury + 1
		If cury >= numlines Then cury = numlines - 1
		curline.TLine = GetLine(cury)
		maxdd = Len(curline\s$)
		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
				curline\s$ = Left$(curline\s$, curx) + Mid$(curline\s$, curx + 2)
				maxdd = Len(curline\s$)
				ResetSel(1)
			End If
		End If
	End If

	t\curline = curline
	t\curx = curx
	t\cury = cury
	
	Viewport 0, 0, GraphicsWidth(), GraphicsHeight()
						
End Function

;-------------------------------------------------------------------------------------------------------
;										      AddLine()
;-------------------------------------------------------------------------------------------------------
Function AddLine.TLine(s$)

	l.TLine = New TLine
	l\s$ = s$
	UpdateLines()
	
	Return l
	
End Function

;-------------------------------------------------------------------------------------------------------
;									       UpdateLines()
;-------------------------------------------------------------------------------------------------------
Function UpdateLines()

	id = 0
	For l.TLine = Each TLine
		l\id = 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 il\id = 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, t\sel_backgroundcolor
	Rect x, y, ww, hh
	Color 0, 0, t\sel_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, t\commentcolor
		test = 1
	Else
		Color 0, 0, t\textcolor
		test = 0
	End If
	Text x, y, s$
	
	If test Then Return

	Color 0, 0, t\keywordcolor
	l$ = " " + Lower$(s$)	+ " "
	For k.KeyWord = Each KeyWord
		
		If Instr(l$, Lower$(k\s$)) Then

			test = 0
			Repeat
			
				test = Instr(l$, Lower$(k\s$), test + 1)
				If test < 1 Then Exit
								
				Text x + (test - 1) * t\CharWidth, y, Mid$(s$, test, Len(k\s$) - 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, t\commentcolor
		test = 1
	Else
		Color 0, 0, t\textcolor
		test = 0
	End If
	Text x, y, Mid$(s$, st, ll)
	
	If test Then Return

	Color 0, 0, t\keywordcolor
	l$ = " " + Lower$(s$)	+ " "
	For k.KeyWord = Each KeyWord
		
		If Instr(l$, Lower$(k\s$)) Then

			test = 0
			Repeat
			
				test = Instr(l$, Lower$(k\s$), test + 1)
				If test < 1 Then Exit
				
				x1 = x + (test - st) * t\CharWidth
				ll = (Len(k\s$) - 2) * t\CharWidth
				
				If (x1 + ll >= t\x) And (x1 <= t\x + t\width) Then
					Text x1, y, Mid$(s$, test, Len(k\s$) - 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 l\id = i Then il = l: Exit
	Next
	
	If il = Null Then
		Repeat
			il.TLine = AddLine("")
			If il\id = i Then Exit
		Until il\id = 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)\l\id Else Return
	If tsel(2)\l <> Null Then sel2y = tsel(2)\l\id 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)\l\id

	;remove lines in between	
	For l.TLine = Each TLine
		If (l\id > sel1y) And (l\id < sel2y) Then Delete l
	Next

	;same line?
	If tsel(id1)\l = tsel(id2)\l Then
		If (sel1x = 0) And (sel2x = Len(tsel(id2)\l\s$)) Then
			Delete tsel(id1)\l
		Else
			tsel(id1)\l\s$ = Left$(tsel(id1)\l\s$, sel1x) + Mid$(tsel(id1)\l\s$, sel2x + 1)
		End If
	Else
		test = 1

		;cut first line		
		If sel1x = 0 Then 
			Delete tsel(id1)\l
			test = 0
		Else
			tsel(id1)\l\s$ = Left$(tsel(id1)\l\s$, sel1x)			
		End If

		;cut last line		
		If sel2x = Len(tsel(id2)\l\s$) Then
			Delete tsel(id2)\l
			test = 0
		Else
			tsel(id2)\l\s$ = Mid$(tsel(id2)\l\s$, sel2x + 1)
		End If

		;paste together if needed		
		If test Then 
			tsel(id1)\l\s$ = tsel(id1)\l\s$ + tsel(id2)\l\s$
			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)\l\id Else Return
	If tsel(2)\l <> Null Then sel2y = tsel(2)\l\id 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)\l\s$, 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)\l\s$, tsel(id2)\c)
			init = 0
		End If
		If init Then
			s$ = s$ + l\s$ + Chr$(13)
		End If
		If l = tsel(id1)\l Then 
			s$ = s$ + Mid$(tsel(id1)\l\s$, 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$(l\s$, x + 1)
			l\s$ = Left$(l\s$, 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
		l\s$ = Left$(l\s$, x) + r$ + Mid$(l\s$, 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(l\s$) > limitchars Then l\s$ = Left$(l\s$, limitchars)
		Next
	End If
	
End Function

;-----------------------------------------------------------------------------------------------------
;											UpdateText()
;-----------------------------------------------------------------------------------------------------
;grab screenshot to 'idle' image
Function UpdateText(t.TTextField)

	DrawTextField t, 1
	;store idle
	CopyRect t\x, t\y, t\width, t\height, 0, 0, BackBuffer(), ImageBuffer(t\idle)

End Function

;-----------------------------------------------------------------------------------------------------
;											DeleteTextField()
;-----------------------------------------------------------------------------------------------------
Function DeleteTextField(t.TTextField)

	;free image
	FreeImage t\idle
	
	;delete storage
	For st.TStorage = Each TStorage
		If st\t = t Then Delete st
	Next

	;delete temp lines
	If t = ActiveText Then Delete Each TLine

	;free font	
	FreeFont t\font
	
	;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\t = ActiveText Then Delete st
		Next
		;store temp lines
		For l.TLine = Each TLine
			st.TStorage = New TStorage
			st\s$ = l\s$
			st\id = l\id
			st\t = 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 = t Then
			l.TLine = New TLine
			l\s$ = st\s$
			l\id = st\id
		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, l\s$
	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)\l\id Else Return
	If tsel(2)\l <> Null Then sel2y = tsel(2)\l\id Else Return
	
	sel1x = tsel(1)\c
	sel2x = tsel(2)\c
	
	;determine order	
	If sel2y < sel1y Then
		sel1y = tsel(2)\l\id
		sel2y = tsel(1)\l\id
	End If

	Select tab
	
	Case 0
		;add tabs
		For l.TLine = Each TLine
			If (l\id >= sel1y) And (l\id <= sel2y) Then l\s$ = "    " + l\s$
		Next
		
	Case 1
		;remove tabs
		For l.TLine = Each TLine
			If (l\id >= sel1y) And (l\id <= sel2y) Then 
				If Left$(l\s$, 4) = "    " Then l\s$ = Mid$(l\s$, 5)
			End If
		Next
		
	End Select
	
End Function

;-----------------------------------------------------------------------------------------------------
;												ReadKeyWord()
;-----------------------------------------------------------------------------------------------------
Function ReadKeyWords()

	Restore
	
	Repeat
	
		Read o$
		If o$ = "*STOP*" Then Exit
		
		k.KeyWord = New KeyWord
		k\s$ = " " + 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

2007

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

2007

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+Search
Usually, 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:
http://www.processlibrary.com/directory/files/user32/

Yahfree

2007

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 nice

Edit: also you should include your IgetKey() function to enable the num-pad...

b32

2007

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 \textcolor 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
		s\code = scanc
		s\key$ = Lower$(Mid$("1234567890-=QWERTYUIOP[]ASDFGHJKL;'\ZXCVBNM,./* 789-456+1230.,/" + Chr$(8) + Chr$(13) + Chr$(13), tel, 1))
		s\upkey$ = 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
		s\isdown = KeyDown(s\code)
	Next
	FlushKeys()

End Function

Global oldkdown
;-----------------------------------------------------------------------------------------------------
;											iGetKey()
;-----------------------------------------------------------------------------------------------------
;imitates GetKey() using scancodes
Function iGetKey()

	;read scancodes
	For s.ScanCode = Each ScanCode
		down = KeyDown(s\code)
		If down And (Not s\isdown) Then 
			tk.TKeyDown = New TKeyDown
			tk\s = s
		End If
		s\isdown = down
	Next

	tk.TKeyDown = First TKeyDown
	If tk = Null Then Return
	
	sel.ScanCode = tk\s
	If sel = Null Then Return
	
	oldkdown = sel\code
	
	Delete tk
			
	;shift for uppercase	
	If KeyDown(42) Or KeyDown(54) Then
		sc$ = sel\upkey$
	Else
		sc$ = sel\key$
	End If

	;return ascii value of key	
	Return Asc(sc$)

End Function

;"1234567890-=QWERTYUIOP[]ASDFGHJKL;'\ZXCVBNM,./* 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

2007

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

2007

Also some simple tweaks.

Add fields to the Type TTextField
Field password
Field MaxCharLength

Call Function CreateTextField.TTextField(x, y, width, height, password=False)

With optional password field.

For the Box and Sel text functions do something like:


	If T\password=False Then 
		Text x, y, s$
	Else
		For starlength= 0 To Len(s$)
			startext$ = startext$ + "*"
		Next
		Text x, y, startext$
	End If

Now what you type shows up as those pretty stars. For max length just hold that counter and when youre typing exceeds it, prevent it.

Just my two cents for extra features.

b32

2007

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 files\blitz\userlibs 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;'\ZXCVBNM,./* 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, t\x, t\y, t\width, t\height) 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
	t\x = x
	t\y = y
	t\width = width
	t\height = height
	
	;use only fonts with a fixed width (ocr a extended, fixedsys, blitz etc.)
	t\font = LoadFont("FixedSys");"Blitz"
	SetFont t\font
	
	;font size
	t\CharWidth = StringWidth("X")
	t\CharHeight = StringHeight("X")
	
	;scroll
	t\ofx = 0
	t\ofy = 0

	t\backgroundcolor		= $225588
	t\bordercolor			= $555555
	t\textcolor				= $DDDDFF
	t\sel_backgroundcolor	= $DDAA77
	t\sel_textcolor			= $000000
	t\cursorcolor			= $DDAA77
	
	t\idle = 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 t\idle, t\x, t\y
		Return
	End If

	curline.TLine = t\curline
	curx = t\curx
	cury = t\cury

	;max width/height in characters
	maxchar = (t\width / t\CharWidth) 
	maxlines = (t\height / t\CharHeight)

	;scroll textfield
	If cury - t\ofy >= maxlines Then t\ofy = cury - maxlines + 1
	If cury - t\ofy < 0 Then t\ofy = cury
	If curx - t\ofx < 0 Then t\ofx = curx
	If curx - t\ofx >= maxchar Then t\ofx = curx - maxchar + 1

	;draw frame	
	Color 0, 0, t\backgroundcolor
	Rect t\x, t\y, t\width, t\height
	Color 0, 0, t\bordercolor
	Rect t\x, t\y, t\width, t\height, 0

	;determine bottom	
	bottom = t\y + t\height
		
	;get selection
	If tsel(1)\l <> Null Then sel1y = tsel(1)\l\id Else sel1y = 65536
	If tsel(2)\l <> Null Then sel2y = tsel(2)\l\id Else sel2y = -1

	sel1x = tsel(1)\c - t\ofx
	sel2x = tsel(2)\c - t\ofx

	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 = t\y - t\ofy * t\CharHeight
	init = 0
	For l.TLine = Each TLine
		If l\id = t\ofy Then init = 1
		If init Then
		
			;draw text
			If (l\id > sel1y) And (l\id < sel2y) Then

				SelText t, t\x, iy, Mid$(l\s$, t\ofx + 1, maxchar)

			ElseIf (l\id = sel1y) And (l\id < sel2y) Then

				d$ = Mid$(l\s$, t\ofx + 1, maxchar)
								
				d1$ = Left$(d$, sel1x)
				d2$ = Mid$(d$, sel1x + 1)
							
				BoxText t, t\x, iy, d1$
				SelText t, t\x + Len(d1$) * t\CharWidth, iy, d2$

			ElseIf (l\id > sel1y) And (l\id = sel2y) Then

				d$ = Mid$(l\s$, t\ofx + 1, maxchar)
								
				d1$ = Left$(d$, sel2x)
				d2$ = Mid$(d$, sel2x + 1)
							
				SelText t, t\x, iy, d1$
				BoxText t, t\x + Len(d1$) * t\CharWidth, iy, d2$

			ElseIf (l\id = sel1y) And (l\id = sel2y) Then

				d$ = Mid$(l\s$, t\ofx + 1, maxchar)
				d2$ = Mid$(d$, sel1x + 1, sel2x - sel1x)
				
				BoxText t, t\x, iy, d$
				SelText t, t\x + (sel1x * t\CharWidth), iy, d2$

			Else

				BoxText t, t\x, iy, Mid$(l\s$, t\ofx + 1, maxchar)

			End If
						
		End If

		iy = iy + t\CharHeight
		If iy + t\CharHeight > bottom Then Exit

	Next

	;get cursor line
	curline.TLine = GetLine(cury)
	maxdd = Len(curline\s$)

	;draw cursor	
	cgx = t\x + (t\CharWidth * (curx - t\ofx))
	cgy = t\y + (t\CharHeight * (cury - t\ofy))
	Color 0, 0, t\sel_backgroundcolor
	If Not update Then Line cgx, cgy, cgx, cgy + t\CharHeight
;	Color 255, 255, 255
;	Text cgx, cgy, Mid$(curline\s$, curx + 1, 1)

	;shift hit
	If KeyHit(42) Then
		SetMarker(1, cury, curx)
		SetMarker(2, cury, curx)
	End If
	
	;max line size
	maxdd = Len(curline\s$)
		
	;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(l\s$))
		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(curline\s$)
			ResetSel()
		End If		

		;home
		If KeyHit(199) Then 
			cury = 0
			curline = GetLine(cury)
			maxdd = Len(curline\s$)
			curx = 0
			ResetSel
		End If
		
		;end
		If KeyHit(207) Then 
			cury = numlines - 1
			curline = GetLine(cury)
			maxdd = Len(curline\s$)
			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			
				curline\s$ = Left$(curline\s$, curx) + Chr$(ok) + Mid$(curline\s$, curx + 1)
				maxdd = Len(curline\s$)
				curx = curx + 1
				ResetSel(1)
			End If
		End If
		
		;enter
		If KeyHit(28) Then
			nl$ = Mid$(curline\s$, curx + 1)
			curline\s$ = Left$(curline\s$, curx)
			l.TLine = AddLine(nl$)
			Insert l After curline
			cury = cury + 1
			curx = 0
			curline = l
			maxdd = Len(curline\s$)
			UpdateLines()
			ResetSel(1)
		End If
		
		;backspace
		If KeyHit(14) Then
			If curx > 0 Then
				curline\s$ = Left$(curline\s$, curx - 1) + Mid$(curline\s$, curx + 1)
				curx = curx - 1
				maxdd = Len(curline\s$)
				ResetSel(1)
			Else
				If cury > 0 Then
					l.TLine = GetLine(cury - 1)
					curx = Len(l\s$)
					l\s$ = l\s$ + curline\s$
					Delete curline
					numlines = numlines - 1
					UpdateLines()
					cury = cury - 1
					curline = l
					maxdd = Len(l\s$)
					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(curline\s$)
		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(curline\s$)
		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(curline\s$)
				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(curline\s$)
			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(curline\s$)
		ResetSel
	End If
	
	;down
	If KeyHit(208) Then 
		cury = cury + 1
		If cury >= numlines Then cury = numlines - 1
		curline.TLine = GetLine(cury)
		maxdd = Len(curline\s$)
		ResetSel
	End If
	
	If curx > maxdd Then curx = maxdd
	
	;delete knop
	If KeyHit(211) Then DeleteSel()	

	t\curline = curline
	t\curx = curx
	t\cury = cury
						
End Function

;-------------------------------------------------------------------------------------------------------
;										      AddLine()
;-------------------------------------------------------------------------------------------------------
Function AddLine.TLine(s$)

	l.TLine = New TLine
	l\s$ = s$
	UpdateLines()
	
	Return l
	
End Function

;-------------------------------------------------------------------------------------------------------
;									       UpdateLines()
;-------------------------------------------------------------------------------------------------------
Function UpdateLines()

	id = 0
	For l.TLine = Each TLine
		l\id = 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 il\id = 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, t\sel_backgroundcolor
	Rect x, y, ww, hh
	Color 0, 0, t\sel_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\textcolor
	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 l\id = i Then il = l: Exit
	Next
	
	If il = Null Then
		Repeat
			il.TLine = AddLine("")
			If il\id = i Then Exit
		Until il\id = 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)\l\id Else Return
	If tsel(2)\l <> Null Then sel2y = tsel(2)\l\id 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)\l\id

	;remove lines in between	
	For l.TLine = Each TLine
		If (l\id > sel1y) And (l\id < sel2y) Then Delete l
	Next

	;same line?
	If tsel(id1)\l = tsel(id2)\l Then
		If (sel1x = 0) And (sel2x = Len(tsel(id2)\l\s$)) Then
			Delete tsel(id1)\l
		Else
			tsel(id1)\l\s$ = Left$(tsel(id1)\l\s$, sel1x) + Mid$(tsel(id1)\l\s$, sel2x + 1)
		End If
	Else
		test = 1

		;cut first line		
		If sel1x = 0 Then 
			Delete tsel(id1)\l
			test = 0
		Else
			tsel(id1)\l\s$ = Left$(tsel(id1)\l\s$, sel1x)			
		End If

		;cut last line		
		If sel2x = Len(tsel(id2)\l\s$) Then
			Delete tsel(id2)\l
			test = 0
		Else
			tsel(id2)\l\s$ = Mid$(tsel(id2)\l\s$, sel2x + 1)
		End If

		;paste together if needed		
		If test Then 
			tsel(id1)\l\s$ = tsel(id1)\l\s$ + tsel(id2)\l\s$
			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)\l\id Else Return
	If tsel(2)\l <> Null Then sel2y = tsel(2)\l\id 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)\l\s$, 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)\l\s$, tsel(id2)\c)
			init = 0
		End If
		If init Then
			s$ = s$ + l\s$ + Chr$(13)
		End If
		If l = tsel(id1)\l Then 
			s$ = s$ + Mid$(tsel(id1)\l\s$, 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$(l\s$, x + 1)
			l\s$ = Left$(l\s$, 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
		l\s$ = Left$(l\s$, x) + r$ + Mid$(l\s$, 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 t\x, t\y, t\width, t\height, 0, 0, BackBuffer(), ImageBuffer(t\idle)

End Function

;-----------------------------------------------------------------------------------------------------
;											DeleteTextField()
;-----------------------------------------------------------------------------------------------------
Function DeleteTextField(t.TTextField)

	;free image
	FreeImage t\idle
	
	;delete storage
	For st.TStorage = Each TStorage
		If st\t = t Then Delete st
	Next

	;delete temp lines
	If t = ActiveText Then Delete Each TLine

	;free font	
	FreeFont t\font
	
	;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\t = ActiveText Then Delete st
		Next
		;store temp lines
		For l.TLine = Each TLine
			st.TStorage = New TStorage
			st\s$ = l\s$
			st\id = l\id
			st\t = 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 = t Then
			l.TLine = New TLine
			l\s$ = st\s$
			l\id = st\id
		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, l\s$
	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

Code Archives Forum