home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / WIH.ZIP / NEWSCRN.INC < prev    next >
Encoding:
Text File  |  1987-02-01  |  4.5 KB  |  116 lines
  1. Const
  2.    Bell                   = #07;
  3.    Color_Screen_Address   = $B800;
  4.    Mono_Screen_Address    = $B000;
  5.    Screen_Length          = 4000;
  6. Type
  7.    String40   = String[40];
  8.    Screen_Type       = Array[ 1 .. Screen_Length ] Of Byte;
  9.    Screen_Ptr        = ^Screen_Image_Type;
  10.    Screen_Image_Type = Record
  11.                           Screen_Image: Screen_Type;
  12.                        End;
  13.    Saved_Screen_Ptr  = ^Saved_Screen_Type;
  14.    Saved_Screen_Type = Record
  15.                           Screen_Image  : Screen_Type;
  16.                           Screen_Row    : Integer;
  17.                           Screen_Column : Integer;
  18.                           Screen_X1     : Integer;
  19.                           Screen_Y1     : Integer;
  20.                           Screen_X2     : Integer;
  21.                           Screen_Y2     : Integer;
  22.                        End;
  23. Var
  24.    Actual_Screen        : Screen_Ptr;
  25.    Saved_Screen         : Saved_Screen_Ptr;
  26.    UpperLeft_Column, UpperLeft_Row, LowerRight_Column,
  27.    LowerRight_Row       : Integer;
  28. (*----------------------------------------------------------------------*)
  29. Procedure Get_Screen_Address;
  30. Var
  31.    Regs : Record       (* 8088 registers *)
  32.              Ax, Bx, Cx, Dx, Bp, Si, Di, Ds, Es, Flags : Integer
  33.           End;
  34. Begin  (* Get_Screen_Address *)
  35.    Regs.Ax := 15 SHL 8;
  36.    INTR( $10 , Regs );
  37.    If ( Regs.Ax AND $FF ) <> 7 Then
  38.       Actual_Screen := PTR( Color_Screen_Address , 0 )
  39.    Else
  40.       Actual_Screen := PTR( Mono_Screen_Address , 0 );
  41.    UpperLeft_Column  := 1;
  42.    UpperLeft_Row     := 1;
  43.    LowerRight_Column := 80;
  44.    LowerRight_Row    := 25;
  45. End    (* Get_Screen_Address *);
  46. (*----------------------------------------------------------------------*)
  47. Procedure Save_Screen( Var Saved_Screen_Pointer : Saved_Screen_Ptr );
  48. Begin  (* Save_Screen *)
  49.    New( Saved_Screen_Pointer );
  50.    With Saved_Screen_Pointer^ Do
  51.       Begin
  52.          Screen_X1     := UpperLeft_Column;
  53.          Screen_Y1     := UpperLeft_Row;
  54.          Screen_X2     := LowerRight_Column;
  55.          Screen_Y2     := LowerRight_Row;
  56.          Screen_Row    := WhereY;
  57.          Screen_Column := WhereX;
  58.          Move( Actual_Screen^.Screen_Image, Screen_Image, Screen_Length );
  59.       End;
  60. End   (* Save_Screen *);
  61. (*----------------------------------------------------------------------*)
  62. Procedure Restore_Screen( Var Saved_Screen_Pointer : Saved_Screen_Ptr );
  63. Begin  (* Restore_Screen *)
  64.    With Saved_Screen_Pointer^ Do
  65.       Begin
  66.          Window( Screen_X1, Screen_Y1, Screen_X2, Screen_Y2 );
  67.          Move( Screen_Image, Actual_Screen^.Screen_Image, Screen_Length );
  68.          GoToXY( Screen_Column, Screen_Row );
  69.       End;
  70.    Dispose( Saved_Screen_Pointer );
  71. End    (* Restore_Screen *);
  72. (*----------------------------------------------------------------------*)
  73. Procedure Draw_Menu_Frame( UpperLeftX,  UpperLeftY,
  74.                            LowerRightX, LowerRightY : Integer;
  75.                            Frame_Color, Text_Color  : Integer;
  76.                            Menu_Title:  String40 );
  77. Var
  78.    I,L,LT        : Integer;
  79.    Title_Offset  : Integer;
  80. Begin (* Draw_Menu_Frame *)
  81.    If UpperLeftX  < 2  then UpperLeftX  := 2;
  82.    If UpperLeftY  < 2  then UpperLeftY  := 2;
  83.    If LowerRightX > 79 then LowerRightX := 79;
  84.    If LowerRightY > 24 then LowerRightY := 24;
  85.    Window( UpperLeftX-1, UpperLeftY-1, LowerRightX+1, LowerRightY+1 );
  86.    Clrscr; Window(1,1,80,25);
  87.    GoToXY( UpperLeftX, UpperLeftY );
  88.    L  := LowerRightX - UpperLeftX;
  89.    LT := LENGTH( Menu_Title );
  90.    If LT > ( L - 5 ) Then Menu_Title[0] := CHR( L - 5 );
  91.    TextColor( Frame_Color );
  92.       Write('╒');
  93.    For I := ( UpperLeftX + 1 ) To ( LowerRightX - 1 ) Do Write('═');
  94.    Write('╕');
  95.    If LT > 0 Then      Begin
  96.          Title_Offset := ((LowerRightX-UpperLeftX-LT-4) div 2) + 1;
  97.          GoToXY( UpperLeftX+Title_Offset, UpperLeftY);
  98.          Write('[ ',Menu_Title,' ]'); End;
  99.    For I := UpperLeftY+1 To LowerRightY-1 Do
  100.       Begin
  101.          GoToXY( UpperLeftX  , I );  Write( '│' );
  102.          GoToXY( LowerRightX , I );  Write( '│' );
  103.       End;
  104.    GoToXY( UpperLeftX, LowerRightY );
  105.    Write( '╘' );
  106.    For I := UpperLeftX+1 To LowerRightX-1 Do Write( '═' );
  107.    Write( '╛' );
  108.    Window( UpperLeftX+1, UpperLeftY+1, LowerRightX-1, LowerRightY-1 );
  109.    UpperLeft_Column  := UpperLeftX+1;
  110.    UpperLeft_Row     := UpperLeftY+1;
  111.    LowerRight_Column := LowerRightX-1;
  112.    LowerRight_Row    := LowerRightY-1;
  113.    Clrscr;
  114.    TextColor( Text_Color );
  115. End;
  116.