SLWindow.Pas & MenuUnit.Pas
Written by and Placed in the Public Domain by
Steven C. Lee
71076,1216

SLWindow and MenuUnit are Turbo Pascal 4.0 units containing
the windowing and menu routines used in Swiss Army Shell, a hard
disk file management program being distributed as Shareware.
Swiss Army Shell is available as SAS10.ARC on Compuserve's IBM
Software Forum in DL1 and on The ST BBS in Birmingham, Alabama
(205)836-9311 300/1200/2400-8-N-1.

SLWindow and MenuUnit are written entirely in Turbo Pascal.
I used the CURSORS unit by Scott Bussinger (available on
Compuserve's BORPROGA) to turn the cursor off and on during
window writing, but SLWindow will work fine without it by
removing the MakeCursor statements.

SLWindow and MenuUnit are not fancy, and not as fast as
assembler routines. However I have found their performance to be
quite adequate even on my ancient 4.77 Mhz Columbia. They are
very easy to use and I am placing them in the public domain. You
may do with them as you wish.

There is virtually no error checking, and they are designed
to work only in CGA mode. Swiss Army Shell has been tested on an
IBM PS/2 model 60 with VGA and worked fine, so these routines
should work fine on CGA, EGA, or VGA in CGA mode.


SLWindow.Pas
------------

SLWindow provides one type - TextWindow - and thirteen
procedures and functions. It defines one variable - WholeScrn -
which is automatically initialized at startup.

TextWindow is a record type which stores the upper left and
lower right corners of the window. It also contains the window
title and the foreground and background colors of the window.

Windows are drawn with a one character border, so the upper
left corner should never be outside coordinates X = 2 and Y = 2.
The lower right corner should never be outside X = 79 and Y = 24.
The border characters are defined as constants which can be
changed to whatever you like.

SLWindow uses the heap to allocate memory to save window
contents. You will need to allocate enough heap to store all of
the windows you plan to use at one time, but since RestScrn
releases the memory when it restores the screen, the same memory
may be used for multiple windows as long as they are not saved on
top of each other. A minimum of 4000 bytes is required, since
that is the amount used by WholeScrn. To calculate the amount of
heap required, you should use the following formula :

(X2 - X1 + 3) * (Y2 - Y1 + 3) * 2

This will give you the memory required for an individual
window. You should figure this for your largest window, and if
you will be performing multiple window saves between restores,
you will need to allow for those as well. Remember that RestScrn
will free the memory used by SaveScrn, so you don't need enough
memory to store all the windows in your program, just enough for
the maximum requirements of the windows on screen at one time.
When you have totaled up the individual window requirements, add
4000 for WholeScrn.

If you save the same window twice without calling RestScrn
in between, when RestScrn is called you will get the contents of
the screen when the second SaveScrn was performed. You will also
destroy the pointer to the memory allocated by the first call to
SaveScrn leaving you with no way to free it. (As I said, there
is virtually no error checking.) By changing the window
coordinates between calls to SaveScrn and RestScrn you could
restore the window to a different location on the screen.

The procedures and functions in SLWindow are described
below:

procedure PressaKey;
--------------------
PressaKey simply writes the message 'Press a key to continue...'
and waits for a key to be pressed.

procedure Beep;
---------------
Beep just beeps. You can change the frequencies and timing if
you don't like it.

procedure Message(Msg : string);
--------------------------------
Message places a message window in the center of the screen and
clears the message when a key is pressed.

procedure SwitchTo(Wind : TextWindow);
--------------------------------------
SwitchTo switches to the window specified and sets the foreground
and background colors to those previously defined for that
window. The cursor will be placed in the upper left corner of
the window.

procedure ReverseVideo(Wind : TextWindow);
------------------------------------------
ReverseVideo reverses the foreground and background colors. If
foreground has been defined as a high intensity color it will be
changed to the low intensity version of that color. Background
colors can only be low intensity, so ReverseVideo always changes
them to high intensity.

procedure NormalVideo(Wind : TextWindow);
-----------------------------------------
NormalVideo simply switches the foreground and background colors
to those originally defined for that window.

procedure SaveScrn(var Wind : TextWindow);
------------------------------------------
SaveScrn requests the amount of memory specified by
StoreSize from the heap manager, and stores the screen
segment defined for that window at the address returned.

procedure RestScrn(var Wind : TextWindow);
------------------------------------------
RestScrn restores a screen segment previously saved by SaveScrn.
It also frees the memory allocated for that window by SaveScrn.

procedure SetWindow(var WindowRec : TextWindow);
------------------------------------------------
SetWindow will place a previously defined window on the screen
and draw a border around it. It also sets the previously defined
foreground and background colors, and places the cursor at the
upper left corner of the window. If the window title is defined
as the null string or is too long to fit the top border, no title
will be printed. Results are unpredictable if the title is not
initialized.

function GetString(Name,Prompt,Default : string; MaxLen :integer):string;
---------------------------------------------------------------------------
GetString centers a window on the screen and prompts for input.
It returns the string entered, or the default if only Return is
pressed. GetString will not allow entry of more characters than
specified by MaxLen. Backspace will work in the expected manner.
Pressing Escape will return the null string. It is actually a
pretty crude routine because I tried to write it to handle any
size string up to 74 characters. When I got it working I had
other things to do, so I never bothered to improve it. The
parameters required are as follows:

Name : The title of the window. May be ''.
Prompt : The prompt you want to show such as 'Enter Path : '.
Default : The default string to be returned. May be ''.
MaxLen : The maximum allowable length of the input string.

function YesNo(Question : string):boolean;
------------------------------------------
YesNo centers a window on the screen and displays the Question
you specify. It will return true if 'Y' or 'y' is pressed, and
false if any other key is pressed.

procedure UseWholeScrn;
-----------------------
UseWholeScrn will save the entire screen, clear it, and place the
cursor at the upper left corner. A subsequent
RestScrn(WholeScrn) will restore it. The colors are defined as
White and Black in the initialization section of SLWindow, but
you can change them to whatever you like.

procedure InitWindow(var Wind : TextWindow;
Name : string;
LX,TY,RX,BY,Fore,Back : integer);
----------------------------------------------------------
InitWindow takes care of window initialization. The window must
have been previously declared as a variable of type TextWindow.
A typical call looks like this:

var
MyWindow : TextWindow;

InitWindow(MyWindow,'MyWindow',10,10,20,20,White,Blue);

This will initialize a window which a subsequent call to
SetWindow would place with upper left coordinates of X = 10,
Y = 10 and lower right coordinates of X = 20, Y = 20. The
foreground color would be set to White and the background color
to Blue. The window title would be 'MyWindow'.

InitWindow also initializes MyWindow.StoreSize which will
contain the number of bytes requested from the heap manager when
SaveScrn saves the screen segment.


MenuUnit.Pas
------------

MenuUnit defines one type - MenuType - and one variable
- HiLiteColor -. HiLiteColor must be initialized by your
program. This will be the color used to highlight the 'HOT' key
for each menu choice.

There is only one function in MenuUnit - MenuChoice. It
will return the number of the menu selection made. The normal
usage is:

case MenuChoice(MyMenu,X,Y) of
1 : DoNumber1;
2 : DoNumber2;
3 : DoNumber3;
end; {case}

X and Y are the coordinates where you want to place the
upper left corner of the menu window. The menu must have been
previously defined in the following manner:

procedure ArcOptions;
var
ArcMenu : Menutype;
begin
HiLiteColor := LightRed;
with ArcMenu do
begin
Name := 'Arc Options';
Choice[1] := 'Extract Tagged Files';
Choice[2] := 'UnArc Entire Archive';
Choice[3] := 'Delete Tagged Files';
HiLite := 'EUD';
NumChoices := 3;
Default := 1;
end; {with ArcMenu}
case MenuChoice(ArcMenu,40,3) of
1 : ExTagged;
2 : UnArc;
3 : DeleteTagged;
end; {case}
end; {ArcOptions}

The above is a procedure used in ArcView.Exe, the VIEW
component of Swiss Army Shell. (It is available seperately as
ARCVW.ARC and is Freeware.)

Name is the title of the menu. The menu choices are stored
in an array of strings. The array is defined with a maximum of
15 choices, but you may change that to whatever you want. The
maximum width of each choice may be up to 77 characters. (A word
of caution : if you define and place a menu that will not fit on
the screen the results will be unpredictable. No error checking
is performed.) You must also initialize NumChoices, which is the
number of menu choices, and Default. This menu would be placed
with the upper left corner at X = 40, Y = 3.

Default selects the choice on which the bar cursor will be
placed when MenuChoice is called. If your program can determine
what the most likely choice is, you can assign a value to Default
before calling MenuChoice, and the user can simply hit Return
when the menu is displayed.

HiLite must be initialized to a string consisting of the
'HOT' characters to be used by MenuChoice. In the procedure
above, the letter E would be highlighted in Choice[1], U in
Choice[2], and D in Choice[3]. HiLiteColor determines the color
used to highlight. Only the first matching character will be
highlighted. In the above case, if HiLite = 'EnD' then the first
'n' in 'UnArc Entire Archive' would be highlighted, however that
HiLite key would not work because MenuChoice converts lower case
letters input to upper case to prevent the shift key status from
interfering with its operation. Any character other than a lower
case letter may be used.

If E is pressed, then the procedure ExTagged would be
called, U would call UnArc, and D would call DeleteTagged. You
could also move the bar with the cursor keys and press Return to
make a selection. Escape returns a choice of 0.


KeyCodes.Def
------------

KEYCODES.DEF is an include file which can be placed in the
constant declaration section of your program. It provides names
for all (I think) of the extended keyboard scan codes, and
several of the normal scan codes. You can easily add to it by
determining the appropriate codes from an ASCII table. To see
how to use the codes just read the Screen Routines Section in
Chapter 5 of the Turbo Pascal 4.0 manual. Pay particular
attention to the repeat loop on page 80 and the HandleKey and
HandleFuncKey routines on page 81-82. You should also look at
the internal routine NormalKey and FuncKey in MenuChoice.Pas.


Wrap Up
-------

I have included a short program, SLDemo.Pas, which
demonstrates how to use these units. By no means does it
demonstrate all of the possibilities. For example, you could
define a two dimensional array of menus and write a procedure to
display multilevel pull down menus.

There are no comments in SLWindow.Pas and MenuUnit.Pas, so
you will be on your own figuring out how they work, but the
routines are short enough so that it should not be too difficult.
I did try to comment SLDemo.Pas heavily, so the use of these
units should be fairly clear. I hope you have fun with these
routines. Good luck!

Steven C. Lee
April 27, 1988