Is there existing an inputroutine?

[Jawade]

OK, nice, but for passwords to 32 chars it is a bit starred. :-)

In the llast verion the following part must be removed:


If aa = Chr$(255, 134) Then
big = big Xor 3
ScreenRes 320*big, 240*big, 32: Width 80, 30: Color 0, -1:Cls
End If

[Jawade]

Now complete with 3-mode size and 2-mode Insert:

Code: Select all

'Choose 0, 1 Or 2 as parameter.


#INCLUDE "windows.bi"


Dim Shared mode As Integer
Dim Shared big As Integer
Dim Shared j As Integer
Dim Shared nn As String
Dim Shared pp As String
Declare Sub xText(x As Integer, y As Integer, bb As String, s As Integer, l As Integer)
Declare Sub pText(x As Integer, y As Integer, txt As String, fg As ulong, bg As ulong, mag As Integer)


Main:
    mode = Val(Command$)
    If mode = 0 Then big = 1
    If mode = 1 Then big = 1: ScreenRes 640, 480, 32: Width 80, 30
    If mode = 2 Then big = 2: ScreenRes 640, 480, 32: Width 80, 30
    If mode > 2 And mode < 0 Then Print "add 0, 1 or 2": System
    Color 0, -1: Cls
    pText(6*16, 5*32, "Name: ", 0, rgb(255,255,255), 2)
    xText(12, 5, nn, 0, 16)
    pText(2*16, 7*32, "Password: ", 0, rgb(255,255,255), 2)
    xText(12, 7, pp, 1, 20)
    Locate 18, 1: Print nn: Print pp'www
    Sleep
System


Sub xText(x As Integer, y As Integer, bb As String, s As Integer, l As Integer)
    Dim a As Integer = x - 1
    Dim i As Integer = 1
    Dim aa As String
    Locate y, x: bb = ""
    Do
        Do
            aa = InKey$: Sleep 3
            Line ((Pos - 1) * 8*big, CsrLin * 16*big - (2 + (GetKeyState(45) And 1))) - (Pos * 8*big, CsrLin * 16*big - 1), IIf(Frac(Timer) < .5, 0, -1), bf
        Loop Until aa <> ""
        Line ((Pos - 1) * 8*big, CsrLin * 16*big - 2) - (Pos * 8*big, CsrLin * 16*big - 1), -1, bf
        If Len(aa) = 1 Then
            If Asc(aa) = 8 Then
                If i = 1 Then
                ElseIf i < Len(bb) + 1 Then
                    i = i - 1
                    bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
                Else
                    bb = Left$(bb, Len(bb) - 1): i = i - 1
                    If i < 1 Then i = 1
                End If
            End If
            If Asc(aa) > 31 Then
                If Len(bb) < l Then
                    If i < Len(bb) + 1 Then
                        bb = Left$(bb, i-1) + aa + Mid$(bb, i + (GetKeyState(45) And 1))
                        i = i + 1
                    Else
                        bb = bb + aa: i = i + 1
                    End If
                End If
            End If
        End If
        If Len(aa) = 2 Then
            If aa = Chr$(255, 71) Then i = 1
            If aa = Chr$(255, 79) Then i = Len(bb) + 1
            If aa = Chr$(255, 75) Then
                Print Chr$(8);
                i = i - 1: If i < 1 Then i = 1
            End If
            If aa = Chr$(255, 77) Then
                If big = 1 Then Print Chr$(11);
                i = i + 1: If i > Len(bb) + 1 Then i = Len(bb) + 1
            End If
            If aa = Chr$(255, 83) Then
                bb = Left$(bb, i - 1) + Mid$(bb, i + 1)
            End If
        End If
        If s Then
            pText(x*16, y*32, Left$("*********************", Len(bb)) + " ", 0, rgb(255,255,255), 2) 'UTF-8 adjustment.
            'pText(x*16, y*32, String$(Len(bb), "*")+" ", 0, -1, 2)
            Locate , i + a
        Else
            pText(x*16, y*32, bb+" ", 0, rgb(255,255,255), 2)
            Locate , i + a
        End If
    Loop Until aa = Chr$(27) Or aa = Chr$(13)
End Sub


Sub pText(x As Integer, y As Integer, txt As String, fg As ulong, bg As ulong, mag As Integer)
    If big = 2 Then
        x = x - big*8: y = y - big*16
        If ScreenPtr()=0 Then Return ' no screen
        var n = Len(txt) : If n < 1 Then Return ' no chars
        n Shl = 3 ' nPixels = nChars * fontwidth
        var img = imagecreate(n, 16, bg)
        If img = 0 Then Return
        draw String img,(0, 0), txt, fg
        For j As Integer = 0 To 15
            For i As Integer = 0 To n - 1
                Line (i*mag+x,j*mag+y)-Step(mag-1,mag-1), Point(i,j,img),bf
            Next
        Next
        imagedestroy img
    End If
    If big = 1 Then
        Color fg, bg
        Locate y / 32, x / 16
        Print txt;
    End If
End Sub