home *** CD-ROM | disk | FTP | other *** search
/ synchro.net / synchro.net.tar / synchro.net / main / BBS / D32_01.ZIP / SCRNSAVE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-07-25  |  4.0 KB  |  207 lines
  1. Unit ScrnSave;
  2.  
  3. { SCRNSAVE.PAS : Cross platform text mode screen saving object for DOS,    }
  4. { Win32, and OS/2.  Written By James Coyle - Updated March 21st, 1999      }
  5.  
  6. { Note: This unit assumes that the program is running on a color system in }
  7. {       80 x 25 line text mode.                                            }
  8.  
  9. Interface
  10.  
  11. Type
  12.   ScrnSavePTR = ^ScrnSaveOBJ;
  13.   ScrnSaveOBJ = Object
  14.   Public
  15.     OutputHandle : Longint;
  16.  
  17.                 Constructor Init;
  18.                 Destructor  Done;
  19.     Procedure   Save;
  20.     Procedure   Restore;
  21.  
  22.     procedure   WriteXY(const X, Y: Byte; Attr: Byte; CH: Byte);
  23.     procedure   GetXY(const X, Y: Byte; var Attr: Byte; var CH: Byte);
  24.   Private
  25.     SavedX : Byte;
  26.     SavedY : Byte;
  27.                 SavedA : Byte;
  28.     Buffer : Array[0..3999] of Byte;
  29.   End;
  30.  
  31. Implementation
  32.  
  33. Uses CRT
  34.   {$IFDEF WIN32}
  35.     ,Windows
  36.   {$ENDIF}
  37.  
  38.   {$IFDEF OS2}
  39.     ,Os2Base
  40.   {$ENDIF};
  41.  
  42. Constructor ScrnSaveOBJ.Init;
  43. Begin
  44.   OutputHandle := -1;
  45.  
  46.   {$IFDEF VirtualPascal}
  47.     {$IFDEF WIN32}
  48.       OutputHandle := SysFileStdOut;
  49.     {$ENDIF}
  50.  
  51.     {$IFDEF OS2}
  52.       OutputHandle := TvVioHandle;
  53.     {$ENDIF}
  54.   {$ENDIF}
  55.  
  56.   {$IFDEF FPC}
  57.     OutputHandle := OutHandle;
  58.   {$ENDIF}
  59. End;
  60.  
  61. Destructor ScrnSaveOBJ.Done;
  62. Begin
  63. End;
  64.  
  65. Procedure ScrnSaveOBJ.Save;
  66. {$IFNDEF MSDOS}
  67. Var
  68.   P : Word;
  69.   X : Byte;
  70.   Y : Byte;
  71. {$ENDIF}
  72. Begin
  73.   SavedX := WhereX;
  74.   SavedY := WhereY;
  75.         SavedA := TextAttr;
  76.  
  77.   {$IFDEF MSDOS}
  78.     Move (Mem[$B800:$0000], Buffer, 4000);
  79.   {$ELSE}
  80.     P := 0;
  81.     For Y := 0 to 24 Do
  82.       For X := 0 to 79 Do Begin
  83.         begin
  84.           GetXY(X, Y, Buffer[P], Buffer[P + 1]);
  85.           Inc (P, 2);
  86.         end; { if }
  87.       End;
  88.   {$ENDIF}
  89. End;
  90.  
  91. Procedure ScrnSaveOBJ.Restore;
  92. {$IFNDEF MSDOS}
  93. Var
  94.   X, Y    : Longint;
  95.   P       : Longint;
  96. {$ENDIF}
  97. Begin
  98.   {$IFDEF MSDOS}
  99.     Move (Buffer, Mem[$B800:$0000], 4000);
  100.   {$ELSE}
  101.     P := 0;
  102.     For Y := 0 to 24 Do
  103.       For X := 0 to 79 Do
  104.         begin
  105.            WriteXY(X, Y, Buffer[P], Buffer[P + 1]);
  106.            Inc (P, 2);
  107.         end; { for }
  108.   {$ENDIF}
  109.  
  110.   GotoXY (SavedX, SavedY);
  111.   TextAttr := SavedA;
  112. End;
  113.  
  114. procedure ScrnSaveObj.WriteXY(const X, Y: Byte; Attr: Byte; CH: Byte);
  115. {$IFDEF WIN32}
  116. var Cell    : TCharInfo;
  117.     BufSize : TCoord;                   { Column-row size of source buffer }
  118.     WritePos: TCoord;                      { Upper-left cell to write from }
  119.     DestRect: TSmallRect;
  120. {$ENDIF}
  121.  
  122. {$IFDEF MSDOS}
  123. var OldX, OldY, OldA: Byte;
  124. {$ENDIF}
  125.  
  126. {$IFDEF OS2}
  127. var TempStr: String;
  128. {$ENDIF}
  129. begin
  130.   {$IFDEF WIN32}
  131.     BufSize.X := 01;
  132.     BufSize.Y := 01;
  133.  
  134.     WritePos.X := 0;
  135.     WritePos.Y := 0;
  136.  
  137.     Cell.Attributes := Attr;
  138.     Cell.UniCodeChar := Ord(CH);
  139.  
  140.     DestRect.Left := X;
  141.     DestRect.Top := Y;
  142.     DestRect.Right := X;
  143.     DestRect.Bottom := Y;
  144.  
  145.     WriteConsoleOutput(OutputHandle, @Cell, BufSize, WritePos, DestRect);
  146.   {$ENDIF}
  147.  
  148.   {$IFDEF OS2}
  149.     VioWrtCharStrAtt(@CH, 1, Y, X, Attr, OutputHandle);
  150.   {$ENDIF}
  151.  
  152.  
  153.   {$IFDEF MSDOS}
  154.     OldX := WhereX;
  155.     OldY := WhereY;
  156.     OldA := TextAttr;
  157.  
  158.     GotoXY(X, Y);
  159.     TextAttr := Attr;
  160.     Write(CH);
  161.  
  162.     GotoXY(OldX, OldY);
  163.     TextAttr := OldA;
  164.   {$ENDIF}
  165. end; { proc. WriteXY }
  166.  
  167.  
  168. procedure ScrnSaveObj.GetXY(const X, Y: Byte; var Attr: Byte; var CH: byte);
  169. {$IFDEF WIN32}
  170. var Reads: DWORD;
  171.     Coord: TCoord;
  172.  
  173.     Temp: SmallWord;
  174. {$ENDIF}
  175.  
  176. {$IFDEF OS2}
  177. var ScrnWord,
  178.     ReadSize : SmallWord;
  179. {$ENDIF}
  180. begin
  181.   {$IFDEF WIN32}
  182.     FillChar(Coord, SizeOf(Coord), 0);
  183.     Coord.X := X;
  184.     Coord.Y := Y;
  185.  
  186.     ReadConsoleOutputCharacter(OutputHandle, @Temp, 1, Coord, Reads);
  187.     Ch := Byte(Temp);
  188.  
  189.     ReadConsoleOutputAttribute(OutputHandle, @Temp, 1, Coord, Reads);
  190.     Attr := Byte(Temp);
  191.   {$ENDIF}
  192.  
  193.   {$IFDEF OS2}
  194.     ReadSize := SizeOf(ScrnWord);
  195.     VioReadCellStr(ScrnWord, ReadSize, Y, X, OutputHandle);
  196.  
  197.     Attr := Hi(ScrnWord) and $7f;
  198.     CH := Lo(ScrnWord);
  199.   {$ENDIF}
  200.  
  201.   {$IFDEF MSDOS}
  202.     { dummy }
  203.   {$ENDIF}
  204. end; { proc. GetXY }
  205.  
  206. End.
  207.