Input function with blinking cursor

Source-code only - please, don't post questions here.
sir_mud
Posts: 1401
Joined: Jul 29, 2006 3:00
Location: US
Contact:

Input function with blinking cursor

Postby sir_mud » Nov 30, 2006 9:28

I don't like the fact there isn't a blinking cursor when using input and it can lead to some confusion when a user doen't know they are supposed to type something, so I rehashed some old password input code from my personal QB library to blink a cursor for me.

Code: Select all

FUNCTION getstring (minlength as uinteger = 0, maxlength as uinteger = 255, password as ubyte = 0, cancel as ubyte = 1, numericonly as ubyte = 0, ycoord as uinteger = csrlin(), xcoord as uinteger = pos()) as string

   dim as string temp, mykey, blank, display
   dim as double mytimer
    IF ycoord < 1 OR xcoord < 1 THEN

        return ""

    END IF

    temp = ""
   mytimer = timer +.5

    DO

        mykey = INKEY

   if len(mykey) > 0 then

   end if
        IF len(mykey) > 0 THEN


            SELECT CASE mykey
   case ""


            CASE CHR(8)

                IF LEN(temp) = 1 THEN

                    blank = SPACE(LEN(temp)+1)

                    temp = ""

                ELSE

                    IF LEN(temp) > 0 THEN

                        blank = SPACE(LEN(temp)+1)

                        temp = LEFT(temp, LEN(temp) - 1)

                    END IF

                END IF

                LOCATE ycoord, xcoord

                PRINT blank

            CASE CHR(27)

                IF cancel = 0 THEN

                    temp = CHR(27)

                    EXIT DO

                END IF

            CASE ELSE

      if numericonly > 0 then
      if asc(mykey)<48 or asc(mykey) > 57 then
      if asc(mykey) <> 13 then
      if asc(mykey) <> 46 then
      mykey = ""
      end if
      end if
      end if
      end if
                IF ASC(mykey) > 31 AND ASC(mykey) < 127 THEN

                    temp += mykey

                END IF

            END SELECT

            'refresh display

            SELECT CASE password

            CASE 0

                'not password entry

       display = temp


            CASE ELSE

                'password entry

               

                display = STRING(LEN(temp), "*")

               

            END SELECT

        END IF
   sleep 50
               LOCATE ycoord, xcoord

      if timer > mytimer then
      PRINT display & "_"
      mytimer = timer + .5
      else
      print display & " "
      end if

    LOOP UNTIL mykey = CHR(13) OR LEN(temp) = maxlength

locate ycoord, xcoord
print display & " "
    return temp

END FUNCTION

? getstring()

As you can see, the function accepts many arguments, but requires none of them. If called when the cursor is on the last line of the screen it will scroll pretty quick, so try to test for that before you call it. If password or cancel arguments are nonzero they are activated, ie. password hides the output, and cancel disables canceling by either not entering anything or pushing ESC.
*edit*
Added Numeric only option. When activated it only allows numbers 0 to 9 and the decimal character to be entered.
mrToad
Posts: 342
Joined: Jun 07, 2005 23:03
Location: USA

Postby mrToad » Dec 06, 2006 22:45

this looks cool, thanks :]
sir_mud
Posts: 1401
Joined: Jul 29, 2006 3:00
Location: US
Contact:

Postby sir_mud » May 15, 2007 7:49

Updated the code with another option, this time you can make it timeout if no input is specified. As you can see by the code if you enter a valid character the timeout is restarted.

Code: Select all

