Category : File Managers
Archive   : FNDUP40A.ZIP
Filename : WINDO.INC

{**********************************************************************}
{ W I N D O . I N C }
{ }
{**********************************************************************}
{ Kloned and Kludged by Lane Ferris }
{ -- The Hunters Helper -- }
{ Original Copyright 1984 by Michael A. Covington }
{ Extensive Modifications by Lynn Canning 9/25/85 }
{ 9107 Grandview Dr. }
{ Overland Park, Ks. 66212 }
{ 1) Foreground and Background colors added. }
{ NOTE: Monochrome monitors are automatically set }
{ to white on black. }
{ 2) Multiple borders added. }
{ 3) TimeDelay procedure added. }
{ Requirements: IBM PC or close compatible. }
{----------------------------------------------------------------------}
{ DOCUMENTATION }
{ by Lynn Canning }
{----------------------------------------------------------------------}
{ To make a window on the screen, call the procedure }
{ MkWin(x1,y1,x2,y2,BD,FG,BG); }
{ The x and y coordinates define the window placement and are the }
{ same as the Turbo Pascal Window coordinates. }
{ The border parameters (BD) are 0 = No border }
{ 1 = Single line border }
{ 2 = Double line border }
{ The foreground (FG) and background (BG) parameters are the same }
{ values as the corresponding Turbo Pascal values. }
{ }
{ The maximum number of windows open at one time is set at five }
{ (see MaxWin=5). This may be set to greater values if necessary. }
{ }
{ After the window is made, you must write the text desired from the }
{ calling program. Note that the usable text area is actually 1 }
{ position smaller than the window coordinates to allow for the border.}
{ Hence, a window defined as 1,1,80,25 would actually be 2,2,79,24 }
{ after the border is created. When writing to the window in your }
{ calling program, the textcolor and backgroundcolor may be changed as }
{ desired by using the standard Turbo Pascal commands. }
{ }
{ To return to the previous screen or window, call the procedure }
{ RmWin; }
{ }
{ The TimeDelay procedure is involked from your calling program. It }
{ is similar to the Turbo Pascal DELAY execpt DELAY is based on clock }
{ speed whereas TimeDelay is based on the actual clock. This means }
{ that the delay will be the same duration on all systems no matter }
{ what the clock speed. }
{ The procedure could be used for an error condition as follows: }
{ MkWin - make an error message window }
{ Writeln - write error message to window }
{ TimeDelay(5) - leave window on screen 5 seconds }
{ RmWin - remove error window }
{ cont processing }
{----------------------------------------------------------------------}



Const

InitDone :boolean = false ; { Initialization switch }

On = True ;
Off = False ;
VideoEnable = $08; { Video Signal Enable Bit }

Type
Imagetype = array [1..4000] of char; { Screen Image in the heap }
WinDimtype = record
x1,y1,x2,y2: integer
end;

Screens = record { Save Screen Information }
Image: Imagetype; { Saved screen Image }
Dim: WinDimtype; { Saved Window Dimensions }
x,y: integer; { Saved cursor position }
end;


Var

Win: { Global variable package }
record
Dim: WinDimtype; { Current Window Dimensions }
Depth: integer;
{ MaxWin should be included in your program }
{ and it should be the number of windows saved }
{ at one time }
{ It should be in the const section of your program }
Stack: array[1..MaxWin] of ^Screens;

end;

Crtmode :byte absolute $0040:$0049;
Crtwidth :byte absolute $0040:$004A;
Monobuffer :Imagetype absolute $B000:$0000;
Colorbuffer :Imagetype absolute $B800:$0000;
CrtAdapter :integer absolute $0040:$0063; { Current Display Adapter }
VideoMode :byte absolute $0040:$0065; { Video Port Mode byte }
Video_Buffer:LongInt; { Record the current Video}
FG :byte;
BG :integer;
BD :integer;
Switch :boolean;
Delta,
Xtemp,Ytemp :integer;
x,y :integer;

{------------------------------------------------------------------}
{ Delay for X seconds }
{------------------------------------------------------------------}

