fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
Eingabe Box für Console Modus

Uploader:	RockTheSchock
Datum/Zeit:	05.09.2013 16:43:03
Sub MQPrint OverLoad(text as String, fgcolor as Integer=-1,bgcolor as Integer=-1)

Dim curc as Integer



if fgcolor>-1  then

    curc = Color()

    If bgcolor>-1 Then color fgcolor,bgcolor Else color fgcolor

    Print text;

    color curc

else

    Print text;

end If

End Sub



Sub MQPrint OverLoad(column As Integer,row As Integer, text as String, colr as Integer=-1)

    Dim curcol As Integer

    Dim currow As Integer



    curcol=Pos()

    currow=CsrLin()



    Locate row,column

    MQPrint text, colr

    Locate currow,curcol

End Sub





Function TextField(row As Integer, col As Integer, size As Integer, maxsize As Integer=50) As String

    Dim text As String

    Dim changed As Integer



    Dim key As String

    Dim askey As Integer



    Dim oldrow As Integer

    Dim oldcol As Integer

    Dim oldcolor As Integer



    Dim char(0 To 2,size+1) As Integer

    Dim fgcolor(0 To 2,size+1) As Integer

    Dim bgcolor(0 To 2,size+1) As Integer



    Dim w As Integer, h As Integer

    Dim depth As Integer

    ScreenInfo w, h, depth



    'save background

    For i As Integer = 0 To UBound(fgcolor)

        For j As Integer = 0 To UBound(fgcolor,2)

            char(i,j)=Screen(row+i,col+j)

            fgcolor(i,j)=Screen(row+i,col+j,1) And &hf

            bgcolor(i,j)=Screen(row+i,col+j,2) Shr 4

        Next

    Next



    'save cursor position

    Dim curpos As Integer

    curpos=1



    'save CusorState

    oldrow = CsrLin()

    oldcol = Pos()



    'save color

    oldcolor = Color()







    'Draw Box

    Locate row,col

    Print Chr(201);String(size,205);Chr(187)

    Locate row+1,col

    Print Chr(186);Space(size);Chr(186)

    Locate row+2,col

    Print Chr(200);String(size,205);Chr(188)



    'Set blinking cursor at right position

    Locate row+1,col+1,1

    Do

        key   = InKey()

        askey = Asc(key)



        Select Case askey

            Case 32 To 127 'All readable chars

                If Len(text)<maxsize Then

                    text=text+key

                    If curpos<=size Then curpos = curpos+1

                    changed = 1

                EndIf

            Case 13             'Return

                Exit Do

            Case 27         'Escape

                text = ""

                Exit Do

            Case 8          'Backspace

                If Len(text)>0 Then

                    text = Left(text,Len(text)-1)

                    curpos=curpos-1

                    If curpos<1 Then curpos=1

                    If Len(text)>=size Then curpos=size+1

                    changed = 1

                End if

        End Select



        If changed Then

            Locate row+1,col+1

            Print Right(text,size)+Space(size-Len(Text));

            Locate row+1,col+curpos

            changed=0

        EndIf



    Loop



    'Restore Background

    For i As Integer = 0 To UBound(fgcolor)

        For j As Integer = 0 To UBound(fgcolor,2)

            Color fgcolor(i,j),bgcolor(i,j)

            Locate row+i,col+j

            Print Chr(char(i,j));

        Next

    Next



    Color oldcolor

    Locate oldrow,oldcol,0

    Return text

End FUNCTION



Dim i As Integer





Screen 0

Width 80,25

Color 1,9

For i = 1 To 80*25

    Print chr((i Mod 26)+65);

Next





Color 8,1

Locate 20,3

MQPrint "Hello World!",4                'user color

MQPrint 2,15,"Hello World!"         'use Color 8,1

MQPrint 1,16,"Hello World!",30

MQPrint "Hello World!"             'use Color 8,1



Print TextField(2,10,20)



Sleep