Function getstring (minlength As Uinteger = 0, maxlength As Uinteger = 255, password As Ubyte = 0, cancel As Ubyte = 1, numericonly As Ubyte = 0, ycoord As Uinteger = Csrlin(), xcoord As Uinteger = Pos(), timeout as uinteger = 0) As String

        Dim As String temp, mykey, blank, display
        Dim As Double mytimer, timerout
        if timeout > 0 then timerout = timer + timeout
    If ycoord < 1 Or xcoord < 1 Then

        Return ""

    End If

    temp = ""
        mytimer = Timer +.5

    Do

        mykey = Inkey


        If Len(mykey) > 0 Then


            Select Case mykey
        Case ""


            Case Chr(8)

                If Len(temp) = 1 Then

                    blank = Space(Len(temp)+1)

                    temp = ""

                Else

                    If Len(temp) > 0 Then

                        blank = Space(Len(temp)+1)

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

                    End If

                End If

                Locate ycoord, xcoord

                Print blank

            Case Chr(27)

                If cancel = 0 Then

                    temp = Chr(27)

                    Exit Do

                End If

            Case Else

                If numericonly > 0 Then
                If Asc(mykey)<48 Or Asc(mykey) > 57 Then
                If Asc(mykey) <> 13 Then
                If Asc(mykey) <> 46 Then
                mykey = ""
                End If
                End If
                End If
                End If
                If Asc(mykey) > 31 And Asc(mykey) < 127 Then
                   
                    if timeout > 0 then timerout = timer + timeout
                    temp += mykey

                End If

            End Select

            'refresh display

            Select Case password

            Case 0

                'not password entry

                 display = temp


            Case Else

                'password entry

               

                display = String(Len(temp), "*")

               

            End Select

        End If
        Sleep 50
               Locate ycoord, xcoord

                If Timer > mytimer Then
                Print display & "_"
                mytimer = Timer + .5
                Else
                Print display & " "
                End If
    if timerout > 0 then
        if timer > timerout then exit do
    end if
    Loop Until mykey = Chr(13) Or Len(temp) = maxlength

Locate ycoord, xcoord
Print display & " "
    Return temp

End Function

? getstring (,,,,,,,5)
Pritchard
Posts: 5425
Joined: Sep 12, 2005 20:06
Location: Ohio, USA

Postby Pritchard » Jun 28, 2007 3:02

I couldn't help but to make this into it's own object. Fully commented with Consistent Indentation. Enjoy.

Code: Select all

  '' type of input allowed in our string.
Enum InpKind
  AcceptAll = 0
  NumOnly   = 1
  AlphOnly  = 2
End Enum


  '' Mud String Object
Type MudStr

  MinLen    As UInteger = 0       '' The minimal input length for the string.
  MaxLen    As UInteger = 255     '' The maximum input length fot the string.
 
  Pass      As UByte = 0          '' Password input or not?
 
  Cancel    As UByte = 1          '' Whether or not to cancel operation.
 
  InpType   As UByte = 0          '' The type of input.  Accepts all input by default.
 
  X         As UInteger = CsrLin()'' X position of the text.  Defaults to current row.
  Y         As UInteger = Pos()   '' Y Position of the text.  Defaults to current column.
 
  CurRate   As Double   = .5      '' Cursor Blink Rate
  TimeOut   As UInteger = 0       '' Text timeout.
 
 
    '' Get a string's input.
  Declare Function Get( ByVal TxtX As UInteger = CsrLin(), ByVal TxtY As UInteger = Pos() ) As String
 

End Type


