home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PASWIN.ZIP / PTOOLWI3.INC < prev    next >
Encoding:
Text File  |  1986-11-03  |  12.6 KB  |  305 lines
  1.  { PTOOLWI2.INC   Copyright 1984  R D Ostrander                   Version 3.0
  2.                                  Ostrander Data Services              of
  3.                                  5437 Honey Manor Dr              PTOOLWIN.INC
  4.                                  Indianapolis  IN  46241
  5.  
  6.  These Turbo Pascal procedures are text window manipulation tools used to ease
  7.  the manipulation of Windows in an IBM PC environment. They are used to open
  8.  and close windows while saving the data covered by the window. Borders around
  9.  windows are also supported.
  10.  
  11.  This program has been placed in the Public Domain by the author and copies
  12.  may be freely made for non-commercial, demonstration, or evaluation purposes.
  13.  Use of these subroutines in a program for sale or for commercial purposes in
  14.  a place of business requires a $20 fee be paid to the author at the address
  15.  above.  Personal non-commercial users may also elect to pay the $20 fee to
  16.  encourage further development of this and similar programs. With payment you
  17.  will be able to receive update notices, diskettes and printed documentation
  18.  of this and other PTOOLs from Ostrander Data Services.
  19.  
  20.  PTOOL, and PTOOLxxx are Copyright Trademarks of Ostrander Data Services
  21.  
  22.  Turbo Pascal is a Copyright of Borland International Inc.
  23.  
  24.  Version 2.0 adds support for stack operations for holding screen image data.
  25.  
  26.  Version 3.0 automatically determines whether to use C/G or Monochrome
  27.  monitor card if the PTOOLWIN_Screen_Type variable is left as an 'X'.
  28.  This was written by Lew Paper using routines developed by Bela Lubkin.
  29.  
  30.  
  31. Procedures and Functions available in PTOOLWI2.INC are:
  32.  
  33.  PTWSet  (Screen#, X1, Y1, X2, Y2,  - Sets up window coordinates so that later
  34.          BorderSwitch,                references can be made by Mnemonic only.
  35.          BackgroundColor,             PTWSet must be done once for each window
  36.          ForegroundColor)             before it is Opened.
  37.                                       The Screen# is a number between 1 and
  38.                                       the maximum number of windows allowable
  39.                                       set in the Constants Block below.
  40.                                       The X and Y Coordinates are the same as
  41.                                       for the Turbo Pascal Window procedure.
  42.                                       A border may be placed around the window
  43.                                       and the size of the window will be
  44.                                       decreased to fit inside the border. The
  45.                                       BorderSwitch functions are:
  46.                                          0 - No border
  47.                                          1 - Single line block graphics border
  48.                                          2 - Double line block graphics border
  49.                                         -1 - Single line Reversed color border
  50.                                         -2 - Double line Reversed color border
  51.                                       The BackgroundColor and ForegroundColor
  52.                                       parameters are the same as for the Turbo
  53.                                       Pascal TextColor and TextBackground
  54.                                       procedures.
  55.  
  56.  PTWOpen (Screen#)                  - Activates a window (previously set by
  57.                                       PTWSet) and saves the screen covered by
  58.                                       the window.
  59.                                       In the Constants Block following, there
  60.                                       is a parameter that sets the maximum
  61.                                       number of windows that may be open at
  62.                                       any one time.
  63.  
  64.  PTWClose                           - De-activates the open window, activates
  65.                                       the previous window and restores the
  66.                                       screen covered by the closed window.
  67.                                       Note that the PTWOpen & PTWClose have a
  68.                                       "Push/Pop" type of action.
  69.                                                                             }
  70.  
  71.  
  72. { Constant Values (Parameters) That must be included in your source program }
  73.  
  74. (*
  75. CONST
  76.  
  77.    PTOOLWIN_Number_of_Windows = nn;    { This determines the number of      }
  78.                                        { windows that may be set with the   }
  79.                                        { PTWSet procedure.                  }
  80.                                        { This also determines the maximum   }
  81.                                        { number of windows that may be open }
  82.                                        { at any one time.                   }
  83.                                        { Use the greater of the two.        }
  84.  
  85.                                                                            *)
  86.  
  87. { Areas for internal use Begin Here **************************************** }
  88.  
  89. TYPE
  90.  
  91.      PTOOLWIN_Set_Info  = Record
  92.                             PTOOLWIN_X1       : Integer;
  93.                             PTOOLWIN_Y1       : Integer;
  94.                             PTOOLWIN_X2       : Integer;
  95.                             PTOOLWIN_Y2       : Integer;
  96.                             PTOOLWIN_Border   : Integer;
  97.                             PTOOLWIN_Back     : Integer;
  98.                             PTOOLWIN_Fore     : Integer;
  99.                           End;
  100.  
  101.      PTOOLWIN_Stacks    = Array [1..25] of String [160];
  102.  
  103.  
  104. CONST
  105.      PTOOLWIN_Screen_Type : Char = 'X'; {Initial value neither 'M' or 'C', LP}
  106.  
  107.  
  108. VAR
  109.  
  110.      PTOOLWIN_C_Screen   : Char absolute $B800:$0000;
  111.      PTOOLWIN_M_Screen   : Char absolute $B000:$0000;
  112.  
  113.      PTOOLWIN_Set        : Array [1..PTOOLWIN_Number_of_Windows]
  114.                                   of PTOOLWIN_Set_Info;
  115.  
  116.      PTOOLWIN_Stack_Num  : Array [1..PTOOLWIN_Number_of_Windows] of Integer;
  117.      PTOOLWIN_Stack_X    : Array [1..PTOOLWIN_Number_of_Windows] of Integer;
  118.      PTOOLWIN_Stack_Y    : Array [1..PTOOLWIN_Number_of_Windows] of Integer;
  119.      PTOOLWIN_Stack      : Array [1..PTOOLWIN_Number_of_Windows]
  120.                                   of ^PTOOLWIN_Stacks;
  121.  
  122.      PTOOLWIN_Curr       : PTOOLWIN_Set_Info;
  123.  
  124.  
  125. CONST
  126.  
  127.      PTOOLWIN_Stack_Size : Byte = 0;
  128.  
  129.      PTOOLWIN_Full_Screen : PTOOLWIN_Set_Info = (PTOOLWIN_X1     : 1;
  130.                                                  PTOOLWIN_Y1     : 1;
  131.                                                  PTOOLWIN_X2     : 80;
  132.                                                  PTOOLWIN_Y2     : 25;
  133.                                                  PTOOLWIN_Border : 0;
  134.                                                  PTOOLWIN_Back   : 0;
  135.                                                  PTOOLWIN_Fore   : 15);
  136.  
  137. { Internal Procedures Begin Here ****************************************** }
  138.  
  139.  
  140. { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  141.  
  142.  Adapted from WINDOW.PAS
  143.               by Bela Lubkin
  144.               Borland International Technical Support
  145.  
  146.  Lew Paper, 5/12/85                                                        }
  147.  
  148. Procedure DetermineDisplay;
  149. { Set ScreenBase to $B000 or $B800, depending on which display is in use.
  150.   A side effect is that the cursor is left at (1,1) on the screen. }
  151.  
  152.   Var
  153.     M,C: Integer;
  154.     T: Byte;
  155.  
  156.   Begin
  157.     M:=MemW[$B000:0]; {Mono 1,1}
  158.     C:=MemW[$B800:0]; {Color 1,1}
  159.     {Set T to a value which is different than either Hi(M) or Hi(C).
  160.      The three values of T, 64, 65 and 66 are arbitrary.}
  161.     T:=64;
  162.     If (Hi(M)=T) Or (Hi(C)=T) Then T:=65; {If not, neither is 64}
  163.     If (Hi(M)=T) Or (Hi(C)=T) Then T:=66; {If not, one is 64, the other is not
  164.                                            65.  If so, one is 64, the other is
  165.                                            65, so neither is 66}
  166.     GotoXY(1,1); {To $B000 if mono, $B800 if color}
  167.     Write(Chr(T));
  168.     GotoXY(1,1);
  169.     If Mem[$B000:0]=T Then PTOOLWIN_Screen_Type := 'M' {LP modification}
  170.     Else PTOOLWIN_Screen_Type := 'C'; {LP modification}
  171.     MemW[$B000:0]:=M;
  172.     MemW[$B800:0]:=C;
  173.   End;
  174.  
  175. { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  176.  
  177. Procedure PTOOLWIN_Open_Window (Screen : Integer; OpenType : Char);
  178.  
  179. Var
  180.    I  : Byte;
  181.  
  182. Begin
  183.      If (Screen = 0) or
  184.         (PTOOLWIN_Stack_Size = 0) then PTOOLWIN_Curr := PTOOLWIN_Full_Screen
  185.                                   else PTOOLWIN_Curr := PTOOLWIN_Set [Screen];
  186.      With PTOOLWIN_Curr do
  187.      Begin
  188.           Window (PTOOLWIN_X1, PTOOLWIN_Y1,
  189.                   PTOOLWIN_X2, PTOOLWIN_Y2);
  190.           If PTOOLWIN_Border >= 0 then
  191.             Begin
  192.                   TextBackground (PTOOLWIN_Back);
  193.                   TextColor      (PTOOLWIN_Fore);
  194.             End
  195.           else
  196.             Begin
  197.                  TextBackground (PTOOLWIN_Fore);
  198.                  TextColor      (PTOOLWIN_Back);
  199.             End;
  200.          If (Abs (PTOOLWIN_Border) = 1) and
  201.             (OpenType = 'N') then
  202.             Begin
  203.                  Gotoxy (1,1); Write ('┌');
  204.                  For I := 2 to PTOOLWIN_X2 - PTOOLWIN_X1 do
  205.                      Write ('─');
  206.                  Write ('┐');
  207.                  For I := 2 to PTOOLWIN_Y2 - PTOOLWIN_Y1 do
  208.                      Begin
  209.                           Gotoxy (1, I);
  210.                           Write ('│');
  211.                           Gotoxy (PTOOLWIN_X2 - PTOOLWIN_X1 + 1, I);
  212.                           Write ('│');
  213.                      End;
  214.                  Gotoxy (1, PTOOLWIN_Y2 - PTOOLWIN_Y1 + 1); Write ('└');
  215.                  For I := 2 to PTOOLWIN_X2 - PTOOLWIN_X1 do
  216.                      Write ('─');
  217.             End;
  218.          If (Abs (PTOOLWIN_Border) = 2) and
  219.             (OpenType = 'N') then
  220.             Begin
  221.                  Gotoxy (1,1); Write ('╔');
  222.                  For I := 2 to PTOOLWIN_X2 - PTOOLWIN_X1 do
  223.                      Write ('═');
  224.                  Write ('╗');
  225.                  For I := 2 to PTOOLWIN_Y2 - PTOOLWIN_Y1 do
  226.                      Begin
  227.                           Gotoxy (1, I);
  228.                           Write ('║');
  229.                           Gotoxy (PTOOLWIN_X2 - PTOOLWIN_X1 + 1, I);
  230.                           Write ('║');
  231.                      End;
  232.                  Gotoxy (1, PTOOLWIN_Y2 - PTOOLWIN_Y1 + 1); Write ('╚');
  233.                  For I := 2 to PTOOLWIN_X2 - PTOOLWIN_X1 do
  234.                      Write ('═');
  235.             End;
  236.          If PTOOLWIN_Border <> 0 then
  237.             Begin
  238.                  Window (PTOOLWIN_X1 + 1, PTOOLWIN_Y1 + 1,
  239.                          PTOOLWIN_X2 - 1, PTOOLWIN_Y2 - 1);
  240.                  If OpenType = 'N' then
  241.                     If Abs (PTOOLWIN_Border) = 1 then Write ('┘')
  242.                                                  else Write ('╝');
  243.             End;
  244.          TextBackground (PTOOLWIN_Back);
  245.          TextColor      (PTOOLWIN_Fore);
  246.      End;
  247. End;
  248.  
  249.  
  250. { Called Procedures Begin Here ******************************************** }
  251.  
  252.  
  253. PROCEDURE PTWSet (Window, X1, Y1, X2, Y2, Border, Back, Fore  : Integer);
  254.  
  255. BEGIN
  256.  
  257.      IF PTOOLWIN_Screen_Type = 'X' THEN DetermineDisplay; {LP modification}
  258.  
  259.      With PTOOLWIN_Curr do
  260.      Begin
  261.           PTOOLWIN_X1     := X1;
  262.           PTOOLWIN_Y1     := Y1;
  263.           PTOOLWIN_X2     := X2;
  264.           PTOOLWIN_Y2     := Y2;
  265.           PTOOLWIN_Border := Border;
  266.           PTOOLWIN_Back   := Back;
  267.           PTOOLWIN_Fore   := Fore;
  268.      End;
  269.      PTOOLWIN_Set [Window] := PTOOLWIN_Curr;
  270.  
  271. END;
  272.  
  273.  
  274. PROCEDURE PTWOpen (Screen : Integer);
  275.  
  276. BEGIN
  277.  
  278.      PTOOLWIN_Stack_Size := PTOOLWIN_Stack_Size + 1;
  279.      PTOOLWIN_Stack_Num [PTOOLWIN_Stack_Size] := Screen;
  280.      PTOOLWIN_Stack_X   [PTOOLWIN_Stack_Size] := WhereX;
  281.      PTOOLWIN_Stack_Y   [PTOOLWIN_Stack_Size] := WhereY;
  282.      New (PTOOLWIN_Stack [PTOOLWIN_Stack_Size]);
  283.      If PTOOLWIN_Screen_Type = 'C' then
  284.         Move (PTOOLWIN_C_Screen, PTOOLWIN_Stack [PTOOLWIN_Stack_Size]^, 4000)
  285.      else
  286.         Move (PTOOLWIN_M_Screen, PTOOLWIN_Stack [PTOOLWIN_Stack_Size]^, 4000);
  287.      PTOOLWIN_Open_Window (Screen, 'N');
  288.  
  289. END;
  290.  
  291.  
  292. PROCEDURE PTWClose;
  293.  
  294. BEGIN
  295.      If PTOOLWIN_Screen_Type = 'C' then
  296.         Move (PTOOLWIN_Stack [PTOOLWIN_Stack_Size]^, PTOOLWIN_C_Screen, 4000)
  297.      else
  298.         Move (PTOOLWIN_Stack [PTOOLWIN_Stack_Size]^, PTOOLWIN_M_Screen, 4000);
  299.      Dispose (PTOOLWIN_Stack [PTOOLWIN_Stack_Size]);
  300.      PTOOLWIN_Stack_Size := PTOOLWIN_Stack_Size - 1;
  301.      PTOOLWIN_Open_Window (PTOOLWIN_Stack_Num [PTOOLWIN_Stack_Size], 'R');
  302.      Gotoxy (PTOOLWIN_Stack_X [PTOOLWIN_Stack_Size + 1],
  303.              PTOOLWIN_Stack_Y [PTOOLWIN_Stack_Size + 1]);
  304.  
  305. END;