procedure TimeDelay (hold : integer);
type
RegRec = { The data to pass to DOS }
record
AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
{! 1. Instead use the Registers type from the Turbo 4.0 D^OS unit.}
end;
var
regs:regrec;
ah, al, ch, cl, dh:byte;
sec :string[2];
tmptime, result, secn, error, secn2, diff :integer;

begin
ah := $2c;
with regs do
begin
ax := ah shl 8 + al;
end;
intr($21,Dos.Registers(regs));
{! 2. Param^eter to Intr must be of the type Registers defined in DOS unit.}
with regs do
begin
str(dx shr 8:2, sec);
end;
if (sec[1] = ' ') then
sec[1]:= '0';
val(sec, secn, error);
repeat { stay in this loop until the time }
ah := $2c; { has expired }
with regs do
begin
ax := ah shl 8 + al;
end;
intr($21,Dos.Registers(regs));
with regs do
begin
str(dx shr 8:2, sec);
end;
if (sec[1] = ' ') then
sec[1]:= '0';
val(sec, secn2, error);
diff := secn2 - secn;
if diff < 0 then { we just went over the minute }
diff := diff + 60; { so add 60 seconds }
until diff > hold; { has our time expired yet }
end; { procedure TimeDelay }

{------------------------------------------------------------------}
{ Get Absolute postion of Cursor into parameters x,y }
{------------------------------------------------------------------}
Procedure Get_Abs_Cursor (var x,y :integer);
Var
Active_Page : byte absolute $0040:$0062; { Current Video Page Index}
Crt_Pages : array[0..7] of integer absolute $0040:$0050 ;

Begin

X := Crt_Pages[active_page]; { Get Cursor Position }
Y := Hi(X)+1; { Y get Row }
X := Lo(X)+1; { X gets Col position }
End;
{------------------------------------------------------------------}
{ Turn the Video On/Off to avoid Read/Write snow }
{------------------------------------------------------------------}
Procedure Video (Switch:boolean);
Begin
If (Switch = Off) then
Port[CrtAdapter+4] := (VideoMode - VideoEnable)
else Port[CrtAdapter+4] := (VideoMode or VideoEnable);
End;
{------------------------------------------------------------------}
{ InitWin Saves the Current (whole) Screen }
{------------------------------------------------------------------}
Procedure InitWin;
{ Records Initial Window Dimensions }
Begin

If CrtMode = 7 then
Video_Buffer := $B000 {Set Ptr to Monobuffer }
{! 3. Assign unsigned ^values of $8000 or larger only to Word or LongInt types.}
else Video_Buffer := $B800; { or Color Buffer }
{! 4. Assign unsigned value^s of $8000 or larger only to Word or LongInt types.}

with Win.Dim do
begin x1:=1; y1:=1; x2:=crtwidth; y2:=25 end;
Win.Depth:=0;
InitDone := True ; { Show initialization Done }
end;
{------------------------------------------------------------------}
{ BoxWin Draws a Box around the current Window }
{------------------------------------------------------------------}
procedure BoxWin(x1,y1,x2,y2:integer; BD:integer; FG:integer; BG:integer);

{ Draws a box, fills it with blanks, and makes it the current }
{ Window. Dimensions given are for the box; actual Window is }
{ one unit smaller in each direction. }

var
x,y,I : integer;
TB,SID,TLC,TRC,BLC,BRC :integer;

