[bb] textfield by b32 [ 1+ years ago ]

Started by BlitzBot, June 29, 2017, 00:28:39

Previous topic - Next topic
Print
Go Down Pages1
User actions

BlitzBot

June 29, 2017, 00:28:39
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 :
Code: blitzbasic
;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.
Code: BASIC
;-----------------------------------------------------------------------------------------------------
;										   **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:
Code: BASIC

	If Tpassword=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(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:
Code: BASIC
;-----------------------------------------------------------------------------------------------------
;										   **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

Print
Go Up Pages1
User actions