Function MudStr.Get( ByVal TxtX As UInteger = CsrLin(), ByVal TxtY As UInteger = Pos() ) As String

     
    '' Temporary string for any number of purposes.
  Dim As String Temp
 
    '' Current key string.
  Dim As String MyKey
 
    '' Blank string.
  Dim As String Blank
 
    '' Current display string.
  Dim As String Display
 
 
    '' Current timer status.
  Dim As Double MyTimer
 
    '' When to time out.
  Dim As Double TimerOut
 
 
    '' If there's a timeout to this, then record when to timout.
  If This.TimeOut > 0 Then
 
      '' When the time at TimerOut is met, time out.
    TimerOut = Timer + This.TimeOut
   
  EndIf
 
 
    '' Invalid text coordinates.
      '' Y was invalid
  If TxtY < 1 Then
 
      '' Return nothing.
    Return ""
 
    '' Y was valid
  Else
 
      '' X was invalid.
    If TxtX < 1 Then

      Return ""
     
    End if

  End If
 
 
    '' Input coordinates are different than current ones.
      '' X axis copy
  If TxtX <> This.X Then
    This.X = TxtX
  EndIf
 
      '' Y axis copy.
  If TxtY <> This.Y Then
    This.Y = TxtY
  EndIf
 

    '' Blank the Temp string.
  Temp = ""
 
    '' Increate the Current Timer by half second increments.
  MyTimer = ..Timer + This.CurRate


    '' Main input loop.
  Do


      '' Get a character from Inkey.
    MyKey = Inkey


      '' If input to the key was found.
    If Len(MyKey) > 0 Then


        '' Check key status and execute code based on that status.
      Select Case MyKey
     
     
          '' Key is blank.  Do nothing.
        Case ""


          '' Backspace character code was input.
        Case Chr(8)
 
 
            '' Temp Key has length of 1.
          If Len(Temp) = 1 Then
   
              '' Blank space is the length of temp plus one.
            Blank = Space( Len(Temp) + 1 )
   
              '' Clear temp string.
            Temp = ""
   
   
            '' ...
          Else
 
 
              '' Larger length of input.
            If Len(Temp) > 0 Then
   
               
                '' Record blank as the length of temp plus one.
              Blank = Space( Len(Temp) + 1 )
   
                '' Go left of temp by one minus it's length (backspacing)
              Temp = Left( Temp, Len(Temp) - 1 )
             
   
            End If
           
 
          End If
         
         
            '' Print the blank space at cursor position.
          Locate This.X, This.Y
          Print Blank
         
         
          '' Escape character.
        Case Chr(27)
   
   
            '' Cancel has not been set yet.
          If This.Cancel = 0 Then
 
              '' Give the escape character to Temp.
            Temp = Chr(27)
 
              '' Exit the loop.
            Exit Do
           
          End If
         
   
          '' Other character were input.
        Case Else
   
         
            '' Input type if numeric only.
          If This.InpType = InpKind.NumOnly Then
         
              '' Characters aren't in the numeric range.
            If Asc(MyKey) < 48 Or Asc(MyKey) > 57 Then
           
                '' Also not other input regarded as acceptable.
              If Asc(MyKey) <> 13 Then
                If Asc(MyKey) <> 46 Then
               
                    '' Clear the current key.
                  MyKey = ""
                 
                End If
              End If
             
            End If
           
          End If
         
         
            '' Input type if alphabetical characters only.
          If This.InpType = InpKind.AlphOnly Then
         
              '' Characters aren't in the Min and Max bounds of Alphabetical characters
            If Asc(MyKey) < 65 Or Asc(MyKey) > 122 Then
           
                '' Also not other input regarded as acceptable.
              If Asc(MyKey) > 90 Then
                If Asc(MyKey) < 97 Then
               
                    '' Clear the current key.
                  MyKey = ""
                 
                End If
              End If
             
            End If
           
          End If
         
         
            '' Text strings input.
              '' Only allow input from a certain key range.
          If Asc(MyKey) > 31 And Asc(MyKey) < 127 Then
             
                '' We have specified timeout.  Increase timer tracking.
              If This.TimeOut > 0 Then TimerOut = ..Timer + This.TimeOut
             
                '' Add the input key to our temporary string.
              Temp += MyKey
   
          End If
         
 
      End Select
 
 
        '' Check the password input.
      Select Case This.Pass

          '' no password entered.
        Case 0
 
            '' Simply use our string for display.
          Display = Temp 
 
          '' password in object.
        Case Else
 
            '' password entry
          Display = String(Len(Temp), "*")
       
      End Select
     

    End If
   
   
      '' Pause for pausing's sake.
    Sleep 50
   
   
      '' Set cursor position.
    Locate This.X, This.Y
   

      '' If the timer's gone beyond the bounds of our cursor rate.
    If ..Timer > MyTimer Then
   
        '' Cursor display.
      Print display & "_"
     
        '' Increase the bounds for the cursor again.
      mytimer = Timer + This.CurRate
     
     
      '' Timer is not over cursor rate bounds.
    Else
   
        '' Display no cursor.
      Print display & " "
     
    End If
   
   
      '' Our Timer Out check is > 0
    If TimerOut > 0 Then
   
        '' Exit loop if we've surpassed our timeout length.
      If ..Timer > TimerOut Then Exit Do
     
    End If
   
   
    '' Loop until we hit escape or have reached beyond our maximum length.
      '' ??? WHERE IS MIN LENGTH CHECKING ???
  Loop Until MyKey = Chr(13) Or Len(Temp) = This.MaxLen


    '' Set string position.
  Locate This.X, This.Y
 
    '' Print the display.
  Print Display & " "
 
 
    '' Return our input text.
  Return Temp
 

End Function


  '' Create our input object.
Dim As MudStr ptr TempInput = New MudStr

 
  '' Call and print the results of the GET function.
Print TempInput->Get()
sleep
sir_mud
Posts: 1401
Joined: Jul 29, 2006 3:00
Location: US
Contact:

