Category : System Diagnostics for your computer
Archive   : EVALCACH.ZIP
Filename : CHARSCRN.PAS

{
***************************************************************************
CHARSCRN.PAS -- Character-oriented screen routines/objects for Turbo Pascal
Copyright 1989 L. Brett Glass -- All rights reserved.
***************************************************************************
}
unit CharScrn;

interface

uses DOS,CRT;

const
FIRSTCOL = 1; {Numbering of rows and columns}
SECONDCOL = Succ(FIRSTCOL);
LASTCOL = 80;

FIRSTROW = 1;
LASTROW = 25;

SCREENHEIGHT = Succ(LASTROW - FIRSTROW);
SCREENWIDTH = Succ(LASTCOL - FIRSTCOL);

CURSOROFF = $2000; {Cursor mode which turns cursor off on all video cards }

type
ColType = FIRSTCOL..LASTCOL;
RowType = FIRSTROW..LASTROW;
WidthType = 1..SCREENWIDTH;
HeightType = 1..SCREENHEIGHT;

CharObject = object
x : ColType;
y : RowType
end;

ScreenParms = object (CharObject)
{Used to save screen parameters during routines}
cursorMode : Integer; {that change them while they work}
attribute : Byte;
{Methods}
procedure Save;
procedure Restore;
end;

VisibleCharObject = object (CharObject)
color : Byte;
dirty : Boolean;
{Methods}
procedure Draw; virtual;
procedure Refresh; {Draw if dirty}
end;

TitledCharObject = object(VisibleCharObject)
title : String[SCREENWIDTH];
{Methods}
procedure DispTitle; virtual;
procedure Draw; virtual;
end;

var
cursorOn : Word; {Cursor mode to turn cursor on for this specific card}

procedure CharToScreen(x : ColType; y : RowType; ch : Char);
{Write a character to the screen at an arbitrary spot}

procedure CharsToScreen(x : ColType; y : RowType; len : Word; var chars);
{Write an array of characters to the screen.}

procedure FillBox(left : ColType; top : RowType;
width : WidthType; height : HeightType;
value : Char);
{ Fill a rectangular region of the screen with the character, using
the current attribute.}

{ Cursor operations }

function GetCursorMode: Word;
{Get cursor mode from BIOS}

procedure SetCursorMode(mode : Word);
{Set cursor mode through BIOS}

implementation

procedure CharToScreen(x : ColType; y : RowType; ch : Char);
begin
GoToXY(x,y);
Write(ch)
end; {CharsToScreen}

procedure CharsToScreen(x : ColType; y : RowType; len : Word; var chars);
var
charPtr : ^Char;
charOfs : Word absolute charPtr;
i : Word;
begin
GoToXY(x,y);
charPtr := Addr(chars);
for i := 1 to len do
begin
Write(charPtr^);
Inc(charOfs)
end
end; {CharsToScreen}

procedure FillBox(left : ColType; top : RowType;
width : WidthType; height : HeightType; value : Char);
var
i,j : Word;
begin
for i := top to Pred(top + height) do
begin
GoToXY(left,i);
for j := left to Pred(left + width) do
Write(value)
end
end; {FillBox}

function GetCursorMode : Word;
var
regs : Registers;

begin {GetCursorMode}
regs.ax := $300;
Intr($10,regs);
GetCursorMode := regs.cx;
end; {GetCursorMode}

procedure SetCursorMode(mode : Word);
var
regs : Registers;
begin {SetCursorMode}
regs.ax := $100;
regs.cx := mode;
Intr($10,regs)
end; {SetCursorMode}

procedure ScreenParms.Save;
begin
cursorMode := GetCursorMode;
attribute := TextAttr;
x := WhereX;
y := WhereY;
end;

procedure ScreenParms.Restore;
begin
SetCursorMode(cursorMode);
TextAttr := attribute;
GotoXY(x,y);
end;

procedure VisibleCharObject.Refresh;
begin
if dirty then
self.Draw
end; {VisibleCharObject.Refresh}

procedure VisibleCharObject.Draw;
const
questionChar : Char = '?';
var
p : ScreenParms;
begin
p.Save;
TextAttr := color;
CharsToScreen(x,y,1,questionChar);
p.Restore;
end; {VisibleCharObject.Draw}

procedure TitledCharObject.DispTitle;
var
p : ScreenParms;
begin
p.Save;
TextAttr := color;
CharsToScreen(x,y,Length(title),title[1]);
p.Restore
end; {TitledCharObject.DispTitle}

procedure TitledCharObject.Draw;
begin
if Length(title) = 0 then
VisibleCharObject.Draw
else
self.DispTitle
end; {TitledCharObject.DispTitle}

begin
if lastMode = MONO then
cursorOn := $0B0C { start/end scan lines }
else
cursorOn := $0607;
end.