home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CRSR10.ZIP / CURSOR10.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-02-18  |  4.9 KB  |  108 lines
  1. { =========================================================================== }
  2. { Cursor10.pas - Restores cursor for any video card.        ver 1.0, 02-18-88 }
  3. { by James H. LeMay, CIS 76011,217                                            }
  4. {    6341 Klamath Rd.                                                         }
  5. {    Ft. Worth, TX 76116                                                      }
  6. {    1-817-735-4833                                                           }
  7. {                                                                             }
  8. { This program will let you restore your cursor automatically on whatever     }
  9. { system you have:                                                            }
  10. {                                                                             }
  11. {   Usage: Cursor                               << Underline cursor           }
  12. {          Cursor [-bh?]                        << Block cursor or help       }
  13. {          Cursor [TopScanLine BottomScanLine]  << Custom shape               }
  14. {   No parameters makes an underline cursor.                                  }
  15. {   -b makes a block cursor.                                                  }
  16. {   Two decimal parameters shape the scan lines.                              }
  17. {   Anything else just displays the usage.                                    }
  18. {                                                                             }
  19. { For more information on cursor shapes for different video devices, get      }
  20. { QWIK40.ARC.  QWIK.TPU is required to compile this program which is also in  }
  21. { QWIK40.ARC.  CURSOR10.EXE was compiled with a modified version of           }
  22. { QWIK40.TPU.  This source code is public domain, but QWIK is shareware.      }
  23. { QWIK is initialized in the unit and detects your video system including:    }
  24. {                                                                             }
  25. {    IBM PC, XT, AT, PCjr, PC convertible, all PS/2 models, 3270 PC.          }
  26. {    MDA, CGA, EGA, MCGA, VGA, 8214/A, all Hercules.                          }
  27. {    And all compatibles.                                                     }
  28. {    Operating in all text modes, column modes, and row modes.                }
  29. {                                                                             }
  30. { QWIK turns on the cursor emulation mode for the VGA.                        }
  31. {                                                                             }
  32. { EXAMPLES:                                                                   }
  33. {   cursor -b                  << Restores block cursor                       }
  34. {   cursor -h                  << Displays help                               }
  35. {   cursor 0 13                << Makes a block-type cursor (MDA)             }
  36. { =========================================================================== }
  37.  
  38. program RestoreCursor;
  39.  
  40. {$M 3000, 0, 0}
  41. {$R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }
  42.  
  43. uses Crt,Qwik;  { QWIK.TPU is found in QWIK40.ARC or a later version. }
  44.  
  45. var
  46.   CursorMode,   { High byte is top scan line; low byte is bottom. }
  47.   OldCursor:      word;
  48.   ParameterError: boolean;
  49.  
  50. procedure GetBlockCursor;
  51. begin
  52.   if (pos('b',ParamStr(1))>0) or (pos('B',ParamStr(1))>0) then
  53.     case ActiveDispDev of
  54.       MdaMono:                      CursorMode:=$000D;
  55.       CgaColor,McgaMono..McgaColor: CursorMode:=$0007;
  56.       EgaColor..VgaColor:           CursorMode:=pred(EgaFontSize);
  57.     end
  58.   else ParameterError:=true;  { Show command usage. }
  59. end;
  60.  
  61. procedure GetCustomCursor;
  62. var
  63.   Error1,Error2:              integer;
  64.   TopScanLine,BottomScanLine: byte;
  65. begin
  66.   val (ParamStr(1),TopScanLine   ,Error1);
  67.   val (ParamStr(2),BottomScanLine,Error2);
  68.   if Error1+Error2=0 then
  69.     CursorMode:=TopScanLine shl 8 + BottomScanLine
  70.   else ParameterError:=true;  { Show command usage. }
  71. end;
  72.  
  73. procedure GetUnderlineCursor;
  74. var BottomScanLine: byte;
  75. begin
  76.   case ActiveDispDev of
  77.     MdaMono:                      CursorMode:=$0B0C;
  78.     CgaColor,McgaMono..McgaColor: CursorMode:=$0607;
  79.     EgaColor..VgaColor:
  80.       begin
  81.         BottomScanLine:=EgaFontSize-2;
  82.         CursorMode:=(pred(BottomScanLine) shl 8) + BottomScanLine;
  83.       end;
  84.   end;
  85. end;
  86.  
  87. begin
  88.   ParameterError:=false;
  89.   case ParamCount of
  90.     1: GetBlockCursor;
  91.     2: GetCustomCursor;
  92.   else GetUnderlineCursor;
  93.   end;
  94.   if ParameterError then
  95.     begin
  96.       CheckSnow:=Qsnow;
  97.       writeln ('CURSOR 1.0 (c) 1988 James H. LeMay');
  98.       writeln ('Restores default cursor on any system.');
  99.       writeln ('Usage: Cursor');
  100.       writeln ('       Cursor [-bh?]');
  101.       writeln ('       Cursor [TopScanLine BottomScanLine]');
  102.       writeln ('No parameters makes an underline cursor.');
  103.       writeln ('-b makes a block cursor.');
  104.       writeln ('Two decimal parameters shape the scan lines.');
  105.     end
  106.   else CursorChange (CursorMode,OldCursor);
  107. end.
  108.