home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 3
/
hamradioversion3.0examsandprograms1992.iso
/
mods
/
pk232src
/
sss_pwin.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-09-09
|
10KB
|
266 lines
{----------------------------------------------------------------------}
{ Pop-up window subroutines of the Split-Screen Server (SSS) }
{----------------------------------------------------------------------}
{ }
{ Author: form SIG disks }
{ }
{ Modified (adapted) by HB9CVV }
{ }
{----------------------------------------------------------------------}
{ PTWSet (Screen#, X1, Y1, X2, Y2, BorderSwitch, BackgroundColor, }
{ ForegroundColor) }
{ Sets up window coordinates so that later references can be made by }
{ Mnemonic only. PTWSet must be done once for each window before it is }
{ Opened. The Screen# is a number between 1 and the maximum number of }
{ windows allowable set in the Constants Block below. The X and Y }
{ Coordinates are the same as for the Turbo Pascal Window procedure. }
{ A border may be placed around the window and the size of the window }
{ will be decreased to fit inside the border. The BorderSwitch }
{ functions are: 0 - No border }
{ 1 - Single line block graphics border }
{ 2 - Double line block graphics border }
{ -1 - Single line Reversed color border }
{ -2 - Double line Reversed color border }
{ The BackgroundColor and ForegroundColor parameters are the same as }
{ for the Turbo Pascal TextColor and TextBackground procedures. }
{ PTWOpen (Screen#) }
{ Activates a window (previously set by PTWSet) and saves the screen }
{ covered by the window. In the Constants Block following, there is a }
{ parameter that sets the maximum number of windows that may be open }
{ at any one time. }
{ PTWClose }
{ De-activates the open window, activates the previous window and }
{ restores the screen covered by the closed window. Note that the }
{ PTWOpen & PTWClose have a "Push/Pop" type of action. }
{ Constant Values (Parameters) That must be included in the source pgm }
{ }
{ CONST PTOOLWIN_Number_of_Windows = nn; }
{ }
{ This determines the number of windows that may be set with the PTWSet }
{ procedure.This also determines the maximum number of windows that may }
{ be open at any one time. Use the greater of the two. }
{ Areas for internal use Begin Here *********************************** }
TYPE
PTOOLWIN_Set_Info = RECORD
PTOOLWIN_X1 : Integer;
PTOOLWIN_Y1 : Integer;
PTOOLWIN_X2 : Integer;
PTOOLWIN_Y2 : Integer;
PTOOLWIN_Border : Integer;
PTOOLWIN_Back : Integer;
PTOOLWIN_Fore : Integer;
END;
PTOOLWIN_Stacks = ARRAY[1..25] OF STRING[160];
CONST
PTOOLWIN_Screen_Type : Char = 'X'; {Initial value neither 'M' or 'C', LP}
VAR
PTOOLWIN_C_Screen : Char ABSOLUTE $B800 : $0000;
PTOOLWIN_M_Screen : Char ABSOLUTE $B000 : $0000;
PTOOLWIN_Set : ARRAY[1..PTOOLWIN_Number_of_Windows]
OF PTOOLWIN_Set_Info;
PTOOLWIN_Stack_Num : ARRAY[1..PTOOLWIN_Number_of_Windows] OF Integer;
PTOOLWIN_Stack_X : ARRAY[1..PTOOLWIN_Number_of_Windows] OF Integer;
PTOOLWIN_Stack_Y : ARRAY[1..PTOOLWIN_Number_of_Windows] OF Integer;
PTOOLWIN_Stack : ARRAY[1..PTOOLWIN_Number_of_Windows]
OF^PTOOLWIN_Stacks;
PTOOLWIN_Curr : PTOOLWIN_Set_Info;
CONST
PTOOLWIN_Stack_Size : Byte = 0;
PTOOLWIN_Full_Screen : PTOOLWIN_Set_Info = (PTOOLWIN_X1 : 1;
PTOOLWIN_Y1 : 1;
PTOOLWIN_X2 : 80;
PTOOLWIN_Y2 : 25;
PTOOLWIN_Border : 0;
PTOOLWIN_Back : 0;
PTOOLWIN_Fore : 15);
{ Internal Procedures Begin Here ************************************** }
PROCEDURE DetermineDisplay;
{ Set ScreenBase to $B000 or $B800, depending on which display is in use.
A side effect is that the cursor is left at (1,1) on the screen. }
VAR
M, C : Integer;
T : Byte;
BEGIN
M := MemW[$B000:0]; {Mono 1,1}
C := MemW[$B800:0]; {Color 1,1}
{Set T to a value which is different than either Hi(M) or Hi(C).
The three values of T, 64, 65 and 66 are arbitrary.}
T := 64;
IF (Hi(M) = T) OR (Hi(C) = T) THEN T := 65; {If not, neither is 64}
IF (Hi(M) = T) OR (Hi(C) = T) THEN T := 66; {If not, one is 64,
the other is not 65. If so, one is 64, the other is 65, so neither is 66}
GoToXY(1, 1); {To $B000 if mono, $B800 if color}
Write(Chr(T));
GoToXY(1, 1);
IF Mem[$B000:0] = T THEN PTOOLWIN_Screen_Type := 'M' {LP modification}
ELSE PTOOLWIN_Screen_Type := 'C'; {LP modification}
MemW[$B000:0] := M;
MemW[$B800:0] := C;
END;
{ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
PROCEDURE PTOOLWIN_Open_Window(Screen : Integer; OpenType : Char);
VAR
I : Byte;
BEGIN
IF (Screen = 0) OR
(PTOOLWIN_Stack_Size = 0) THEN PTOOLWIN_Curr := PTOOLWIN_Full_Screen
ELSE PTOOLWIN_Curr := PTOOLWIN_Set[Screen];
WITH PTOOLWIN_Curr DO
BEGIN
Window(PTOOLWIN_X1, PTOOLWIN_Y1,
PTOOLWIN_X2, PTOOLWIN_Y2);
IF PTOOLWIN_Border >= 0 THEN
BEGIN
TextBackground(PTOOLWIN_Back);
TextColor(PTOOLWIN_Fore);
END
ELSE
BEGIN
TextBackground(PTOOLWIN_Fore);
TextColor(PTOOLWIN_Back);
END;
IF (Abs(PTOOLWIN_Border) = 1) AND
(OpenType = 'N') THEN
BEGIN
GoToXY(1, 1); Write('┌');
FOR I := 2 TO PTOOLWIN_X2-PTOOLWIN_X1 DO
Write('─');
Write('┐');
FOR I := 2 TO PTOOLWIN_Y2-PTOOLWIN_Y1 DO
BEGIN
GoToXY(1, I);
Write('│');
GoToXY(PTOOLWIN_X2-PTOOLWIN_X1+1, I);
Write('│');
END;
GoToXY(1, PTOOLWIN_Y2-PTOOLWIN_Y1+1); Write('└');
FOR I := 2 TO PTOOLWIN_X2-PTOOLWIN_X1 DO
Write('─');
END;
IF (Abs(PTOOLWIN_Border) = 2) AND
(OpenType = 'N') THEN
BEGIN
GoToXY(1, 1); Write('╔');
FOR I := 2 TO PTOOLWIN_X2-PTOOLWIN_X1 DO
Write('═');
Write('╗');
FOR I := 2 TO PTOOLWIN_Y2-PTOOLWIN_Y1 DO
BEGIN
GoToXY(1, I);
Write('║');
GoToXY(PTOOLWIN_X2-PTOOLWIN_X1+1, I);
Write('║');
END;
GoToXY(1, PTOOLWIN_Y2-PTOOLWIN_Y1+1); Write('╚');
FOR I := 2 TO PTOOLWIN_X2-PTOOLWIN_X1 DO
Write('═');
END;
IF PTOOLWIN_Border <> 0 THEN
BEGIN
Window(PTOOLWIN_X1+1, PTOOLWIN_Y1+1,
PTOOLWIN_X2-1, PTOOLWIN_Y2-1);
IF OpenType = 'N' THEN
IF Abs(PTOOLWIN_Border) = 1 THEN Write('┘')
ELSE Write('╝');
END;
TextBackground(PTOOLWIN_Back);
TextColor(PTOOLWIN_Fore);
END;
END;
{ Called Procedures Begin Here ******************************************** }
PROCEDURE PTWSet(Window, X1, Y1, X2, Y2, Border, Back, Fore : Integer);
BEGIN
IF PTOOLWIN_Screen_Type = 'X' THEN DetermineDisplay; {LP modification}
WITH PTOOLWIN_Curr DO
BEGIN
PTOOLWIN_X1 := X1;
PTOOLWIN_Y1 := Y1;
PTOOLWIN_X2 := X2;
PTOOLWIN_Y2 := Y2;
PTOOLWIN_Border := Border;
PTOOLWIN_Back := Back;
PTOOLWIN_Fore := Fore;
END;
PTOOLWIN_Set[Window] := PTOOLWIN_Curr;
END;
PROCEDURE PTWOpen(Screen : Integer);
BEGIN
PTOOLWIN_Stack_Size := PTOOLWIN_Stack_Size+1;
PTOOLWIN_Stack_Num[PTOOLWIN_Stack_Size] := Screen;
PTOOLWIN_Stack_X[PTOOLWIN_Stack_Size] := WhereX;
PTOOLWIN_Stack_Y[PTOOLWIN_Stack_Size] := WhereY;
New(PTOOLWIN_Stack[PTOOLWIN_Stack_Size]);
IF PTOOLWIN_Screen_Type = 'C' THEN
Move(PTOOLWIN_C_Screen, PTOOLWIN_Stack[PTOOLWIN_Stack_Size]^, 4000)
ELSE
Move(PTOOLWIN_M_Screen, PTOOLWIN_Stack[PTOOLWIN_Stack_Size]^, 4000);
PTOOLWIN_Open_Window(Screen, 'N');
END;
PROCEDURE PTWClose;
BEGIN
IF PTOOLWIN_Screen_Type = 'C' THEN
Move(PTOOLWIN_Stack[PTOOLWIN_Stack_Size]^, PTOOLWIN_C_Screen, 4000)
ELSE
Move(PTOOLWIN_Stack[PTOOLWIN_Stack_Size]^, PTOOLWIN_M_Screen, 4000);
Dispose(PTOOLWIN_Stack[PTOOLWIN_Stack_Size]);
PTOOLWIN_Stack_Size := PTOOLWIN_Stack_Size-1;
PTOOLWIN_Open_Window(PTOOLWIN_Stack_Num[PTOOLWIN_Stack_Size], 'R');
GoToXY(PTOOLWIN_Stack_X[PTOOLWIN_Stack_Size+1],
PTOOLWIN_Stack_Y[PTOOLWIN_Stack_Size+1]);
END;