home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CRSR5X.ZIP / CURSOR5X.PAS
Encoding:
Pascal/Delphi Source File  |  1989-01-01  |  5.4 KB  |  105 lines
  1. { =========================================================================== }
  2. { Cursor5x.pas - Restores cursor for any video card.        ver 5.X, 01-01-89 }
  3. { by  James H. LeMay, CIS 76011,217                                           }
  4. { for Eagle Performance Software                                              }
  5. {     P.O. Box 122237                                                         }
  6. {     Ft. Worth, TX 76121                                                     }
  7. {     (817)-735-4833                                                          }
  8. {                                                                             }
  9. { This program will let you restore your cursor automatically on whatever     }
  10. { system you have:                                                            }
  11. {                                                                             }
  12. {   Usage: Cursor                               << Underline cursor           }
  13. {          Cursor [-bh?]                        << Block cursor or help       }
  14. {          Cursor [TopScanLine BottomScanLine]  << Custom shape               }
  15. {   No parameters makes an underline cursor.                                  }
  16. {   -b makes a block cursor.                                                  }
  17. {   Two decimal parameters shape the scan lines.                              }
  18. {   Anything else just displays the usage.                                    }
  19. {   The "-" and "/" are optional                                              }
  20. {                                                                             }
  21. { For more information on cursor shapes for different video devices, get      }
  22. { QWIK5X.ARC.  QWIK.TPU is required to compile this program which is also in  }
  23. { QWIK5X.ARC.  This source code is public domain, but QWIK is shareware.      }
  24. { QWIK is initialized in the unit and detects your video system including:    }
  25. {                                                                             }
  26. {    IBM PC, XT, AT, PCjr, PC convertible, all PS/2 models, 3270 PC.          }
  27. {    MDA, CGA, EGA, MCGA, VGA, 8214/A, all Hercules.                          }
  28. {    And all compatibles.                                                     }
  29. {    Operating in all text modes, column modes, and row modes.                }
  30. {                                                                             }
  31. { QWIK turns on the cursor emulation mode for the VGA.                        }
  32. {                                                                             }
  33. { EXAMPLES:                                                                   }
  34. {   cursor -b                  << Restores block cursor                       }
  35. {   cursor -h                  << Displays help                               }
  36. {   cursor 0 13                << Makes a block-type cursor (MDA)             }
  37. {                                                                             }
  38. {                                                                             }
  39. { Revisions:                                                                  }
  40. {   Version 1.1, 04-08-88                                                     }
  41. {     . Accounted for CGA emulation on EGA with CheckCgaEmulation.            }
  42. {   Version 4.2, 08-01-88                                                     }
  43. {     . Revised program for QWIK42.TPU                                        }
  44. {   Version 5.X, 01-01-89                                                     }
  45. {     . Revised directives for TP5 and QWIK5X.TPU                             }
  46. { =========================================================================== }
  47.  
  48. program RestoreCursor;
  49.  
  50. {$M 1500, 0, 0}
  51. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  52.  
  53. uses Qwik;  { QWIK.TPU is found in QWIK5X.ARC or a later version. }
  54.  
  55. var
  56.   BottomScanLine,TopScanLine: byte;
  57.   CursorMode:                 word absolute BottomScanLine;
  58.   ParameterError:             boolean;
  59.   Attr:                       integer;
  60.  
  61. procedure GetBlockCursor;
  62. var P: string[10];
  63. begin
  64.   P := ParamStr(1);
  65.   if (pos('b',P)>0) or (pos('B',P)>0) then
  66.        CursorMode := CursorBlock
  67.   else ParameterError:=true;  { Show command usage. }
  68. end;
  69.  
  70. procedure GetCustomCursor;
  71. var  Error1,Error2: integer;
  72. begin
  73.   val (ParamStr(1),TopScanLine   ,Error1);
  74.   val (ParamStr(2),BottomScanLine,Error2);
  75.   if Error1+Error2<>0 then
  76.     ParameterError:=true;  { Show command usage. }
  77. end;
  78.  
  79. begin
  80.   ParameterError:=false;
  81.   case ParamCount of
  82.     0: CursorMode := CursorUnderline;
  83.     1: GetBlockCursor;
  84.     2: GetCustomCursor;
  85.   else ParameterError := true;
  86.   end;
  87.   if ParameterError then
  88.     begin
  89.       ScrollAttr := QreadAttr (WhereR,WhereC);
  90.       Attr       := ScrollAttr;
  91.       EosToCursor;
  92.       QwriteEos (Attr,'CURSOR 4.2 (c) 1988 Eagle Performance Software');QEosLn;
  93.       QwriteEos (Attr,'Restores default cursor on any system.');        QEosLn;
  94.       QwriteEos (Attr,'Usage: Cursor');                                 QEosLn;
  95.       QwriteEos (Attr,'       Cursor [-bh?]');                          QEosLn;
  96.       QwriteEos (Attr,'       Cursor [TopScanLine BottomScanLine]');    QEosLn;
  97.       QwriteEos (Attr,'No parameters makes an underline cursor.');      QEosLn;
  98.       QwriteEos (Attr,'-b makes a block cursor.');                      QEosLn;
  99.       QwriteEos (Attr,'Two decimal parameters shape the scan lines.');  QEosLn;
  100.       GotoEos;
  101.     end
  102.   else
  103.     SetCursor (CursorMode);
  104. end.
  105.