home *** CD-ROM | disk | FTP | other *** search
- { PTOOLWIN.INC Copyright 1984 R D Ostrander Version 1.0
- Ostrander Data Services
- 5437 Honey Manor Dr
- Indianapolis IN 46241
-
- These Turbo Pascal procedures are text window manipulation tools used to ease
- the manipulation of Windows in an IBM PC environment. They are used to open
- and close windows while saving the data covered by the window. Borders around
- windows are also supported.
-
- This program has been placed in the Public Domain by the author and copies
- may be freely made for non-commercial, demonstration, or evaluation purposes.
- Use of these subroutines in a program for sale or for commercial purposes in
- a place of business requires a $20 fee be paid to the author at the address
- above. Personal non-commercial users may also elect to pay the $20 fee to
- encourage further development of this and similar programs. With payment you
- will be able to receive update notices, diskettes and printed documentation
- of this and other PTOOLs from Ostrander Data Services.
-
-
- PTOOL, and PTOOLxxx are Copyright Trademarks of Ostrander Data Services
-
- Turbo Pascal is a Copyright of Borland International Inc.
-
- Procedures and Functions available in PTOOLWIN.INC are:
-
-
- PTWSet (Screen#, X1, Y1, X2, Y2, - Sets up window coordinates so that later
- BorderSwitch, references can be made by Mnemonic only.
- BackgroundColor, PTWSet must be done once for each window
- ForegroundColor) 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 your source program }
-
- (*
- CONST
-
- PTOOLWIN_Number_of_Windows = 10; { This determines the number of }
- { windows that may be set with the }
- { PTWSet procedure. }
-
- PTOOLWIN_Max_Number_Open = 10; { This determines the number of }
- { windows that may be open at any }
- { one time. 4K bytes are reserved }
- { each window. }
-
- PTOOLWIN_Screen_Type : Char = 'C'; { This must be a 'C' if the program }
- { is to be run on a system with a }
- { Color/Graphics card and must be a }
- { 'M' if the program is to be run on }
- { a system with a Monochrome card or }
- { on an IBM-3270-PC. }
- *)
-
- { 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];
-
-
- 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_Max_Number_Open] of Integer;
- PTOOLWIN_Stack_X : Array [1..PTOOLWIN_Max_Number_Open] of Integer;
- PTOOLWIN_Stack_Y : Array [1..PTOOLWIN_Max_Number_Open] of Integer;
- PTOOLWIN_Stack : Array [1..PTOOLWIN_Max_Number_Open]
- 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 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
-
- 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;
- 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);
- 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;