home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / textwndw.swg / 0004_WINDOWS1.PAS.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  4.8 KB  |  187 lines
  1. {
  2. >   Okay...it works fine, but I want to somehow be able to kindo of remove t
  3. > Window.  I'm not sure if there is any way of doing this?
  4.  
  5. You need to save the screen data at the location you wish to make
  6. a Window, then after you're done With the Window simply restore
  7. the screen data back to what it was.  Here's some example
  8. routines of what you can do, you must call InitWindows once at
  9. the begining of the Program before using the OpenWindow
  10. Procedure, then CloseWindow to restore the screen.
  11. }
  12.  
  13. Uses
  14.   Crt;
  15.  
  16. Type
  17.   ShadeType = (Shading, NoShading);
  18.   ScreenBlock = Array [1..2000] of Integer;
  19.   ScreenLine  = Array [1..80] of Word;
  20.   ScreenArray = Array [1..25] of ScreenLine;
  21.   WindowLink  = ^WindowControlBlock;
  22.   WindowControlBlock = Record
  23.     X,Y      : Byte;          { start position }
  24.     Hight    : Byte;          { Menu Hight     }
  25.     Width    : Byte;          { Menu width     }
  26.     ID       : Byte;          { Menu number    }
  27.     BackLink : WindowLink;    { previous block }
  28.     MenuItem : Byte;          { select item    }
  29.     ScreenData : ScreenBlock; { saved screen data }
  30.   end;
  31.   String30 = String[30];
  32.   ScreenPtr = ^ScreenRec;
  33.   ScreenRec = Array [1..25,1..80] of Integer;
  34.  
  35.  
  36. Var
  37.   Screen       : ScreenPtr;
  38.   ActiveWindow : Pointer;
  39.  
  40. Procedure InitWindows;
  41. begin
  42.   If LastMode = Mono Then
  43.     Screen := Ptr($B000,0)
  44.   Else
  45.     Screen := Ptr($B800,0);
  46.   ActiveWindow := Nil;
  47. end;
  48.  
  49. Procedure OpenWindow(X, Y, Lines, Columns, FrameColor,
  50.                      ForeGround, BackGround : Byte;
  51.                      Title : String30; Shade : ShadeType);
  52. Var
  53.   A, X1, X2,
  54.   Y1, Y2        : Integer;
  55.   OldAttr       : Integer;
  56.   WindowSize    : Integer;
  57.   Block         : WindowLink;
  58. begin
  59.   OldAttr := TextAttr;
  60.  
  61.   WindowSize := (Lines + 3) * (Columns + 5) * 2 +
  62.                  Sizeof(WindowControlBlock) - Sizeof(ScreenBlock);
  63.  
  64.   If MemAvail < WindowSize Then
  65.   begin
  66.     WriteLn;WriteLn('Program out of memory');
  67.     Halt;
  68.   end;
  69.  
  70.   GetMem(Block,WindowSize);
  71.   Block^.X := X - 2;
  72.   Block^.Y := Y - 1;
  73.   Block^.Hight := Lines + 3;
  74.   Block^.Width := Columns + 5;
  75.   Block^.BackLink := ActiveWindow;
  76.  
  77.   ActiveWindow := Block;
  78.   A := 1;
  79.   For Y1 := Block^.Y to Block^.Y+Block^.Hight-1 Do
  80.   begin
  81.     Move(Screen^[Y1, Block^.X], Block^.ScreenData[A], Block^.Width * 2);
  82.     A := A + Block^.Width;
  83.   end;
  84.  
  85.   TextColor(FrameColor);
  86.   If BackGround = Black Then
  87.     TextBackGround(LightGray)    { This will keep exploding Window visable }
  88.   Else
  89.     TextBackground(BackGround);
  90.  
  91.   X1 := X + Columns Div 2;
  92.   X2 := X1 + 1;
  93.   Y1 := Y + Lines Div 2;
  94.   Y2 := Y1 + 1;
  95.  
  96.   Repeat
  97.     Window(X1, Y1, X2, Y2);
  98.     ClrScr;
  99.     If Columns < 20 Then
  100.       Delay(20);
  101.     If X1 > X Then
  102.       Dec(X1);
  103.     If X2 < X + Columns Then
  104.       Inc(X2);
  105.     If Y1 > Y Then
  106.       Dec(Y1);
  107.     If Y2 < Y + Lines Then
  108.       Inc(Y2);
  109.   Until (X2 - X1 >= Columns ) And (Y2 - Y1 >= Lines);
  110.  
  111.   Window(X - 1, Y, X + Columns, Y + Lines);
  112.   TextBackground(BackGround);
  113.   ClrScr;
  114.   TextColor(FrameColor);
  115.   Window(1, 1, 80, 24);
  116.   GotoXY(X - 2, Y - 1);
  117.   Write('┌');
  118.   For A := 1 to Columns + 2 Do
  119.     Write('─');
  120.  
  121.   Write('┐');
  122.   For A := 1 to Lines Do
  123.   begin
  124.     GotoXY(X - 2, Y + A - 1);
  125.     Write('│');
  126.     GotoXY(X + Columns + 1, Y + A - 1);
  127.     Write('│');
  128.   end;
  129.   GotoXY(X - 2, Y + Lines);
  130.   Write('└');
  131.   For A := 1 to Columns + 2 Do
  132.     Write('─');
  133.   Write('┘');
  134.   If Shade = Shading Then
  135.   begin
  136.     For A := Y to Y + Lines + 1 Do
  137.       Screen^[A, X + Columns + 2] := Screen^[A, X + Columns + 2] And $07FF;
  138.     For A := X - 1 to X + Columns + 1 Do
  139.       Screen^[Y + Lines + 1, A] := Screen^[Y + Lines + 1, A] And $07FF;
  140.   end;
  141.   If Title <> '' Then
  142.   begin
  143.     TextColor(FrameColor);
  144.     GotoXY(X + ((Columns - Length(Title)) div 2) - 1, Y - 1);
  145.     Write(' ', Title, ' ');
  146.   end;
  147.   Window(1, 1, 80, 24);
  148. end;
  149.  
  150. Procedure CloseWindow;
  151. Var
  152.   Block   : WindowLink;
  153.   A       : Integer;
  154.   Y1      : Integer;
  155.   WindowSize : Integer;
  156. begin
  157.   If ActiveWindow = Nil Then
  158.     Exit;
  159.   Block := ActiveWindow;
  160.   WindowSize := (Block^.Hight) * (Block^.Width) * 2 +
  161.                  Sizeof(WindowControlBlock) - Sizeof(ScreenBlock);
  162.   A := 1;
  163.   For Y1 := Block^.Y to Block^.Y+Block^.Hight - 1 Do
  164.     begin
  165.     Move(Block^.ScreenData[A], Screen^[Y1, Block^.X], Block^.Width * 2);
  166.     A := A + Block^.Width;
  167.     end;
  168.   ActiveWindow := Block^.BackLink;
  169.   FreeMem(Block, WindowSize);
  170. end;
  171.  
  172. begin
  173.   InitWindows;
  174.   OpenWindow(10, 5, 10, 50, LightGreen, LightBlue, Magenta,
  175.                      'Test Window', Shading);
  176.   ReadKey;
  177.   OpenWindow(20, 6, 6, 30, Green, Yellow, Blue,
  178.                      'Test Window 2', Shading);
  179.   ReadKey;
  180.   CloseWindow;
  181.   ReadKey;
  182.   CloseWindow;
  183.   ReadKey;
  184.   GotoXY(1,24);
  185.  
  186. end.
  187.