Author Topic: [bb] textfield by b32 [ 1+ years ago ] (Read 594 times)

BlitzBot · « **on:** June 29, 2017, 12:28:39 AM »

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
 
        tackgroundcolor                = $225588
        tordercolor                    = $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, tackgroundcolor
        Rect tx, ty, twidth, theight
        Color 0, 0, tordercolor
        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/[/url]

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: [Select]

;-----------------------------------------------------------------------------------------------------
;										   **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: [Select]


	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: [Select]

;-----------------------------------------------------------------------------------------------------
;										   **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

Author Topic: [bb] textfield by b32 [ 1+ years ago ] (Read 594 times)

BlitzBot

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