home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1992 March / Source_Code_CD-ROM_Walnut_Creek_March_1992.iso / msdos / turbopas / tppop16.arc / WINDOWS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-28  |  7.0 KB  |  218 lines
  1. {$R-,S-,I+,D+,T+,F-,V-,B-,N-,L+ }
  2. Unit Windows;
  3.  
  4. Interface
  5.  
  6. Uses Crt;
  7.  
  8. Type
  9.   BorderType = (None,Single,Double,DoubleTop,DoubleSide,Solid);
  10.  
  11. Var
  12.   VideoMode      : Byte Absolute $0000:$0449;     { current video mode          }
  13.  
  14. Procedure DrawBox(X1,Y1,X2,Y2,Forground,Background : Word;
  15.                   Border : BorderType);
  16.  
  17. Procedure MakeWindow(X1,Y1,X2,Y2,Forground,BackGround : Word;
  18.                      Border : BorderType);
  19.  
  20. Procedure RemoveWindow;
  21.  
  22. Procedure SetCursor(Cursor : Word);
  23.  
  24.   InLine($59/              { pop  cx        }
  25.          $B4/$01/          { mov  ah,1      }
  26.          $CD/$10);         { int  10h       }
  27.  
  28. Implementation
  29.  
  30. Type
  31.   ScreenType = Array[1..2000] of Word;
  32.   ScreenPtr  = ^ScreenRecord;
  33.   ScreenRecord = Record
  34.                    Screen    : ScreenType;   { holds the screen memory   }
  35.                    UpperCors : Word;         { holds window coordinates  }
  36.                    LowerCors : Word;         { holds window coordinates  }
  37.                    OldAttr   : Word;         { holds character attribute }
  38.                    XY        : Word;         { holds the cursor position }
  39.                    Cursor    : Word;         { holds the cursor shape    }
  40.                    Previous  : ScreenPtr;    { pointer to underlying window }
  41.                  End;
  42.  
  43. Var
  44.   MonoScreen  : ScreenType Absolute $B000:0000; { monochome screen            }
  45.   ColorScreen : ScreenType Absolute $B800:0000; { CGA screen                  }
  46.   CurrentScreen  : ScreenPtr;                   { place to save screen info   }
  47.   ScreenSaved  : Boolean;                   { Are any windows on the heap? }
  48.  
  49. Procedure GotoXYAbs(XY : Word);
  50.  
  51.   InLine($5A/              { pop   dx       }
  52.          $B4/$02/          { mov   ah,2     }
  53.          $30/$FF/          { xor   bh,bh    }
  54.          $CD/$10);         { int   10h      }
  55.  
  56. Function WhereXYAbs : Word;
  57.  
  58.   InLine($B4/$03/          { mov  ah,3      }
  59.          $30/$FF/          { xor  bh,bh     }
  60.          $CD/$10/          { int  10h       }
  61.          $89/$D0);         { mov  ax,dx     }
  62.  
  63. Function CursorShape : Word;
  64.  
  65.   InLine($B4/$03/          { mov  ah,3      }
  66.          $30/$FF/          { xor  bh,bh     }
  67.          $89/$C8);         { mov  ax,cx     }
  68.  
  69. Procedure SaveScreen;
  70.  
  71. { saves the screen memory, window coordinates, }
  72. { cursor position, and character attribute.    }
  73.  
  74. Var
  75.   NewScreen : ScreenPtr;
  76.  
  77. Begin
  78.   New(NewScreen);
  79.   With NewScreen^ Do
  80.   Begin
  81.     If ScreenSaved
  82.       Then Previous := CurrentScreen
  83.     Else Previous := Nil;
  84.     ScreenSaved := True;
  85.     If VideoMode = 7               { save the screen memory }
  86.       Then Screen := MonoScreen
  87.     Else Screen := ColorScreen;
  88.     UpperCors := WindMin;   { save the window coordinates }
  89.     LowerCors := WindMax;
  90.     OldAttr := TextAttr;       { save the character attribute }
  91.     XY := WhereXYAbs;            { save the cursor position     }
  92.     Cursor := CursorShape;
  93.   End;
  94.   CurrentScreen := NewScreen;
  95. End;
  96.  
  97. Procedure DropWindow;
  98.  
  99. Var
  100.   OldScreen : ScreenPtr;
  101.  
  102. Begin
  103.   With CurrentScreen^ Do
  104.   Begin
  105.     If Previous = Nil Then ScreenSaved := False;
  106.     OldScreen := CurrentScreen;    { release heap memory             }
  107.     CurrentScreen := Previous;
  108.     Dispose(OldScreen);
  109.   End;
  110. End;
  111.  
  112. Procedure RemoveWindow;
  113.  
  114. { Restores screen memory, window coordinates, }
  115. { cursor position, and character attribute.   }
  116.  
  117. Begin
  118.   If Not ScreenSaved Then Exit;
  119.   With CurrentScreen^ Do
  120.   Begin
  121.     If VideoMode = 7                 { restore screen memory }
  122.       Then MonoScreen := Screen
  123.     Else ColorScreen := Screen;
  124.     WindMin := UpperCors;     { restore the window coordinates  }
  125.     WindMax := LowerCors;
  126.     TextAttr := OldAttr;         { restore the character attribute }
  127.     GotoXYAbs(XY);                 { restore the cursor position     }
  128.     SetCursor(Cursor);
  129.     DropWindow;
  130.   End;
  131. End;
  132.  
  133. Procedure DuplicateChar(Character : Char;Count : Integer);
  134.  
  135. { Uses the BIOS to write multiple copies of a character to the screen }
  136.  
  137. Begin
  138.   InLine($8A/$46/$06             {          mov       al,byte ptr char[bp]    }
  139.          /$8B/$4E/$04            {          mov       cx,count[bp]            }
  140.          /$B4/$09                {          mov       ah,09h                  }
  141.          /$8A/$1E/>TextAttr      {          mov       bl,[TextAttr]          }
  142.          /$32/$FF                {          xor       bh,bh                   }
  143.          /$CD/$10                {          int       10h                     }
  144.   );
  145. End;
  146.  
  147. Procedure DrawBox(X1,Y1,X2,Y2,Forground,Background : Word;Border : BorderType);
  148.  
  149. { Draws a double box around the window and reduces the window size. }
  150. { Inputs are the same as for MakeWindow.                            }
  151.  
  152. Type
  153.   BorderPart = (Top,Side,UpperLeft,UpperRight,LowerLeft,LowerRight);
  154.  
  155. Var
  156.   Loop : Integer;
  157.  
  158. Const
  159.   Borders : Array[Single..Solid,Top..LowerRight] of Char =
  160.                                           (('─','│','┌','┐','└','┘'), {single}
  161.                                            ('═','║','╔','╗','╚','╝'), {double}
  162.                                            ('═','│','╒','╕','╘','╛'), {combo }
  163.                                            ('─','║','╓','╖','╙','╜'), {combo }
  164.                                            (' ',' ',' ',' ',' ',' '));{solid }
  165.  
  166. { window type 0 has no border, type 5 uses the space character }
  167.  
  168. Begin
  169.   If VideoMode = 7 Then            { Make sure the attributes can be }
  170.   Begin                          { seen on a monochrome screen.    }
  171.     Forground := 7;
  172.     Background := 0;
  173.   End;
  174.   Window(X1,Y1,X2,Y2);
  175.   TextColor(Forground);
  176.   TextBackground(Background);
  177.   GotoXY(1,1);
  178.   If Border > None Then
  179.   Begin
  180.     Write(Borders[Border,UpperLeft]);            { upper left  }
  181.     DuplicateChar(Borders[Border,Top],Pred(X2-X1));    { top         }
  182.     GotoXY(Succ(X2-X1),1);
  183.     Write(Borders[Border,UpperRight]);           { upper right }
  184.     For Loop := 2 To Y2-Y1 Do
  185.     Begin
  186.       GotoXY(1,Loop);
  187.       Write(Borders[Border,Side]);               { left side   }
  188.       GotoXY(Succ(X2-X1),Loop);
  189.       Write(Borders[Border,Side]);               { right side  }
  190.     End;
  191.     Write(Borders[Border,LowerLeft]);            { lower left  }
  192.     DuplicateChar(Borders[Border,Top],Pred(X2-X1));    { bottom      }
  193.     GotoXY(Succ(X2-X1),Succ(Y2-Y1));
  194.     DuplicateChar(Borders[Border,LowerRight],1);           { lower right }
  195.     Window(Succ(X1),Succ(Y1),Pred(X2),Pred(Y2)); { reduce the window size }
  196.   End;
  197.   ClrScr;
  198. End;
  199.  
  200. Procedure MakeWindow(X1,Y1,X2,Y2,Forground,BackGround : Word;
  201.                      Border : BorderType);
  202.  
  203. { Saves the screen and draws a box. }
  204.  
  205. { Inputs are:  The four window coordinates,        }
  206. {              the forground color,                }
  207. {              the background color,               }
  208. {              and the border type (see DrawBox)   }
  209.  
  210. Begin
  211.   SaveScreen;
  212.   DrawBox(X1,Y1,X2,Y2,Forground,Background,Border);
  213. End;
  214.  
  215. Begin
  216.   ScreenSaved := False;
  217. End.
  218.