Announcement

Collapse
No announcement yet.

Blinking INKEY$

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
    #1

    Blinking INKEY$

    Hi
    When I use to program my Commadore 64 I had a one line code that
    provided a blink cursor for my GET statements. (GET in Commadore
    code equal INKEY$ in PowerBASIC code.)Does anyone know of a simi-
    lar one line code that will work with INKEY$?

    Fred K

    ------------------
    Tags: None
    #2
    When you are using graphics screens, you need to emulate the cursor.
    These are some routines I had written when I used PB DOS 2.0
    It allows data entry when using graphics screens, emulating the cursor.
    The code consists of 2 files, Ed_Grap.inc and Ed_Grap.bas which compiles to a unit.

    It is used this way:

    Code:
    IF filnm$="" THEN filnm$="Noname.cdf"
LOCATE 17,27
PRINT ": ";
CALL CursorOn
ExitCode%=%FALSE
CALL EdGraphic(filnm$,"F",8,3,ExitCode%)
filnm$=RTRIM$(filnm$)
CALL CursorOff
IF ExitCode%<>27 THEN
  'Process FileName
END IF

' *****
SUB CursorOn
   LOCATE , , 1
END SUB
' *****
SUB CursorOff
   LOCATE , , 0
END SUB
' *****

'===========================================
' Ed_Grap.inc
'===========================================
DECLARE SUB EdGraphic(text$,typ$,t1%,t2%,keycode%)
' In graphics mode, emulates a blinking cursor and accepts string input.
' Maximum length permitted is t1% + t2%
' t1% is permitted length before the decimal
' t2% is permitted length after the decimal
' typ$ can be: "F" for filename,
'              "C" for any character input,
'              "N" for numeric input
DECLARE SUB BadSound()
' A 2 note beep.
' - EOF - ED_GRAP.BAS
'============================================
' snip Here ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'============================================
' Ed_Grap.bas
$COMPILE UNIT
$LIB ALL OFF
$OPTIMIZE SIZE
$CPU 80286
' --------------------------------------------------------------------------
' This Unit file contains the following Functions and routines:
' --------------------------------------------------------------------------

' SUB EdGraphic(text$,typ$,t1%,t2%,keycode%)  SHARED PUBLIC
'       LOCAL leftcol%,edit$,work%,insrt%,pflag%,sflag%,maxlen%,cflag%
'     Put cursor at starting row and column before calling routine

' DEF FNchkstring%(i$)  ' Checks a string for valid filename characters
'   LOCAL cstr$

' DEF FNt2len%(edit$)   ' Returns used length to right of decimal
'        LOCAL decimal.loc%,lst.chr.loc%

' SUB Badsound SHARED PUBLIC        ' More cool than a beep

