Code archives/User Input/textfield
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
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
| ||
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? |
| ||
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/ |
| ||
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... |
| ||
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. 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. |
| ||
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! |
| ||
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. |
| ||
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 Archives Forum