Category : Pascal Source Code
Archive   : INT101.ZIP
Filename : CURSORS.PAS

{$R-,S-,I-,D-,T-,F-,V-,B-,N-}

unit Cursors;

{ A unit for changing the appearance of the display cursor.

Version 1.02 - 10/26/1987 - First general release

Scott Bussinger
Professional Practice Systems
110 South 131st Street
Tacoma, WA 98444
(206)531-8944
Compuserve 72247,2671 }


interface

uses Dos;

type CursorSize = word;
CursorType = (UnderlineCursor,BlockCursor,NoCursor,RestoreCursor);

procedure GetCursor(var Curs: CursorSize);
{ Get the current cursor size }

procedure SetCursor(Curs: CursorSize);
{ Set the current cursor size }

procedure MakeCursor(CursType: CursorType);
{ Set the cursor to the indicated style -- adjusts for display type }

procedure GetCursorLoc(var Row,Column: byte);
{ Return the current cursor location }

procedure SetCursorLoc(Row,Column: byte);
{ Move the cursor to the given location }

function MonoDisplay: boolean;
{ Return true if the current display is a monochrome adapter }

implementation

var ExitSave: pointer;
OriginalCursor: CursorSize;

function MonoDisplay: boolean;
{ Return true if the current display is a monochrome adapter }
var Reg: Registers;
begin
Reg.AH := $0F;
Intr($10,Reg);
MonoDisplay := Reg.AL = 7
end;

procedure GetCursor(var Curs: CursorSize);
{ Get the current cursor size }
var Reg: Registers;
begin
Reg.AH := $03;
Reg.BH := $00;
Intr($10,Reg);
if (Reg.CX=$0607) and MonoDisplay
then
Curs := $0C0D { Watch out for bug in DOS }
else
Curs := Reg.CX
end;

procedure SetCursor(Curs: CursorSize);
{ Set the current cursor size }
var Reg: Registers;
begin
Reg.AH := $01;
Reg.CX := Curs;
Intr($10,Reg)
end;

procedure MakeCursor(CursType: CursorType);
{ Set the cursor to the indicated style -- adjusts for display type }
var LastLine: CursorSize;
begin
if MonoDisplay
then
LastLine := $000D
else
LastLine := $0007;
case CursType of
UnderlineCursor: SetCursor(swap(pred(LastLine)) + LastLine);
BlockCursor: SetCursor(LastLine);
NoCursor: SetCursor($2000);
RestoreCursor: SetCursor(OriginalCursor)
end
end;

procedure GetCursorLoc(var Row,Column: byte);
{ Return the current cursor location }
var Reg: Registers;
begin
Reg.AH := $03;
Reg.BH := $00;
Intr($10,Reg);
Row := succ(Reg.DH);
Column := succ(Reg.DL)
end;

procedure SetCursorLoc(Row,Column: byte);
{ Move the cursor to the given location }
var Reg: Registers;
begin
Reg.AH := $02;
Reg.BH := $00;
Reg.DL := pred(Column);
Reg.DH := pred(Row);
Intr($10,Reg)
end;

{$F+}
procedure ExitHandler;
{ Return the cursor to its original shape }
begin
MakeCursor(RestoreCursor);
ExitProc := ExitSave
end;
{$F-}

begin
ExitSave := ExitProc;
ExitProc := @ExitHandler;
GetCursor(OriginalCursor)
end.