Postby sir_mud » Jul 23, 2007 9:00

Rewrote it in the form of a library and an object.
Changelog:
General speed increase.
Now if you set the timeout to > 0 you can call the function again and again and it will remember the previous value.
Added a callback function. You can use this to check again for invalid chars or use it to update something in the rest of your program. See example for usage.

file: inputex.bas

Code: Select all

''InputEx -- Extended Input Routine by sir_mud
''licensed under the terms of the GPLv2
''If you would like to use this in a non-GPL compatible program
''contact me at contact@aknerd.com for purchase details
''file: inputex.bas

#include "inputex.bi"
'#pragma cmdline = "-lib"

constructor InputEx

   this.maxlength = 255
   this.password = 0
   this.cancel = 1
   this.numonly = 0
   this.timeout = 0

end constructor

function InputEx.get( x as uinteger = Pos(), y as uinteger = Csrlin() ) as string

   Dim As String mykey, blank, display
   Dim As Double mytimer, timerout

   If y < 1 Or x < 1 Then
      Return ""
   else
      this.y = y
      this.x = x
   End If

   If timeout > 0 Then
      timerout = Timer + timeout
   else
      this.temp = ""
   end if

   mytimer = Timer +.5

   Do

      mykey = Inkey

      If Len(mykey) > 0 Then
         Select Case mykey
         Case ""  '' This shouldn't happen

         Case Chr(8)  '' Backspace key
            If Len(temp) = 1 Then
               blank = Space(Len(this.temp)+1)
               this.temp = ""
            Else
               If Len(this.temp) > 0 Then
                  blank = Space(Len(this.temp)+1)
                  this.temp = Left(this.temp, Len(this.temp) - 1)
               End If
            End If

            Locate y, x
            Print blank

         Case Chr(27) '' Escape key, our cancel key
            If this.cancel = 0 Then
               this.temp = Chr(27)
               Exit Do
            End If

         Case Else  '' This is where the magic happens

            If this.numonly > 0 Then '' do numeric only input first
               If mykey[0]<48 Or mykey[0] > 57 Then
                  If mykey[0] <> 13 Then
                     If mykey[0] <> 46 Then
                     mykey = ""
                     End If
                  End If
               else
                  if mykey[0] <> 46 then
                     if this._callback <> 0 then
                        cretval = this._callback( mykey[0] )
                        if cretval > 0 then exit do
                        if cretval = 0 then
                           this.temp += mykey
                        else
                           mykey = ""
                        end if
                     else
                        this.temp += mykey
                     end if 
                  end if
               End If
            else
               If mykey[0] > 31 And mykey[0] < 255 Then
                  If this.timeout > 0 Then timerout = Timer + this.timeout
                  if this._callback <> 0 then
                     cretval = this._callback( mykey[0] )
                     if cretval > 0 then exit do
                     if cretval = 0 then
                        this.temp += mykey
                     else
                        mykey = ""
                     end if
                  else
                     this.temp += mykey
                  end if 

               End If
            end if

         End Select

         '' time to refresh display

         Select Case this.password

         Case 0 '' Not password entry
            display = this.temp

         Case Else '' Password entry
            display = String(Len(this.temp), "*")

         End Select

      End If

      Sleep 50

      Locate y, x

      If Timer > mytimer Then
         Print display & "_"
         mytimer = Timer + .5
      Else
         Print display & " "
      End If

      If timerout > 0 Then
         If Timer > timerout Then Exit Do
      End If

   sleep 10

   Loop Until mykey = Chr(13) Or Len(this.temp) = maxlength

Locate y, x
Print display & " "

Return this.temp

End Function

file: inputex.bi

Code: Select all

''InputEx -- Extended Input Routine by sir_mud
''licensed under the terms of the GPLv2
''If you would like to use this in a non-GPL compatible program
''contact me at contact@aknerd.com for purchase details
''file: inputex.bi

type InputEx

Public:
   as uinteger maxlength, y, x, cretval
   as ubyte password, cancel, numonly
   as double timeout
   _callback as function( as uinteger ) as integer

   declare Function get( x as uinteger = Pos(), y as uinteger = Csrlin() ) as string
   declare constructor()

Private:
   as string temp

end type

#inclib "inputex"


And finally a simple example showing callback usage

Code: Select all

declare function mycb( x as ubyte ) as integer

