home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPDB311.ZIP / TPDBSCRN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-02-14  |  2.7 KB  |  139 lines
  1. UNIT TPDBScrn;
  2. {August 22, 1989}
  3. {Screen handling unit}
  4.  
  5. {$L Flash}
  6. {$L Attr}
  7.  
  8. INTERFACE
  9.  
  10. CONST
  11.     {Color constants - defined to take advantage of Turbo Pascal's
  12.  constant folding capabilities.  See documentation.}
  13.  
  14.  
  15.   Black        = $00;       DarkGray     = $08;
  16.   Blue         = $01;       LightBlue    = $09;
  17.   Green        = $02;       LightGreen   = $0A;
  18.   Cyan         = $03;       LighBCyan    = $0B;
  19.   Red          = $04;       LightRed     = $0C;
  20.   Magenta      = $05;       LightMagenta = $0D;
  21.   Brown        = $06;       Yellow       = $0E;
  22.   LightGray    = $07;       White        = $0F;
  23.   Blink        = $80;
  24.  
  25.   BlackBG      = $00;
  26.   BlueBG       = $10;
  27.   GreenBG      = $20;
  28.   CyanBG       = $30;
  29.   RedBG        = $40;
  30.   MagentaBG    = $50;
  31.   BrownBG      = $60;
  32.   LightGrayBG  = $70;
  33.  
  34. Type
  35.     ScreenType = Array[0..3999] of Byte;
  36.     ScrPtr = ^ScreenType;
  37.    DisplayType = (Monochrome, CGA, EGA, MCGA, VGA);
  38.  
  39. VAR
  40.     VideoBase : WORD;
  41.     VideoWait : BOOLEAN;
  42.  
  43.  
  44.  
  45. FUNCTION SaveScreen : ScrPtr;
  46.  
  47. PROCEDURE RestoreScreen(VAR SavedScreen : ScrPtr);
  48.  
  49. PROCEDURE Flash(Row,Col, Attr:byte; Str : String);
  50.  
  51. PROCEDURE CursorOn;
  52.  
  53. PROCEDURE CursorOff;
  54.  
  55. PROCEDURE BlockCursor;
  56.  
  57. PROCEDURE ChAttr(Number : Word; Row, Col, Attr : Word);
  58.  
  59. PROCEDURE ChAllAttr(Row,Col,Rows,Cols,Attr : Word);
  60.  
  61. PROCEDURE FlashC(Row,Attr:Byte;Str : String);
  62.  
  63.  
  64. IMPLEMENTATION
  65.  
  66. VAR
  67.     Screen : ScreenType absolute $B800 : 0000;
  68.     MonoScreen : ScreenType absolute $B000 : 0000;
  69.     Mono : BOOLEAN;
  70.  
  71. {$F+}
  72.  
  73. PROCEDURE Flash(Row,Col, Attr:byte; Str : String);EXTERNAL;
  74.  
  75.     FUNCTION CurrVidDisplay: DisplayType;EXTERNAL;
  76.  
  77.     FUNCTION CurrentVideoMode: Byte; EXTERNAL;
  78.  
  79.     PROCEDURE CursorOn;EXTERNAL;
  80.  
  81.     PROCEDURE CursorOff;EXTERNAL;
  82.  
  83.     PROCEDURE BlockCursor;EXTERNAL;
  84.  
  85. PROCEDURE ChAttr(Number : Word; Row, Col, Attr : Word);EXTERNAL;
  86.  
  87.  
  88.  
  89. {$F-}
  90.  
  91. PROCEDURE ChAllAttr(Row,Col,Rows,Cols,Attr : Word);
  92. VAR
  93.     TRow : BYTE;
  94. BEGIN
  95.     FOR TRow := Row TO Rows DO
  96.         ChAttr(Cols,TRow,Col,Attr);
  97. END;
  98.  
  99. PROCEDURE FlashC(Row,Attr:Byte;Str : String);
  100. BEGIN
  101.      Flash(Row,40 - Length(Str) div 2,Attr,Str);
  102. END;
  103.  
  104.  
  105. FUNCTION SaveScreen : ScrPtr;
  106. VAR
  107.     TempPtr : ScrPtr;
  108. BEGIN
  109.     NEW(TempPtr);
  110.     IF Mono THEN
  111.         Move(MonoScreen,TempPtr^,4000)
  112.     ELSE
  113.         Move(Screen,TempPtr^,4000);
  114.     SaveScreen := TempPtr;
  115. END;
  116.  
  117. PROCEDURE RestoreScreen(VAR SavedScreen : ScrPtr);
  118. BEGIN
  119.     IF Mono THEN
  120.         Move(SavedScreen^,MonoScreen,4000)
  121.     ELSE
  122.         Move(SavedScreen^,Screen,4000);
  123.     DISPOSE(SavedScreen);
  124. END;
  125.  
  126.  
  127. BEGIN
  128.     IF CurrentVideoMode = 7 THEN
  129.     BEGIN
  130.         VideoBase := $B000;
  131.         Mono := TRUE;
  132.     END
  133.     ELSE
  134.     BEGIN
  135.         VideoBase := $B800;
  136.         Mono := FALSE;
  137.     END;
  138.     VideoWait := (CurrVidDisplay = CGA);
  139. END.