Category : Pascal Source Code
Archive   : SUNCOM.ZIP
Filename : WINDOWS.PAS

{ Windows - A Turbo Pascal 5.0 Unit. - Written By Boyd Fletcher

USE: WindowIn - To make a temporary window.
WindowOut - To remove the temporary window.
NOTE: Windows cannot be overlapped. That is you cannot use WindowIn twice
in a row without WindowOut being placed after the first WindowIn.

USE: MakeWindow - Places a permanent window on the screen. It can only be
removed by a WINDOW(1,1,80,25) and a CLRSCR command.
}


UNIT Windows;

INTERFACE

USES CRT,DOS;

VAR WindowPtr : Pointer;
CursorCol, CursorRow : Integer;

PROCEDURE FrameTypes(Mode : Integer; VAR TL,TR,BL,BR,H,V : Char);
PROCEDURE Frame(TopCol,TopRow,BotCol,BotRow,Mode : Integer);
PROCEDURE WindowIn(ForeGround,BackGround,Mode,TopCol,TopRow,
BotCol,BotRow : Integer;
VAR CursorCol, CursorRow : Integer;
VAR WindowPtr : Pointer);
PROCEDURE WindowOut(CursorCol, CursorRow : Integer;
VAR WindowPtr : Pointer);
PROCEDURE MakeWindow(ForeGround,BackGround,Mode,NoClr,
TopCol,TopRow,BotCol,BotRow : Integer);
PROCEDURE SetScreen(ForeGround,BackGround,NoClr,TopCol,
TopRow,BotCol,BotRow : Integer);
PROCEDURE SizeCursor(Top, Bot : Byte);
PROCEDURE OnCursor;
PROCEDURE OffCursor;
FUNCTION Clr(Color,
Mode : Integer) : Char;


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

IMPLEMENTATION


PROCEDURE SizeCursor;
VAR Reg : Registers;
BEGIN {SizeCursor}
with Reg do
begin
ax := 1 shl 8;
cx := Top shl 8 + Bot;
INTR($10,Reg);
end
END; {SizeCursor}

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

PROCEDURE OnCursor;
BEGIN {OnCursor}
SizeCursor(6,7);
END; {OnCursor}

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

PROCEDURE OffCursor;
BEGIN {OffCursor}
Sizecursor(14,0);
END; {OffCursor}

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

PROCEDURE FrameTypes;
BEGIN {Frame Types}
case Mode of
1 : begin
TL := #201; TR := #187;
BL := #200; BR := #188;
H := #205; V := #186;
end;
2 : begin
TL := #214; TR := #183;
BL := #211; BR := #189;
H := #196; V := #186;
end;
3 : begin
TL := #213; TR := #184;
BL := #212; BR := #190;
H := #205; V := #179;
end;
4 : begin
TL := #218; TR := #191;
BL := #192; BR := #217;
H := #196; V := #179;
end;
end;
END; {Frame Types}

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

PROCEDURE Frame;
VAR x : Integer;
TL,TR,BL,BR,H,V : Char;

BEGIN {Frame}
FrameTypes(Mode,TL,TR,BL,BR,H,V);
gotoXY(TopCol,BotRow);
write(BL);
gotoXY(BotCol,BotRow);
write(BR);
gotoXY(TopCol,TopRow);
write(TL);
gotoXY(BotCol,TopRow);
write(TR);
for x := TopRow+1 to BotRow-1 do
begin
gotoXY(TopCol,x);
write(v);
gotoXY(BotCol,x);
write(v);
end;
for x := TopCol+1 to BotCol-1 do
begin
gotoXY(x,TopRow);
write(h);
gotoXY(x,BotRow);
write(h);
end;
END; {Frame}

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

PROCEDURE WindowIn;

TYPE ScrnArray = Array[0..3999] of Byte;
ScreenPtr = ^ScrnArray;

VAR ScreenAddress : Word;
ScrnPtr : ScreenPtr;

BEGIN {Window In}
if (mem[0000:1040] and 48) <> 48
then ScreenAddress := $B800
else ScreenAddress := $B000;
mark(WindowPtr);
new(ScrnPtr);
CursorCol := whereX;
CursorRow := whereY;
move(mem[ScreenAddress:0000],ScrnPtr^,4000);
textcolor(ForeGround);
textbackground(BackGround);
if Mode <> 0 then FRAME(TopCol,TopRow,BotCol,BotRow,Mode);
textcolor(ForeGround);
textbackground(BackGround);
window(TopCol+1,TopRow+1,BotCol-1,BotRow-1);
clrscr;
dispose(ScrnPtr);
END; {Window In}

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

PROCEDURE WindowOut;

VAR ScreenAddress : Word;

BEGIN {Window Out}
if (mem[0000:1040] and 48) <> 48
then ScreenAddress := $B800
else ScreenAddress := $B000;
move(WindowPtr^,mem[ScreenAddress:0000],4000);
if WindowPtr <> Nil then dispose(WindowPtr);
window(1,1,80,25);
gotoXY(CursorCol,CursorRow);
END; {Window Out}

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

PROCEDURE MakeWindow;

BEGIN {Make Window}
window(1,1,80,25);
textcolor(ForeGround);
textbackground(BackGround);
if Mode <> 0 then FRAME(TopCol,TopRow,BotCol,BotRow,Mode);
textcolor(ForeGround);
textbackground(BackGround);
window(TopCol+1,TopRow+1,BotCol-1,BotRow-1);
if NoClr = 0 then clrscr;
END; {Make Window}

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

PROCEDURE SetScreen;

BEGIN {SetScreen}
window(TopCol,TopRow,BotCol,BotRow);
textcolor(ForeGround);
textbackground(BackGround);
if NoClr = 0 then clrscr;
END; {SetScreen}

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

FUNCTION Clr;

BEGIN {Clr}
if Mode = 0 then textcolor(Color);
if Mode = 1 then textbackground(Color);
Clr := #0;
END; {Clr}

END. {UNIT - Windows}