home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / TPDB32 / TPDBSCRN.PAS < prev    next >
Pascal/Delphi Source File  |  1991-10-28  |  4KB  |  174 lines
  1. unit TPDBScrn;
  2.  
  3.                            (***********************************)
  4.                            (*               TPDB              *)
  5.                            (***********************************)
  6.                            (*         Object -Oriented        *)
  7.                            (*     Turbo Pascal 6.0 Units      *)
  8.                            (*    for Accessing dBASE III      *)
  9.                            (*             files.              *)
  10.                            (*        Copyright 1991           *)
  11.                            (*          Brian Corll            *)
  12.                            (*       All Rights Reserved       *)
  13.                            (*     dBASE is a registered       *)
  14.                            (* trademark of Ashton-Tate, Inc.  *)
  15.                            (*   Version 3.20  October, 1991   *)
  16.                            (***********************************)
  17.                            (*   Portions Copyright 1984,1991  *)
  18.                            (*    Borland International Corp.  *)
  19.                            (***********************************)
  20.  
  21. {$L Flash}
  22. {$L Attr}
  23.  
  24. interface
  25.  
  26. const
  27. {Color constants - defined to take advantage of Turbo Pascal's
  28.  constant folding capabilities.  See documentation.}
  29.  
  30.  
  31.     Black = $00;
  32.     DarkGray = $08;
  33.     Blue = $01;
  34.     LightBlue = $09;
  35.     Green = $02;
  36.     LightGreen = $0A;
  37.     Cyan = $03;
  38.     LighBCyan = $0B;
  39.     Red = $04;
  40.     LightRed = $0C;
  41.     Magenta = $05;
  42.     LightMagenta = $0D;
  43.     Brown = $06;
  44.     Yellow = $0E;
  45.     LightGray = $07;
  46.     White = $0F;
  47.     Blink = $80;
  48.  
  49.     BlackBG = $00;
  50.     BlueBG = $10;
  51.     GreenBG = $20;
  52.     CyanBG = $30;
  53.     RedBG = $40;
  54.     MagentaBG = $50;
  55.     BrownBG = $60;
  56.     LightGrayBG = $70;
  57.  
  58. type
  59.     ScreenType = array [0..3999] of byte;
  60.     ScrPtr = ^ScreenType;
  61.     DisplayType = (Monochrome, CGA, EGA, MCGA, VGA);
  62.  
  63. var
  64.     VideoBase: word;
  65.     VideoWait: boolean;
  66.  
  67.  
  68.  
  69. function SaveScreen: ScrPtr;
  70.  
  71. procedure RestoreScreen(var SavedScreen: ScrPtr);
  72.  
  73. procedure Flash(Row, Col, Attr: byte; Str: string);
  74.  
  75. procedure CursorOn;
  76.  
  77. procedure CursorOff;
  78.  
  79. procedure BlockCursor;
  80.  
  81. procedure ChAttr(Number: word; Row, Col, Attr: word);
  82.  
  83. procedure ChAllAttr(Row, Col, Rows, Cols, Attr: word);
  84.  
  85. procedure FlashC(Row, Attr: byte; Str: string);
  86.  
  87.  
  88. implementation
  89.  
  90. var
  91.     Screen: ScreenType absolute $B800: 0000;
  92.     MonoScreen: ScreenType absolute $B000: 0000;
  93.     Mono: boolean;
  94.  
  95. {$F+}
  96.  
  97. procedure Flash(Row, Col, Attr: byte; Str: string);
  98. external;
  99.  
  100. function CurrVidDisplay: DisplayType;
  101. external;
  102.  
  103. function CurrentVideoMode: byte;
  104. external;
  105.  
  106. procedure CursorOn;
  107. external;
  108.  
  109. procedure CursorOff;
  110. external;
  111.  
  112. procedure BlockCursor;
  113. external;
  114.  
  115. procedure ChAttr(Number: word; Row, Col, Attr: word);
  116. external;
  117.  
  118.  
  119.  
  120. {$F-}
  121.  
  122. procedure ChAllAttr(Row, Col, Rows, Cols, Attr: word);
  123.  
  124. var
  125.     TRow: byte;
  126.  
  127. begin
  128.     for TRow := Row to Rows do
  129.         ChAttr(Cols, TRow, Col, Attr);
  130. end;
  131.  
  132. procedure FlashC(Row, Attr: byte; Str: string);
  133.  
  134. begin
  135.     Flash(Row, 40 - Length(Str) div 2, Attr, Str);
  136. end;
  137.  
  138.  
  139. function SaveScreen: ScrPtr;
  140.  
  141. var
  142.     TempPtr: ScrPtr;
  143.  
  144. begin
  145.     New(TempPtr);
  146.     if Mono then
  147.         Move(MonoScreen, TempPtr^, 4000)
  148.     else
  149.         Move(Screen, TempPtr^, 4000);
  150.     SaveScreen := TempPtr;
  151. end;
  152.  
  153. procedure RestoreScreen(var SavedScreen: ScrPtr);
  154.  
  155. begin
  156.     if Mono then
  157.         Move(SavedScreen^, MonoScreen, 4000)
  158.     else
  159.         Move(SavedScreen^, Screen, 4000);
  160.     Dispose(SavedScreen);
  161. end;
  162.  
  163.  
  164. begin
  165.     if CurrentVideoMode = 7 then begin
  166.         VideoBase := $B000;
  167.         Mono := True;
  168.     end else begin
  169.         VideoBase := $B800;
  170.         Mono := False;
  171.     end;
  172.     VideoWait := (CurrVidDisplay = CGA);
  173. end.
  174.