dim as InputEx ptr myinput = new InputEx

myinput->_callback = @mycb
? myinput->get(,)


function mycb( x as ubyte ) as integer
if x > 126 then
return -1 ''Tells inputex to not add the char
else
return 0 ''adds the char
end if
'' if you wanted to exit the input routine you would return > 0
end function
sir_mud
Posts: 1401
Joined: Jul 29, 2006 3:00
Location: US
Contact:

Postby sir_mud » Aug 07, 2007 22:49

New release of this, duplicated on c0de.aknerd.com also.
Changes in this version:
Added printing callback function capability. Can be used with existing code without modification. Included two sample callback functions: _def_print is the old behaviour and the default if nothing is specified, _def_print_gfx will print using "draw string" and allows the user to specify the color of the text. See code for usage.

File: inputex.bi

Code: Select all

''InputEx -- Extended Input Routine by sir_mud
''licensed under the terms of the GPLv2
''If you would like to use this in a non-GPL compatible program
''contact me at contact@aknerd.com for purchase details
''file: inputex.bi

#ifndef NULL
#define NULL 0
#endif

type InputEx

Public:
   as uinteger maxlength, y, x, cretval
   as ubyte password, cancel, numonly
   as double timeout
   _print_cb as sub( as uinteger, as uinteger, as string, as any ptr )
   _print_cb_data as any ptr
   _callback as function( as uinteger ) as integer

   declare Function get( x as uinteger = Pos(), y as uinteger = Csrlin() ) as string
   declare constructor()

Private:
   as string temp

end type

declare sub _def_print( x as uinteger, y as uinteger, data_ as string, _nu as any ptr = NULL )
declare sub _def_gfx_print( x as uinteger, y as uinteger, data_ as string, _color as any ptr = NULL )

#inclib "inputex"



File: inputex.bas | compile with "-lib"

Code: Select all

''InputEx -- Extended Input Routine by sir_mud
''licensed under the terms of the GPLv2
''If you would like to use this in a non-GPL compatible program
''contact me at contact@aknerd.com for purchase details
''file: inputex.bi

#include "inputex.bi"
'Makes use of the program "fbp" by me which lets us use this:
'#pragma cmdline = "-lib"
'If you don't use fbp, then you'll need to compile this file with "-lib"

constructor InputEx

   this.maxlength = 255
   this.password = 0
   this.cancel = 1
   this.numonly = 0
   this.timeout = 0
   this._print_cb = @_def_print
   this._print_cb_data = NULL

end constructor

function InputEx.get( x as uinteger = Pos(), y as uinteger = Csrlin() ) as string

   Dim As String mykey, blank, display
   Dim As Double mytimer, timerout

   If y < 1 Or x < 1 Then
      Return ""
   else
      this.y = y
      this.x = x
   End If

   If timeout > 0 Then
      timerout = Timer + timeout
   else
      this.temp = ""
   end if

   mytimer = Timer +.5

   Do

      mykey = Inkey

      If Len(mykey) > 0 Then
         Select Case mykey
         Case ""  '' This shouldn't happen

         Case Chr(8)  '' Backspace key
            If Len(temp) = 1 Then
               blank = Space(Len(this.temp)+1)
               this.temp = ""
            Else
               If Len(this.temp) > 0 Then
                  blank = Space(Len(this.temp)+1)
                  this.temp = Left(this.temp, Len(this.temp) - 1)
               End If
            End If

         this._print_cb(x,y,blank,this._print_cb_data)

         Case Chr(27) '' Escape key, our cancel key
            If this.cancel = 0 Then
               this.temp = Chr(27)
               Exit Do
            End If

         Case Else  '' This is where the magic happens

            If this.numonly > 0 Then '' do numeric only input first
               If mykey[0]<48 Or mykey[0] > 57 Then
                  If mykey[0] <> 13 Then
                     If mykey[0] <> 46 Then
                     mykey = ""
                     End If
                  End If
               else
                  if mykey[0] <> 46 then
                     if this._callback <> 0 then
                        cretval = this._callback( mykey[0] )
                        if cretval > 0 then exit do
                        if cretval = 0 then
                           this.temp += mykey
                        else
                           mykey = ""
                        end if
                     else
                        this.temp += mykey
                     end if 
                  end if
               End If
            else
               If mykey[0] > 31 And mykey[0] < 255 Then
                  If this.timeout > 0 Then timerout = Timer + this.timeout
                  if this._callback <> 0 then
                     cretval = this._callback( mykey[0] )
                     if cretval > 0 then exit do
                     if cretval = 0 then
                        this.temp += mykey
                     else
                        mykey = ""
                     end if
                  else
                     this.temp += mykey
                  end if 

               End If
            end if

         End Select

         '' time to refresh display

         Select Case this.password

         Case 0 '' Not password entry
            display = this.temp

         Case Else '' Password entry
            display = String(Len(this.temp), "*")

         End Select

      End If

      Sleep 50


      If Timer > mytimer Then
         this._print_cb(x,y,display & "_",this._print_cb_data)
         mytimer = Timer + .5
      Else
         this._print_cb(x,y,display & " ",this._print_cb_data)
      End If

      If timerout > 0 Then
         If Timer > timerout Then Exit Do
      End If

   sleep 10

   Loop Until mykey = Chr(13) Or Len(this.temp) = maxlength