begin
if Crtmode = 7 then begin
FG := 7;
BG := 0;
end;
Window(x1,y1,x2,y2);
TextColor(FG) ;
TextBackground(BG);
if BD = 1 then begin
TB := 196;
SID := 179;
TLC := 218;
TRC := 191;
BLC := 192;
BRC := 217;
end
else begin
TB := 205;
SID := 186;
TLC := 201;
TRC := 187;
BLC := 200;
BRC := 188;
end;
if BD <> 0 then begin
{ Top }
gotoxy(1,1); { Windo Origin }
Write( chr(TLC) ); { Top Left Corner }
For I:=2 to x2-x1 do { Top Bar }
Write( chr(TB));
Write( chr(TRC) ); { Top Right Corner

{ Sides }
for I:=2 to y2-y1 do
begin
gotoxy(1,I); { Left Side Bar }
write( chr(SID) );
gotoxy(x2-x1+1,I) ; { Right Side Bar }
write( chr(SID) );
end;

{ Bottom }
gotoxy(1,y2-y1+1); { Bottom Left Corner }
write( chr(BLC) );
for I:=2 to x2-x1 do { Bottom Bar }
write( chr(TB) );

{ Make it the current Window }
Window(x1+1,y1+1,x2-1,y2-1);
write( chr(BRC) ); { Bottom Right Corner }
end;
gotoxy(1,1) ;
TextColor( FG mod 16); { Take Low nibble 0..15 }
TextBackground (BG); { Take High nibble 0..9 }
ClrScr;
end;
{------------------------------------------------------------------}
{ MkWin Make a Window }
{------------------------------------------------------------------}
procedure MkWin(x1,y1,x2,y2 :integer; BD:integer; FG:byte; BG:integer);
{ Create a removable Window }

begin

If (InitDone = false) then { Initialize if not done yet }
InitWin;

with Win do Depth:=Depth+1; { Increment Stack pointer }
if Win.Depth>maxWin then
begin
writeln(^G,' Windows nested too deep ');
halt
end;
{-------------------------------------}
{ Save contents of screen }
{-------------------------------------}
Video(Off) ; { Turn off Video to avoid Snow }

With Win do
Begin
New(Stack[Depth]); { Allocate Current Screen to Heap }
If CrtMode = 7 then
Stack[Depth]^.Image := monobuffer { set pointer to it }
else
Stack[Depth]^.Image := colorbuffer ;
End ;

Video(On) ; { Turn the Video back on }

With Win do
Begin { Save Screen Dimentions }
Stack[Depth]^.Dim := Dim;
Stack[Win.Depth]^.x := wherex; { Save Cursor Position }
Stack[Win.Depth]^.y := wherey;
End ;

{ Validate the Window Placement}
If (X2 > 80) then { If off right of screen }
begin
Delta := (X2 - 80); { Overflow off right margin }
X1 := X1 - Delta ; { Move Left window edge }
X2 := X2 - Delta ; { Move Right edge on 80 }
end;
If (Y2 > 25) then { If off bottom screen }
begin
Delta := Y2 - 25; { Overflow off right margin }
Y1 := Y1 - Delta ; { Move Top edge up }
Y2 := Y2 - Delta ; { Move Bottom 24 }
end;
{ Create the Window New window }
BoxWin(x1,y1,x2,y2,BD,FG,BG);
Win.Dim.x1 := x1+1;
Win.Dim.y1 := y1+1; { Allow for margins }
Win.Dim.x2 := x2-1;
Win.Dim.y2 := y2-1;

end;
{------------------------------------------------------------------}
{ Remove Window }
{------------------------------------------------------------------}
{ Remove the most recently created removable Window }
{ Restore screen contents, Window Dimensions, and }
{ position of cursor. }
Procedure RmWin;
Var
Tempbyte : byte;

Begin
Video(Off);

With Win do
Begin { Restore next Screen }
If crtmode = 7 then
monobuffer := Stack[Depth]^.Image
else
colorbuffer := Stack[Depth]^.Image;
Dispose(Stack[Depth]); { Remove Screen from Heap }

Video(On);

With Win do { Re-instate the Sub-Window }
Begin { Position the old cursor }
Dim := Stack[Depth]^.Dim;
Window(Dim.x1,Dim.y1,Dim.x2,Dim.y2);
gotoxy(Stack[Depth]^.x,Stack[Depth]^.y);
end;

Get_Abs_Cursor(x,y) ; { New Cursor Position }
Tempbyte := { Get old Cursor attributes }
Mem[ Video_Buffer:((x-1 + (y-1) * 80 ) * 2)+1 ];

TextColor( Tempbyte And $0F ); { Take Low nibble 0..15}
TextBackground ( Tempbyte Div 16); { Take High nibble 0..9 }
Depth := Depth - 1
end ;
end;
{------------------------------------------------------------------}
{------------------------------------------------------------------}