' --------------------------------------------------------------------------
SUB EdGraphic(text$,typ$,t1%,t2%,keycode%) PUBLIC

   LOCAL leftcol%,edit$,work%,insrt%,pflag%,sflag%,maxlen%,cflag%
   LOCAL csr$,lcsr$,True%,timtst@,ploc%

   True%=-1
   cflag%=NOT True% ' Cursor not displayed at first
   csr$="_"         ' Standard Cursor Character
   lcsr$=CHR$(219)  ' Large Cursor Character
   maxlen%=t1%      ' Determine maximum length allowed
   IF t2%>0 AND typ$<>"C" THEN ' t2% not accepted for "C"haracter input
      maxlen%=maxlen%+t2%+1    ' allow for period
   END IF
   edit$=SPACE$(maxlen%)  ' Create a string of maxlen% spaces
   LSET edit$=text$
   altcsr$=RIGHT$(edit$,1) ' Display something if the cursor isn't displayed!
   leftcol%=POS(0)         ' Establish column starting point
   txtpos%=LEN(text$)+1    ' and where the cursor is.
   IF txtpos%>maxlen% THEN txtpos%=maxlen%    ' but don't exceed that length.
   work%=0
   pflag%=0
   sflag%=0
   '------------- Main processing loop -----------------------
   DO
      LOCATE ,leftcol%
      PRINT edit$;
      timtst1@=TIMER
      DO WHILE NOT INSTAT
         timtst2@=TIMER
         IF timtst2@>timtst1@+.2 THEN
            timtst1@=TIMER
            cflag%=NOT cflag%
            IF cflag% THEN
               LOCATE ,leftcol%+txtpos%-1     ' place cursor
               PRINT altcsr$;                 ' Display character
            ELSE
               IF insrt% THEN
                  LOCATE ,leftcol%+txtpos%-1     ' place cursor
                  PRINT lcsr$;                    ' Display large cursor
               ELSE
                  LOCATE ,leftcol%+txtpos%-1     ' place cursor
                  PRINT csr$;                    ' Display standard cursor
               END IF
            END IF
         END IF
      WEND

      ky$=INKEY$
      IF LEN(ky$)=1 THEN  ' standard keycode
         keycode%=ASC(ky$)
      ELSE                ' Extended keycode
         keycode%=-ASC(RIGHT$(ky$,1))   ' store as negative
      END IF

      IF work%=0 THEN   ' If data is added initially, then erase default.
         work%=1
         IF keycode%<32 THEN    ' Control character
            IF INSTR(edit$,".")<>0 AND typ$<>"C" THEN pflag%=1
            IF typ$="N" THEN
               IF INSTR(edit$, ANY "+-")<>0 THEN sflag%=1
            END IF
         ELSE
            edit$=SPACE$(maxlen%)
            txtpos%=1
         END IF
      END IF

      SELECT CASE keycode%

         CASE 8 ' Backspace

            IF txtpos%=1 THEN   ' already at left edge
               CALL Badsound
               EXIT SELECT
            END IF
            DECR txtpos%        ' backspace
            IF typ$="N" AND sflag%=1 AND txtpos%=1 THEN    ' Sign deleted
               sflag%=0
            END IF
            IF pflag%=1 AND MID$(edit$,txtpos%,1)="." THEN  ' Decimal deleted
               pflag%=0
               MID$(edit$,txtpos%)=MID$(edit$,txtpos%+1)
               edit$=LEFT$(LTRIM$(edit$),t1%)
               edit$=edit$+SPACE$(maxlen%-LEN(edit$))
               EXIT SELECT
            ELSE
               MID$(edit$,txtpos%)=MID$(edit$,txtpos%+1)+" "
            END IF

         CASE 3,13,27   ' Exit keys ^C,ENTER,ESC
            EXIT LOOP

         CASE 46      '  Decimal point (.)
            IF (typ$<>"C" AND (pflag%=1 OR t2%=0) OR (txtpos%>t1%+1)) OR _
				   (typ$="C" AND txtpos%>t1%) THEN ' no room
               CALL Badsound
               EXIT SELECT
            END IF

            IF typ$<>"C" THEN pflag%=1
            IF insrt% THEN 'Insert to left of cursor
               MID$(edit$,txtpos%)=ky$+MID$(edit$,txtpos%)
               edit$=LEFT$(edit$,maxlen%)
            ELSE
               MID$(edit$,txtpos%)=ky$
            END IF
            INCR txtpos%
            IF txtpos%>maxlen% THEN txtpos%=maxlen%

            IF typ$<>"C" THEN      ' Erase any characters > tlen2%
               IF FNt2len%(edit$)>t2% THEN
                  edit$=LEFT$(edit$,INSTR(edit$,".")+t2%)
                  edit$=edit$+SPACE$(maxlen%-LEN(edit$))
               END IF
            END IF

         CASE 32 TO 254    ' Regular text
            ploc%=INSTR(edit$,".")
            IF INSTR("NF",typ$)<>0 THEN
               IF (typ$="N" AND ((keycode%<48 OR keycode%>57)_   ' not numeric
                            OR  (txtpos%=1 AND sflag%=1)))_  ' at sign!
                            OR  (INSTR("+-",ky$)<>0 AND txtpos%<>1)_ ' sign!
                     OR (typ$="F" AND (FNchkstring%(ky$)=0)) THEN 'not File!
                  CALL Badsound
                  EXIT SELECT
               END IF
					IF (pflag%=0 AND ((txtpos%>t1%) OR _  ' no more room
                  (insrt% AND LEN(RTRIM$(edit$))>=t1%))) OR _
                  (pflag%=1 AND txtpos%>ploc% AND FNt2len%(edit$)>=t2%) OR _
                  (insrt% AND txtpos%>maxlen% AND ploc%>t1%) OR _ ' no room
                  (pflag%=1 AND insrt% AND _   ' Is there room to insert?
                  ((ploc%>t1% AND txtpos%<t1%+2))) THEN  ' t1 len?
                  CALL Badsound
                  EXIT SELECT
               END IF
            ELSEIF (insrt% AND LEN(RTRIM$(edit$))>=maxlen%) OR _   ' long enough
                   (txtpos%=t1% AND MID$(edit$,txtpos%,1)<>" ") THEN
               CALL Badsound
               EXIT SELECT
            END IF

            IF insrt% THEN
               MID$(edit$,txtpos%)=ky$+MID$(edit$,txtpos%)
               edit$=LEFT$(edit$,maxlen%)
            ELSE   ' Overwrite text
               IF sflag%=1 AND txtpos%=1 THEN sflag%=0
               IF INSTR("+-",ky$)<>0 AND typ$="N" THEN sflag%=1
               IF pflag%=1 THEN
                  IF ploc%=txtpos% THEN
                     pflag%=0
                     MID$(edit$,txtpos%)=ky$
                     edit$=LEFT$(LTRIM$(edit$),t1%)
                     edit$=edit$+SPACE$(maxlen%-LEN(edit$))
                     DECR txtpos%
                  ELSE
                     MID$(edit$,txtpos%)=ky$
                  END IF
               ELSE   ' No decimal flag yet
                  MID$(edit$,txtpos%)=ky$
               END IF
            END IF
            INCR txtpos%
            IF txtpos%>maxlen% THEN txtpos%=maxlen%

         CASE -77   ' Right Arrow
            IF typ$<>"C" AND MID$(edit$,txtpos%,1)=" " THEN
               CALL Badsound
               EXIT SELECT
            END IF
            INCR txtpos%
            IF txtpos%>maxlen% THEN
               txtpos%=maxlen%
               CALL Badsound
            END IF

         CASE -75   ' Left Arrow
            DECR txtpos%
            IF txtpos%<1 THEN
               txtpos%=1
               CALL Badsound
            END IF

         CASE -71   ' Home key
            txtpos%=1

         CASE -79   ' End key
            txtpos%=LEN(RTRIM$(edit$))+1
            IF txtpos%>maxlen% THEN txtpos%=maxlen%

         CASE -82   ' Insert key
            insrt%=NOT insrt%

         CASE -83    ' Delete key (was a decimal/sign deleted?)
            IF sflag%=1 AND txtpos%=1 THEN sflag%=0   ' sign deleted
            IF pflag%=1 THEN
               IF txtpos%=INSTR(edit$,".") THEN    ' decimal deleted
                  pflag%=0
                  MID$(edit$,txtpos%)=MID$(edit$,txtpos%+1)
                  edit$=LEFT$(edit$,t1%)+SPACE$(maxlen%-t1%)
                  EXIT SELECT
               END IF
            END IF
            MID$(edit$,txtpos%)=MID$(edit$,txtpos%+1)+" "

         CASE ELSE
            CALL Badsound

      END SELECT
      altcsr$=MID$(edit$,txtpos%,1)
   LOOP

   IF keycode%=13 THEN   ' Only return new info if no ESC key or ^C
      text$=edit$
   ELSE
      keycode%=27   ' convert ^C to ESC
   END IF
   LOCATE ,leftcol%
   PRINT text$;SPACE$(maxlen%-LEN(text$));
   t2%=txtpos% ' Return cursor position for spaces.

END SUB

' --------------------------------------------------------------------------

' --------------------------------------------------------------------------

DEF FNt2len%(edit$)
    FNt2len%=LEN(RTRIM$(edit$))-INSTR(edit$,".")
END DEF

' --------------------------------------------------------------------------

' --------------------------------------------------------------------------

SUB Badsound PUBLIC
   SOUND 37,0 : SOUND 220,2 : SOUND 174,2
END SUB

' --------------------------------------------------------------------------

' --------------------------------------------------------------------------

DEF FNchkstring%(i$)
   LOCAL cstr$
   cstr$="(){}@#$%^&!-_/~`0123456789"
   cstr$=cstr$+"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
   IF INSTR(cstr$,i$)=0 THEN FNchkstring%=0 ELSE FNchkstring%=1
END DEF

' --------------------------------------------------------------------------

' --------------------------------------------------------------------------
' - EOF - ED_GRAP.BAS
    ------------------
    [email protected]
    :) IRC :)

    Comment

      #3
      If you are in text mode,

      Locate Row,Col,1

      works for me. The number 1 turns the cursor on, 0 (default) turns
      it off.



      ------------------
      There are no atheists in a fox hole or the morning of a math test.
      If my flag offends you, I'll help you pack.

      Comment

        #4
        Thanks for your suggestions

        They work quite well. I'm post another problem that comes off of
        this suggestion. See the new posting you might help there as well.



        ------------------

        Comment

        Previous template Next
        Working...
        X
        😀
        🥰
        🤢
        😎
        😡
        👍
        👎

        We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

        By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

        I Agree