Locate y, x
Print display & " "

Return this.temp

End Function

sub _def_print( x as uinteger, y as uinteger, data_ as string, _nu as any ptr = NULL )

locate y, x
print data_

end sub

sub _def_gfx_print( x as uinteger, y as uinteger, data_ as string, _color as any ptr = NULL )

if _color <> 0 then
draw string (x,y), data_,*(cast(integer ptr, _color))
else
draw string (x,y), data_
end if

end sub
sir_mud
Posts: 1401
Joined: Jul 29, 2006 3:00
Location: US
Contact:

Postby sir_mud » Aug 07, 2007 22:51

New release of this, duplicated on c0de.aknerd.com also.
Changes in this version:
Added printing callback function capability. Can be used with existing code without modification. Included two sample callback functions: _def_print is the old behaviour and the default if nothing is specified, _def_print_gfx will print using "draw string" and allows the user to specify the color of the text. See code for usage.

File: inputex.bi

Code: Select all

''InputEx -- Extended Input Routine by sir_mud
''licensed under the terms of the GPLv2
''If you would like to use this in a non-GPL compatible program
''contact me at contact@aknerd.com for purchase details
''file: inputex.bi

#ifndef NULL
#define NULL 0
#endif

type InputEx

Public:
   as uinteger maxlength, y, x, cretval
   as ubyte password, cancel, numonly
   as double timeout
   _print_cb as sub( as uinteger, as uinteger, as string, as any ptr )
   _print_cb_data as any ptr
   _callback as function( as uinteger ) as integer

   declare Function get( x as uinteger = Pos(), y as uinteger = Csrlin() ) as string
   declare constructor()

Private:
   as string temp

end type

declare sub _def_print( x as uinteger, y as uinteger, data_ as string, _nu as any ptr = NULL )
declare sub _def_gfx_print( x as uinteger, y as uinteger, data_ as string, _color as any ptr = NULL )

#inclib "inputex"



File: inputex.bas | compile with "-lib"

Code: Select all

''InputEx -- Extended Input Routine by sir_mud
''licensed under the terms of the GPLv2
''If you would like to use this in a non-GPL compatible program
''contact me at contact@aknerd.com for purchase details
''file: inputex.bi

#include "inputex.bi"
'Makes use of the program "fbp" by me which lets us use this:
'#pragma cmdline = "-lib"
'If you don't use fbp, then you'll need to compile this file with "-lib"

constructor InputEx

   this.maxlength = 255
   this.password = 0
   this.cancel = 1
   this.numonly = 0
   this.timeout = 0
   this._print_cb = @_def_print
   this._print_cb_data = NULL

end constructor

