home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / turbopas / makewind.arc / MAKEWIND.INC
Encoding:
Text File  |  1987-06-05  |  18.1 KB  |  449 lines
  1. { Window Procedures Version 2.0, Copyright (c) 1987, SofTouch.
  2.  
  3.   Here are some easy-to-use procedures for creating pop-up windows:
  4.  
  5.   Make_Window : creates a pop-up window (saves what is "underneath" it).
  6.               : args: Left   : byte : [2..78] : left edge of the window
  7.                       Top    : byte : [2..23] : top edge of the window
  8.                       Right  : byte : [3..79] : right edge of the window
  9.                       Bottom : byte : [3..24] : bottom edge of the window
  10.                       (the 4 preceding are the coordinates of the WINDOW;
  11.                        it's frame lies outside the specified area.)
  12.                       Title  : string : [0..78] : title of the window
  13.                       Title_Posn : (Left, Center, Right) : where to put the
  14.                                    title (if there is a title) -- on the left
  15.                                    edge, centered, or against the right edge
  16.                       BrdrText : byte : color of frame text
  17.                       BrdrBack : byte : color of frame background
  18.                       WndwText : byte : text color in the window
  19.                       WndwBack : byte : text background color in the window
  20.   Initialize_Windows : sets up variables required for the window system.  This
  21.     procedure MUST be run before any calls to any of the window procedures can
  22.     be made.  It is a good idea to run this procedure at the beginning of your
  23.     program to insure against accidental calls to the window procedures.
  24.     Calling the procedures before initializing the window system can cause a
  25.     program to bomb.  Also, call INITIALIZE_WINDOWS only ONCE.  Calling it
  26.     more than once can trash the window system and can eat memory.  Note that
  27.     SAME_COLOR can be passed in for the colors if you don't want to change
  28.     them or their values are unavailable (SAME_COLOR can only be used if
  29.     COLOR has already been called).  Finally, INITIALIZE_WINDOWS assumes the
  30.     active window is the default (1,1,80,25).  If this is not the case,
  31.     either alter the values in the procedure or do a WINDOW(1,1,80,25) before
  32.     calling INITIALIZE_WINDOWS.
  33.                      : args: F : byte : [0..15] : starting foreground color
  34.                              B : byte : [0..15] : starting background color
  35.                                                   (if >7, characters blink)
  36.   Color : changes the current text foreground and background colors.  In order
  37.     for the window system to recognize color changes, use this procedure
  38.     whenever you want to change the color.  If you want, passing SAME_COLOR in
  39.     for either argument will leave that attribute alone. Example: if current
  40.     color is F := 14, B := 4 and the call Color(15, Same_Color) is made, the
  41.     new values are F := 15, B := 4. Color(Same_Color, Same_Color) does
  42.     nothing.
  43.         : args: F : byte : [0..15] : new foreground color
  44.                 B : byte : [0..15] : new background color (if >7, characters
  45.                                      blink)
  46.   Normal_Window : creates a window (identical to Turbo's WINDOW procedure) but
  47.     updates variables for the window system.  Does NOT frame the window, clear
  48.     it, or anything else.  All it does is create the window, like WINDOW does.
  49.                 : args: Left   : byte : [1..79] : left edge of the window
  50.                         Top    : byte : [1..24] : top edge of the window
  51.                         Right  : byte : [2..80] : right edge of the window
  52.                         Bottom : byte : [2..25] : bottom egde of the window
  53.   Remove_Window : removes a pop-up window (created with Make_Window) from the
  54.     screen and restores what was beneath it when it was created (or moved).
  55.     Does nothing if no windows have been created.
  56.                 : args: none
  57.   Move_Window : moves the current window to a new location on the screen
  58.               : args: New_Left : byte : [2..78] : new left edge of window
  59.                       New_Top  : byte : [2..23] : new top line of window
  60.                       (the 2 preceding are the coordinates of the WINDOW;
  61.                        it's frame lies outside the specified area.)
  62.   Remove_All_Windows : removes all windows that have been created by
  63.     MAKE_WINDOW.  Does nothing if no windows have been created.
  64.                      : args: none
  65.   Swap_Windows : swaps the active window with the window beneath it.  Does
  66.     nothing if less than two windows are active.
  67.                : args : none
  68.  
  69.   These routines are valid ONLY in 80 column mode.  40 Column will be UGLY and
  70.   might not work!
  71.  
  72.   You DO have to initialize the window system before using the procedures.
  73.   Otherwise the program will randomly bomb whenever the last window is
  74.   removed!  PLEASE run procedure INITIALIZE_WINDOWS before you do anything!
  75.  
  76.   You can't remove more windows than you create.
  77.  
  78.   You can move the windows around with great ease.
  79.  
  80.   The only limit to the number of windows you can open is how much RAM
  81.   your computer has (each window takes up minimal heap space).
  82.  
  83.   This code is UGLY!!  It was designed for pure speed.  This destroys elegant
  84.   programs.  I used arithmetic shifts instead of multiplies and divides.  I
  85.   index off of pointer variables (Buff^[1]...).  This sort of stuff isn't
  86.   pretty.  I recommend not fiddlin' with these procedures yourself unless you
  87.   are a Turbo Pascal expert.
  88.  
  89.   SofTouch takes no responsibility, either incidental or consequential, for
  90.   any damage that may result from the use or misuse of these routines.
  91.  
  92.   Versions are available from the below address that use different
  93.   framing techniques (like a single bar instead of a double bar), no
  94.   frame at all, support the MDA, etc.  If we don't have it written we'll
  95.   write it for you.  This offer is only valid if you are a registered
  96.   user (See below for info about registering).
  97.  
  98.   We worked a lot of hours developing these routines.  We even took the time
  99.   to document (wow!) what the procedures do so that it would be easier to
  100.   figure out how to use them.  We're distributing these procedures because
  101.   We've found ourselves disappointed with the other window management
  102.   procedures (even Borland's) available as shareware and we think others, like
  103.   you, might be disappointed, too.  Anyway, onto the shareware part:
  104.  
  105.   Feel free to use these routines in any program you write.  I won't try
  106.   to charge royalties.  But, if you like them and use them, please send
  107.   $15 to:
  108.  
  109.   Windows - Pascal
  110.   SofTouch
  111.   P.O. Box 2184
  112.   Indianapolis, IN  46206
  113.  
  114.   This will make you a registered user and will get you on our mailing list.
  115.  
  116.   If you have any questions, comments, criticisms, etc. about these
  117.   procedures, write to the above address.  Please include an SASE if you
  118.   expect a response.
  119.  
  120.   LOOK FOR: Menus.Inc    - 1-2-3 type horizontal menus and vertical menus.
  121.                            (requires MakeWind.Inc)
  122.             DateTime.Inc - Functions to get & set the machine's date & time
  123.  
  124.   COMING SOON: Similar routines in Turbo C and Turbo BASIC
  125.  
  126. **************************************************************************** }
  127.  
  128. Const Same_Color : Byte = 255;
  129.  
  130. Type Win_Title_Str       = String[78];
  131.      Win_Title_Posn_Type = (Left, Center, Right);
  132.      Win_Buff_Ptr        = ^Win_Buff;
  133.      Win_Buff            = Array[0..3999] Of Byte;
  134.      Win_Rec_Ptr         = ^Win_Rec;
  135.      Win_Rec             = Record
  136.                              Buff                  : Win_Buff_Ptr;
  137.                              Colour, WherX, WherY,
  138.                              Start_Row, Start_Col,
  139.                              End_Row,   Col_Len,
  140.                              Old_Left,  Old_Right,
  141.                              Old_Top,   Old_Bottom : Byte;
  142.                              Next                  : Win_Rec_Ptr;
  143.                            End; { Win_Rec Record }
  144.  
  145. Var Win_First      : Win_Rec_Ptr;
  146.     Win_Word_Array : Array[1..25,1.. 80] Of Integer Absolute $B800:0;
  147.     Win_Byte_Array : Array[1..25,1..160] Of Byte    Absolute $B800:0;
  148.     Win_Left, Win_Right, Win_Top, Win_Bottom, Win_Color : Byte;
  149.     Win_Count      : Integer;
  150.  
  151. { ************************************************************************** }
  152.  
  153. Procedure Color(Fore, Back : Byte);
  154. Begin
  155.   If (Back <> Same_Color) And (Fore <> Same_Color) Then Begin
  156.     Win_Color := Fore + Back shl 4;
  157.     TextColor(Fore);
  158.     TextBackground(Back);
  159.   End Else
  160.     If Fore <> Same_Color Then Begin
  161.       Win_Color := Win_Color and 240 + Fore;
  162.       TextColor(Fore);
  163.     End Else
  164.       If Back <> Same_Color Then Begin
  165.         Win_Color := Win_Color and 15 + Back shl 4;
  166.         TextBackground(Back);
  167.       End; { If Back <> Same_Color }
  168. End; { Procedure Color }
  169.  
  170. { ************************************************************************** }
  171.  
  172. Procedure Initialize_Windows(Fore, Back : Byte);
  173. Begin
  174.   Win_Left   := 1;
  175.   Win_Top    := 1;
  176.   Win_Right  := 80;
  177.   Win_Bottom := 25;
  178.   Win_Count  := 0;
  179.   Color(Fore, Back);
  180. End; { Procedure Initialize_Windows }
  181.  
  182. { ************************************************************************** }
  183.  
  184. Procedure Normal_Window(Left, Top, Right, Bottom : Byte);
  185. Begin
  186.   Win_Left   := Left;
  187.   Win_Top    := Top;
  188.   Win_Right  := Right;
  189.   Win_Bottom := Bottom;
  190.   Window(Left, Top, Right, Bottom);
  191. End; { Procedure Normal_Window }
  192.  
  193. { ************************************************************************** }
  194.  
  195. Procedure Make_Window(Lft, Top, Rite, Bottom : Byte; Title : Win_Title_Str;
  196.                       Title_Posn : Win_Title_Posn_Type;
  197.                       Frame_Fore, Frame_Back, Win_Fore, Win_Back : Byte);
  198. Var Cur_Win       : Win_Rec_Ptr;
  199.     Index, Size,
  200.     Char_n_Color,
  201.     Pred_Top,
  202.     Succ_Bottom,
  203.     BrdrClr, I    : Integer;
  204. Begin
  205.   New(Cur_Win);
  206.   Pred_Top := Pred(Top);
  207.   Succ_Bottom := Succ(Bottom);
  208.   With Cur_Win^ Do Begin
  209.     Next      := Win_First;
  210.     Colour    := Win_Color;
  211.     Start_Row := Pred_Top;
  212.     Start_Col := Pred(Lft);
  213.     End_Row   := Succ_Bottom;
  214.     Col_Len   := (Rite - Lft + 3) shl 1;
  215.     WherX     := WhereX;
  216.     WherY     := WhereY;
  217.     Old_Left  := Win_Left;
  218.     Old_Right := Win_Right;
  219.     Old_Top   := Win_Top;
  220.     Old_Bottom:= Win_Bottom;
  221.     Size := Col_Len * (Bottom - Top + 3);
  222.     GetMem(Buff, Size);
  223.     Index := 0;
  224.     BrdrClr := (Frame_Back shl 4 + Frame_Fore) shl 8;
  225.     Char_n_Color := BrdrClr + 186;
  226.     For I := Pred_Top To Succ_Bottom Do Begin
  227.       Move(Win_Word_Array[I, Pred(Lft)], Buff^[Index], Col_Len);
  228.       Index := Index + Col_Len;
  229.       Win_Word_Array[I, Pred(Lft)]  := Char_n_Color;
  230.       Win_Word_Array[I, Succ(Rite)] := Char_n_Color;
  231.     End; { For I }
  232.     Char_n_Color := BrdrClr + 205;
  233.     For I := Lft To Rite Do Begin
  234.       Win_Word_Array[Pred_Top,    I] := Char_n_Color;
  235.       Win_Word_Array[Succ_Bottom, I] := Char_n_Color;
  236.     End; { For I }
  237.     Win_Word_Array[Pred_Top,    Succ(Rite)] := BrdrClr + 187;
  238.     Win_Word_Array[Succ_Bottom, Succ(Rite)] := BrdrClr + 188;
  239.     Win_Word_Array[Succ_Bottom, Pred(Lft)]  := BrdrClr + 200;
  240.     Win_Word_Array[Pred_Top,    Pred(Lft)]  := BrdrClr + 201;
  241.     If Length(Title) > Col_Len shr 1 - 4 Then
  242.       Size := Col_Len shr 1 - 4
  243.     Else
  244.       Size := Length(Title);
  245.     If Size > 0 Then Begin
  246.       Case Title_Posn Of
  247.         Left   : Index := Pred(Lft shl 1);
  248.         Center : Index := (Lft + Col_Len shr 2 - Size shr 1) shl 1 - 5;
  249.         Right  : Index := Succ((Rite - Size - 2) shl 1);
  250.       End; { Case Title_Posn }
  251.       Win_Byte_Array[Pred_Top, Index] := 181;
  252.       For I := 1 To Size Do
  253.         Move(Title[I], Win_Byte_Array[Pred_Top, Index + (I shl 1)], 1);
  254.       Win_Byte_Array[Pred_Top, Index + Succ(I) shl 1] := 198;
  255.     End; { If Size > 0 }
  256.   End; { With Cur_Win^ }
  257.   Win_First := Cur_Win;
  258.   Win_Count := Succ(Win_Count);
  259.   Normal_Window(Lft, Top, Rite, Bottom);
  260.   Color(Win_Fore, Win_Back);
  261.   ClrScr;
  262. End; { Procedure Make_Window }
  263.  
  264. { ************************************************************************** }
  265.  
  266. Procedure Remove_Window;
  267. Var Cur_Win  : Win_Rec_Ptr;
  268.     Index, I : Integer;
  269. Begin
  270.   If Win_Count > 0 Then Begin
  271.     Win_Count := Pred(Win_Count);
  272.     Cur_Win   := Win_First;
  273.     Win_First := Win_First^.Next;
  274.     With Cur_Win^ Do Begin
  275.       Index := 0;
  276.       For I := Start_Row To End_Row Do Begin
  277.         Move(Buff^[Index], Win_Word_Array[I, Start_Col], Col_Len);
  278.         Index := Index + Col_Len;
  279.       End; { For I }
  280.       Normal_Window(Old_Left, Old_Top, Old_Right, Old_Bottom);
  281.       Color(Colour and 15, (Colour shr 4) and 15);
  282.       GoToXY(WherX, WherY);
  283.       FreeMem(Buff, Col_Len * Succ(End_Row - Start_Row));
  284.     End; { With Cur_Win^ }
  285.     Dispose(Cur_Win);
  286.   End; { If Win_Count > 0 }
  287. End; { Procedure Remove_Window }
  288.  
  289. { ************************************************************************** }
  290.  
  291. Procedure Remove_All_Windows;
  292. Begin
  293.   While Win_Count > 0 Do Remove_Window;
  294. End; { Procedure Remove_All_Windows }
  295.  
  296. { ************************************************************************** }
  297.  
  298. Procedure Move_Window(Left, Top : Byte);
  299. Var Tmp_Buff   : Win_Buff_Ptr;
  300.     Index, I,
  301.     X, Y, Size : Integer;
  302. Begin
  303.   If Win_Count > 0 Then
  304.     With Win_First^ Do Begin
  305.       Size := Col_Len * Succ(End_Row - Start_Row);
  306.       GetMem(Tmp_Buff, Size);
  307.       Index := 0;
  308.       For I := Start_Row To End_Row Do Begin
  309.         Move(Win_Word_Array[I, Start_Col], Tmp_Buff^[Index], Col_Len);
  310.         Move(Buff^[Index], Win_Word_Array[I, Start_Col], Col_Len);
  311.         Index := Index + Col_Len;
  312.       End; { For I }
  313.       Index := 0;
  314.       For I := Top To Top + End_Row - Start_Row Do Begin
  315.         Move(Win_Word_Array[I, Left], Buff^[Index], Col_Len);
  316.         Move(Tmp_Buff^[Index], Win_Word_Array[I, Left], Col_Len);
  317.         Index := Index + Col_Len;
  318.       End; { For I }
  319.       X := WhereX;
  320.       Y := WhereY;
  321.       Normal_Window(Succ(Left), Succ(Top), Left + Col_Len shr 1 - 2,
  322.                     Top + Pred(End_Row) - Start_Row);
  323.       GoToXY(X, Y);
  324.       End_Row   := Succ(Win_Bottom);
  325.       Start_Row := Top;
  326.       Start_Col := Left;
  327.       FreeMem(Tmp_Buff, Size);
  328.     End; { With Win_First^ }
  329. End; { Procedure Move_Window }
  330.  
  331. { ************************************************************************** }
  332.  
  333. Procedure Swap_Windows;
  334. Var Buff_1, Buff_2           : Win_Rec;
  335.     Index, I, Size_1, Size_2 : Integer;
  336. Begin
  337.   If Win_Count > 1 Then Begin
  338.     With Buff_1 Do Begin
  339.       Colour := Win_Color;
  340.       WherX := WhereX;
  341.       WherY := WhereY;
  342.       Size_1 := SizeOf(Win_First^.Buff^);
  343.       GetMem(Buff, Size_1);
  344.       Index := 0;
  345.       Start_Col := Win_First^.Start_Col;
  346.       Start_Row := Win_First^.Start_Row;
  347.       End_Row   := Win_First^.End_Row;
  348.       Col_Len   := Win_First^.Col_Len;
  349.       For I := Start_Row To End_Row Do Begin
  350.         Move(Win_Word_Array[I, Start_Col], Buff^[Index], Col_Len);
  351.         Index := Index + Col_Len;
  352.       End; { For }
  353.     End; { With }
  354.     Remove_Window;
  355.     With Buff_2 Do Begin
  356.       Colour := Win_Color;
  357.       WherX := WhereX;
  358.       WherY := WhereY;
  359.       Size_2 := SizeOf(Win_First^.Buff^);
  360.       GetMem(Buff, Size_2);
  361.       Index := 0;
  362.       Start_Col := Win_First^.Start_Col;
  363.       Start_Row := Win_First^.Start_Row;
  364.       End_Row   := Win_First^.End_Row;
  365.       Col_Len   := Win_First^.Col_Len;
  366.       For I := Start_Row To End_Row Do Begin
  367.         Move(Win_Word_Array[I, Start_Col], Buff^[Index], Col_Len);
  368.         Index := Index + Col_Len;
  369.       End; { For }
  370.     End; { With }
  371.     Remove_Window;
  372.     With Buff_1 Do Begin
  373.       Make_Window(Succ(Start_Col), Succ(Start_Row),
  374.                   Start_Col+(Col_Len shr 1)-2,Pred(End_Row),'',Left,Buff^[1] and 15,
  375.                   (Buff^[1] shr 4) and 15,Colour and 15,(Colour shr 4) and 15);
  376.       Index := 0;
  377.       For I := Start_Row To End_Row Do Begin
  378.         Move(Buff^[Index], Win_Word_Array[I, Start_Col], Col_Len);
  379.         Index := Index + Col_Len;
  380.       End; { For }
  381.       GoToXY(WherX, WherY);
  382.       FreeMem(Buff, Size_1);
  383.     End; { With }
  384.     With Buff_2 Do Begin
  385.       Make_Window(Succ(Start_Col), Succ(Start_Row),
  386.                   Start_Col+(Col_Len shr 1)-2,Pred(End_Row),'',Left,Buff^[1] and 15,
  387.                   (Buff^[1] shr 4) and 15,Colour and 15,(Colour shr 4) and 15);
  388.       Index := 0;
  389.       For I := Start_Row To End_Row Do Begin
  390.         Move(Buff^[Index], Win_Word_Array[I, Start_Col], Col_Len);
  391.         Index := Index + Col_Len;
  392.       End; { For }
  393.       GoToXY(WherX, WherY);
  394.       FreeMem(Buff, Size_2);
  395.     End; { With }
  396.   End; { If }
  397. End; { Procedure Swap_Windows }
  398.  
  399. { ************************************************************************** }
  400. { To run the test program, delete the line below this one }
  401. (*
  402. { To disable the test program, add a line above this one that contains a "("
  403.   immediately followed by a "*" }
  404. Procedure Press_A_Key;
  405. Var Ch : Char;
  406. Begin
  407.   WriteLn('Press a key..');
  408.   Read(Kbd,Ch);
  409. End; { Procedure Press_A_Key }
  410. Var I, X, Y : Integer;
  411.     C : Char;
  412. Begin { test program for MakeWind.Inc }
  413.   Initialize_Windows(9,0);
  414.   WriteLn('I''ll run a little demo.  First, I''ll create a bunch of windows.');
  415.   Press_A_Key;
  416.   For I := 1 To 255 Do Begin
  417.     X := Random(40) + 2;
  418.     Y := Random(12) + 2;
  419.     Make_Window(X,Y,X + Random(35) + 2, Y + Random(10) + 2, 'Window: '+Chr(I),
  420.                 Left, Succ(Random(15)), Succ(Random(7)), Succ(Random(15)),
  421.                 Succ(Random(7)));
  422.   End; { For }
  423.   Write('Press a key to remove the windows...');
  424.   Read(Kbd, C);
  425.   Remove_All_Windows;
  426.   Make_Window(2,2,20,6,'Window 1',Center,14,4,15,0);
  427.   WriteLn('Create a window.');
  428.   Press_A_Key;
  429.   WriteLn('Slide it around.');
  430.   For I := 2 To 40 Do Move_Window(I,2);
  431.   For I := 2 To 12 Do Move_Window(40,I);
  432.   Press_A_Key;
  433.   WriteLn('Or just move it.');
  434.   Move_Window(2,2);
  435.   Press_A_Key;
  436.   Make_Window(4,4,39,8,'Window 2',Right,9,0,14,1);
  437.   WriteLn('Create a second window, overlapping the first.');
  438.   Press_A_Key;
  439.   Swap_Windows;
  440.   WriteLn('And pull the first one on top of it.');
  441.   Press_A_Key;
  442.   Remove_Window;
  443.   WriteLn('Kill window 1');
  444.   Press_A_Key;
  445.   Remove_Window;
  446.   WriteLn('And then remove window 2.');
  447. End. { test program for MakeWind.Inc } (**)
  448. { End of Included File MakeWind.Inc **************************************** }
  449.