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

    Unit cursor;

    (*
     *  CURSOR v1.1 - a Unit to provide extended control of cursor shape.
     *
     *  Public Domain 1991 by John Giesbrecht (1:247/128)
     *
     *  Notes:
     *
     *  - This version requires Turbo Pascal 6.0 or later.
     *  - These routines affect only the cursor on page 0.
     *  - This Unit installs an Exit Procedure which restores the cursor
     *    to its original shape when the Programme terminates.
     *)

    Interface

    Procedure cursoroff;
    Procedure cursoron;           (* original cursor shape *)

    Procedure blockcursor;
    Procedure halfblockcursor;
    Procedure linecursor;         (* Default Dos cursor    *)

    Procedure setcursor(startline, endline : Byte);
    Procedure getcursor(Var startline, endline : Byte);

    (********************************************************************)

    Implementation

    Const
      mono = 7;

    Var
      origstartline,
      origendline,
      mode : Byte;
      origexitproc : Pointer;

    (********************************************************************)
    Procedure setcursor(startline, endline : Byte); Assembler;

    Asm
      mov ah, $01
      mov ch, startline
      mov cl, endline
      int $10
    end;
    (********************************************************************)
    Procedure getcursor(Var startline, endline : Byte); Assembler;

    Asm
      mov ah, $03
      mov bh, $00
      int $10
      les di, startline
      mov Byte ptr es:[di], ch
      les di, endline
      mov Byte ptr es:[di], cl
    end;
    (********************************************************************)
    Procedure cursoroff;

    begin
      setcursor(32, 32);
    end;
    (********************************************************************)
    Procedure cursoron;

    begin
      setcursor(origstartline, origendline);
    end;
    (********************************************************************)
    Procedure blockcursor;

    begin
      if mode = mono
        then setcursor(1, 12)
        else setcursor(1, 7);
    end;
    (********************************************************************)
    Procedure halfblockcursor;

    begin
      if mode = mono
        then setcursor(7, 12)
        else setcursor(4, 7);
    end;
    (********************************************************************)
    Procedure linecursor;
    begin
      if mode = mono
        then setcursor(11, 12)
        else setcursor(6, 7);
    end;
    (********************************************************************)
    Procedure restorecursor; Far;

    begin
      system.exitproc := origexitproc;
      cursoron;
    end;
    (**  I N I T I A L I Z A T I O N  ***********************************)
    begin
     getcursor(origstartline, origendline);
     Asm
      mov ah, $0F
      int $10
      mov mode, al
     end;
     origexitproc := system.exitproc;
     system.exitproc := addr(restorecursor);
    end.

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