function InputEx.get( x as uinteger = Pos(), y as uinteger = Csrlin() ) as string

   Dim As String mykey, blank, display
   Dim As Double mytimer, timerout

   If y < 1 Or x < 1 Then
      Return ""
   else
      this.y = y
      this.x = x
   End If

   If timeout > 0 Then
      timerout = Timer + timeout
   else
      this.temp = ""
   end if

   mytimer = Timer +.5

   Do

      mykey = Inkey

      If Len(mykey) > 0 Then
         Select Case mykey
         Case ""  '' This shouldn't happen

         Case Chr(8)  '' Backspace key
            If Len(temp) = 1 Then
               blank = Space(Len(this.temp)+1)
               this.temp = ""
            Else
               If Len(this.temp) > 0 Then
                  blank = Space(Len(this.temp)+1)
                  this.temp = Left(this.temp, Len(this.temp) - 1)
               End If
            End If

         this._print_cb(x,y,blank,this._print_cb_data)

         Case Chr(27) '' Escape key, our cancel key
            If this.cancel = 0 Then
               this.temp = Chr(27)
               Exit Do
            End If

         Case Else  '' This is where the magic happens

            If this.numonly > 0 Then '' do numeric only input first
               If mykey[0]<48 Or mykey[0] > 57 Then
                  If mykey[0] <> 13 Then
                     If mykey[0] <> 46 Then
                     mykey = ""
                     End If
                  End If
               else
                  if mykey[0] <> 46 then
                     if this._callback <> 0 then
                        cretval = this._callback( mykey[0] )
                        if cretval > 0 then exit do
                        if cretval = 0 then
                           this.temp += mykey
                        else
                           mykey = ""
                        end if
                     else
                        this.temp += mykey
                     end if 
                  end if
               End If
            else
               If mykey[0] > 31 And mykey[0] < 255 Then
                  If this.timeout > 0 Then timerout = Timer + this.timeout
                  if this._callback <> 0 then
                     cretval = this._callback( mykey[0] )
                     if cretval > 0 then exit do
                     if cretval = 0 then
                        this.temp += mykey
                     else
                        mykey = ""
                     end if
                  else
                     this.temp += mykey
                  end if 

               End If
            end if

         End Select

         '' time to refresh display

         Select Case this.password

         Case 0 '' Not password entry
            display = this.temp

         Case Else '' Password entry
            display = String(Len(this.temp), "*")

         End Select

      End If

      Sleep 50


      If Timer > mytimer Then
         this._print_cb(x,y,display & "_",this._print_cb_data)
         mytimer = Timer + .5
      Else
         this._print_cb(x,y,display & " ",this._print_cb_data)
      End If

      If timerout > 0 Then
         If Timer > timerout Then Exit Do
      End If

   sleep 10

   Loop Until mykey = Chr(13) Or Len(this.temp) = maxlength

Locate y, x
Print display & " "

Return this.temp

End Function

sub _def_print( x as uinteger, y as uinteger, data_ as string, _nu as any ptr = NULL )

locate y, x
print data_

end sub

sub _def_gfx_print( x as uinteger, y as uinteger, data_ as string, _color as any ptr = NULL )

if _color <> 0 then
draw string (x,y), data_,*(cast(integer ptr, _color))
else
draw string (x,y), data_
end if

end sub
MystikShadows
Posts: 596
Joined: Jun 15, 2005 13:22
Location: Upstate NY
Contact:

Postby MystikShadows » Aug 09, 2007 16:14

Hi sir_mud,

I was about to start making one of those, probably for the same reasons you have. I see you've beaten me to it :-).

I'll have a lot of usage for this. Thank you for:

1. Making it.
2. Making it GPL ;-).
3. Sharing it

I know I appreciate it a whole lot.
sir_mud
Posts: 1401
Joined: Jul 29, 2006 3:00
Location: US
Contact:

Postby sir_mud » Aug 09, 2007 16:24

thank you MystikShadows, it really has become quite useful now. As for the GPL, its only a little less ambiguous than my old license: http://hmcsoft.50webs.org/stfu.html
:p
Dr_D
Posts: 2345
Joined: May 27, 2005 4:59
Contact:

Postby Dr_D » Aug 09, 2007 19:00

I'm gonna have to adapt this license...

DO NOT expect a warranty for a freely licensed program, or you will be chastised by your peers. (and sodomized by a goat)
MystikShadows
Posts: 596
Joined: Jun 15, 2005 13:22
Location: Upstate NY
Contact:

Postby MystikShadows » Aug 09, 2007 19:58

LOL Dr_D maybe I should add to my projects too lol
badmrbox
Posts: 659
Joined: Oct 27, 2005 14:40
Location: Sweden
Contact:

Postby badmrbox » Aug 09, 2007 20:01

I'm quite tempted too XD
sir_mud
Posts: 1401
Joined: Jul 29, 2006 3:00
Location: US
Contact:

Postby sir_mud » Aug 29, 2007 14:04

If Microsoft's licenses get approved by the OSI i'll submit it :p

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest