[Back to CURSOR SWAG index] [Back to Main SWAG index] [Original]

    {
    I (Fire&Ice if you use screen-names) would like to contribute something
    to SWAG, if you
    like it. It is a modified spinning cursor unit. I found out that the
    original spinkey
    code (I forgot the authors name, sorry) has an error (as follows):
            If you type:
                    Welcine to the wonderful world of Oz!!!
            And then backspace over it (to change what you say), so it says:
                    Welc
            And then type the following message:
                    Welcome to Houston!
            The String Concatenated will be:
                    Welcome to Houston!erful world of Oz!!!

    So, I rewrote the stuff to account for the backspace key. I have
    included two units:
    Cursor.pas and Incl.Pas

    **Cursor Requires Incl to compile (I guess Incl could be of MISC
    classification)
    ***PLEEZ Lemme know what you think and whether or not u will put it on
    SWAG.
    (oh, I did use a little code I got off SWAG for the PCBOut Proc in
    CURSOR.PAS)

    -Thanx

    Fire&Ice
    }

    Unit Cursor;
    { Created By Fire&Ice }
    { Last Modified: 11/3/96 }

    (* This Unit Contains Several Useful Procedures For A Spinning Cursor
    Shape.
       It Serves No Real Purpose, But It's Cooler Than The Normal Cursor.
       It Contains The Following Procedures:
         SetCursor = Turns The Cursor On/Off.
         Pause2    = A Pretty Neat Pause Procedure With Color
         Spinner   = Actual Procedure For Spinning The Cursor.
         SpinStr   = Reads A String With A Spinning Cursor.
         SpinInt   = Reads An Integer With A Spinning Cursor.
         SpinReal  = Reads A Real With A Spinning Cursor.
         SpinChr   = Reads A Char And Converts and Outputs It In Uppercase.
         PCBOut    = Reads A String And Can Use PCB Color Codes To Format
    it.
    *)
    INTERFACE
    Type
      String255=String[255];

    Const
      On=True;
      Off=False;
      Yes=True;
      No=False;
    { These are all the Textcolor() Options...                          }
      Black=0;        { Black                                          }
      DkBlue=1;       { Dark Blue                                      }
      DkGreen=2;      { Dark Green                                     }
      DkTurquoise=3;  { Dark Turquoise                                 }
      DkRed=4;        { Dark Red                                       }
      DkPurple=5;     { Dark Purple                                    }
      Brown=6;        { Brown                                          }
      LtGray=7;       { Standard Text Color (Light Gray)               }
      DkGray=8;       { Dark Gray                                      }
      LtBlue=9;       { Light Blue                                     }
      LtGreen=10;     { Light Green                                    }
      LtTurquoise=11; { Light Turquoise                                }
      LtRed=12;       { Light Red (Pink)                               }
      LtPurple=13;    { Light Purple                                   }
      Yellow=14;      { Yellow                                         }
      White=15;       { White                                          }
      Flash=16;       { Text Attrib for Flashing (Add 16 to Color Num) }

      Procedure SetCursor(Flg: Boolean);
      Procedure Pause2(NormCol, CycCol, StarCol:Integer);
      Procedure Spinner;
      Procedure SpinStr(Prpt:String;VAR Inpt:String);
      Procedure SpinInt(Prpt:String;VAR Intg:Integer);
      Procedure SpinReal(Prpt:String;VAR Intg:Real);
      Procedure SpinChr(Prpt:String;VAR Cr:Char);
      Procedure PCBOut(stream:string255; ret:boolean);

    IMPLEMENTATION
    Uses Dos, Crt, Inc;  { cut out INC below !! }

    Const
      SpinChar:Array[1..4] of Char = ('Ä','\','³','/');

    Var
      Key:Char;
      InfoLen:Integer;

    {**************************************************************************}
    Procedure SetCursor(Flg: Boolean);
            Var
              reg : Registers;

            Begin
              If Flg=True Then              { Turn cursor on }
             If Mem[$0040:$0049] = 7 Then
                  reg.cx := $B0C            { If monochrome monitor }
             Else
               reg.cx := $607               { If color monitor }
              Else                          { Turn cursor off }
                reg.cx := $2020;
              reg.bx := 0;
              reg.ax := $0100;              { Set the interrupt function }
              Intr($10,reg);                { Call the interrupt }
            End;  { of PROCEDURE SetCursor }
    {*************************************************************************}
    Procedure Pause2(NormCol, CycCol, StarCol:Integer);
    Const
      D=115;
      X=38;
      PD:Array[1..6] of Char = ('P', 'A', 'U', 'S', 'E', 'D');

    Var
      Loop, CurHi:Integer;
      Y:Byte;
      Back:Boolean;
      K:Char;

    Begin
      SetCursor(False);Writeln;
      CurHi:=1;Y:=WhereY;Back:=False;
      GotoXY(37, Y);CC(StarCol+Flash);Write('*');
      GotoXY(44, Y);Write('*');CC(NormCol);GotoXY(X, Y);
      Repeat
        GotoXY(X, Y);
        For Loop:=1 to 6 Do
          Begin
            For Loop:=1 to 6 Do
              Begin
                If Loop=CurHi Then
                  Begin
                    CC(CycCol);
                    Write(PD[Loop]);
                  End
                  Else
                  Begin
                    CC(NormCol);
                    Write(PD[Loop]);
                  End;
              End;
        End;
        If CurHi=6 Then
          Begin
            CurHi:=5;
            Back:=True
          End
          Else
          If (Back=True) And (CurHi > 1) Then
            CurHi:=CurHi-1
          Else
          If (Back=True) And (CurHi = 1) Then
            Begin
              CurHi:=2;
              Back:=False
            End
          Else
            CurHi:=CurHi+1;
        Delay(D);
      Until KeyPressed;
      K:=Readkey;GotoXY(43, Y);CC(LtGray);Writeln;
      SetCursor(True);
      End; { of PROCEDURE Pause2 }
    {**************************************************************************}
    Procedure Spinner;
      Var
        X, Y:Byte;
        Q:Integer;

      Begin
        X:=WhereX; Y:=WhereY;
        Q:=1;
        Repeat
          Write(SpinChar[Q]);
          Delay(40);
          GotoXY(X, Y);
          Write(' ');
          GotoXY(X, Y);
          Q:=Q+1;
          If Q = 5 Then
            Q:=1;
        Until KeyPressed;
          Key:=Readkey;
          Write(Key);
          If (Key=Chr(8)) And (InfoLen > 0) Then
            InfoLen:=InfoLen - 1
          Else
            InfoLen:=InfoLen + 1;
      End; { of PROCEDURE Spinner }
    {**************************************************************************}
    Procedure SpinStr(Prpt:String;VAR Inpt:String);

      Label Top;

      Var
        Cycler, Cycl2:Integer;
        Tstr, Tstr2:String;
        L:Integer;

      Begin
        SetCursor(Off);
        Top:
        Write(Prpt);
        Inpt:='';
        InfoLen:=0;
        Tstr:='';
        L:=0;
        Repeat
          Spinner;
          If Key<>Chr(8) Then
            Begin
              L:=L+1;
              Inpt:=Inpt+Key;
            End
            Else
            Begin
              Tstr2:='';
              For Cycl2:= 1 to (L-1) DO
                Begin
                  Tstr2:=Tstr2+Inpt[Cycl2];
                End; { of FOR Cycl2 }
              L:=L-1;
              Inpt:=Tstr2;
            End; { of IF Key... }

        Until Key=Chr(13);
        Writeln;
        If (InfoLen > 0) Then
          InfoLen:=InfoLen - 1;

        If InfoLen > 0 Then
        Begin
          For Cycler:= 1 to InfoLen DO
            Begin
              Tstr:=Tstr+Inpt[Cycler]
            End; { of FOR Cycler }
          Inpt:=Tstr;
        End
        Else
          Begin
            Writeln('ERR: Invalid Entry!');
            goto Top
          End;
       SetCursor(On);
      End; { of PROCEDURE SpinStr }
    {**************************************************************************}
    Procedure SpinInt(Prpt:String;VAR Intg:Integer);

      Var
        Cd:Integer;
        Inpt:String;

      Begin
        SpinStr(Prpt, Inpt);
        Val(Inpt,Intg,Cd);
      End; { of PROCEDURE SpinInt }
    {**************************************************************************}
    Procedure SpinReal(Prpt:String;VAR Intg:Real);

      Var
        Cd:Integer;
        Inpt:String;

      Begin
        SpinStr(Prpt, Inpt);
        Val(Inpt,Intg,Cd);
      End; { of PROCEDURE SpinReal }
    {**************************************************************************}
    Procedure SpinChr(Prpt:String;VAR Cr:Char);
      Var
        X, Y:Byte;

      Begin
        SetCursor(Off);
        Write(Prpt);
        Spinner;
        X:=WhereX; Y:=WhereY; X:=X-1;
        GotoXY(X, Y);
        Cr:=UpCase(Key);
        Writeln(Cr);
        SetCursor(On);
      End; { of PROCEDURE SpinChr }
    {**************************************************************************}
    Procedure PCBOut(stream:string255; ret:boolean);
      Var
        _retval:integer;
        out,out1:string[5];

      Begin
        For _retval:=1 To length(stream) Do
          Begin
            out:=copy(stream,_retval,1);
            Case out[1] Of
              '@':Begin
                    out1:=copy(stream,_retval+2,1);
                    Case out1[1] Of
                      '0':TextBackground(0);
                      '1':TextBackground(1);
                      '2':TextBackground(2);
                      '3':TextBackground(3);
                      '4':TextBackground(4);
                      '5':TextBackground(5);
                      '6':TextBackground(6);
                      '7':TextBackground(7);
                      '8':TextBackground(8);
                      '9':TextBackground(9);
                      'A':TextBackground(10);
                      'B':TextBackground(11);
                      'C':TextBackground(12);
                      'D':TextBackground(13);
                      'E':TextBackground(14);
                      'F':TextBackground(15);
                    End;
                    out1:=Copy(stream,_retval+3,1);
                    Case out1[1] Of
                      '0':TextColor(0);
                      '1':TextColor(1);
                      '2':TextColor(2);
                      '3':TextColor(3);
                      '4':TextColor(4);
                      '5':TextColor(5);
                      '6':TextColor(6);
                      '7':TextColor(7);
                      '8':TextColor(8);
                      '9':TextColor(9);
                      'A':TextColor(10);
                      'B':TextColor(11);
                      'C':TextColor(12);
                      'D':TextColor(13);
                      'E':TextColor(14);
                      'F':TextColor(15);
                    End;
                    _retval:=_retval+3;
                  End;
              Else Write(out[1]);
            End;
          End;
        If ret=Yes Then writeln;
     End; { of PROCEDURE PCBOut }
    {**************************************************************************}
    End. { of Unit Cursor }

    { --------------   CUT -------------- }

    Unit Inc;

    { Created By: Fire&Ice }
    { Last Modified: 10/11/96 }
    INTERFACE

    Function Right(Strng:string;numbr:byte):string;
    Function Left(Strng:string;numbr:byte):string;
    Procedure Pause;
    Procedure CC(col:integer);
    Procedure BC(col:integer);
    Procedure Cnt_Txt (txt:string);

    Const
    { These are all the Textcolor() Options...                          }
      Black=0;        { Black                                          }
      DkBlue=1;       { Dark Blue                                      }
      DkGreen=2;      { Dark Green                                     }
      DkTurquoise=3;  { Dark Turquoise                                 }
      DkRed=4;        { Dark Red                                       }
      DkPurple=5;     { Dark Purple                                    }
      Brown=6;        { Brown                                          }
      LtGray=7;       { Standard Text Color (Light Gray)               }
      DkGray=8;       { Dark Gray                                      }
      LtBlue=9;       { Light Blue                                     }
      LtGreen=10;     { Light Green                                    }
      LtTurquoise=11; { Light Turquoise                                }
      LtRed=12;       { Light Red (Pink)                               }
      LtPurple=13;    { Light Purple                                   }
      Yellow=14;      { Yellow                                         }
      White=15;       { White                                          }
      Flash=16;       { Text Attrib for Flashing (Add 16 to Color Num) }
    { Number of Columns in the Screen (For Procedure Cnt_Txt) }
      NumCols=80;

    IMPLEMENTATION
    uses Crt;

    {***************************************************************************}
    FUNCTION Right(Strng:string;numbr:byte):string;
    Var
     loc:byte;                                        { Like The MSBasic }
                                                      { Right Procedure }
    Begin
      If numbr >= LENGTH(Strng) then
        Right:=strng
      Else
        Begin
          loc:=length(strng)-numbr+1;
          Right:=copy(strng,loc,numbr);
        End;
    End;
    {***************************************************************************}
    FUNCTION Left(Strng:string;numbr:byte):string;       { Like The MSBasic
    }
      Begin                                              { Left Procedure }
        Left:=COPY(Strng,1,numbr);
      End;
    {***************************************************************************}
    Procedure Pause;                      { This Procedure pauses the
    program }
    Var
      Wtt:Char;

      Begin
        writeln;write('Press Any Key To Continue...');Wtt:=readkey;writeln;
      End;
    {***************************************************************************}
    Procedure CC(col:integer);      { Easier than typing Textcolor() }
      Begin
        Textcolor(col);           { ** CC stands for 'Color Change' ** }
      End;
    {***************************************************************************}
    Procedure BC(col:integer);    { Easier than typing Textbackground() }
      Begin
        Textbackground(col);    { ** BC stands for 'Background Change' ** }
      End;
    {***************************************************************************}
    Procedure Cnt_Txt (txt:string);         { This Procedure does the }
    Var
      shft:integer;                     { task of centering a line of text }

      Begin
        Shft:=(NumCols - Length(txt)) DIV 2;
        Shft:=Shft+Length(txt);
        Writeln(txt:shft);
      End;
    {***************************************************************************}
    End.

[Back to CURSOR SWAG index] [Back to Main SWAG index] [Original]