home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / screen.swg / 0049_Dump Screen.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-26  |  2.0 KB  |  78 lines
  1.  
  2. Uses CRT, DOS;
  3.  
  4. {-- read the character at the cursor and return it as a Char --}
  5. Function ScreenChar : Char;
  6. Var
  7. R : Registers;
  8. begin
  9.    Fillchar(R, SizeOf(R), 0);
  10.    R.AH := 8;
  11.    R.BH := 0;
  12.    Intr($10, R);
  13.    ScreenChar := Chr(R.AL);
  14. end;
  15.  
  16. {-- sample routine to read the screen and dump it to an ASCII file --}
  17. {-- it uses ScreenChar ----}
  18. Procedure DumpScreen;
  19. Var
  20. Num : Integer;
  21. X1,Y1, x,y : Byte;
  22. S   : String[79]; {- line length string; some prefer string[80] -}
  23. Ch  : Char;
  24. Buf : Array[1..25] of String[79]; {- buffer to hold the screen contents -}
  25. F   : Text;
  26. FName:String[79];
  27.  
  28. begin
  29.    x1 := WhereX; y1 := WhereY; {- save present location of the cursor -}
  30.  
  31.    {- initialise the variables --}
  32.    Num := 0;
  33.    X := 1;
  34.    Y := 1;
  35.    S := '';
  36.    FillChar(Buf, Sizeof(Buf), #0);
  37.  
  38.  {- do the stuff --}
  39.  Repeat
  40.    GotoXy(X,Y);         {-- start from top left of screen --}
  41.    Inc(Num);            {-- increase line counter --}
  42.    Ch := ScreenChar;    {-- read the character at screen location --}
  43.    S := S+Ch;                {-- add it to temporary string --}
  44.  
  45.    Inc(X);                {-- goto next screen column -}
  46.    If (Ch = #13) or (X = 79) Then {- CR, or end of screen-width-}
  47.    begin
  48.      X := 1;            {- back to column 1 -}
  49.      Buf[Y] := s;       {- put the line in buffer (string array) -}
  50.      s      := '';      {- empty the temporary string -}
  51.      Inc(Y);            {- goto next line (row) -}
  52.    end;
  53.  Until (Num = 1975);    {- until we have read the screen (79*25 chars )-}
  54.  
  55. {-- write the buffer to a text file --}
  56.  FName := 'SCREEN.SAV';
  57.  Assign(F, FName);
  58.  SetTextBuf(F, Buf);
  59.  
  60.  {$I-}
  61.  Append(f); {- if the file exists, append buffer to it -}
  62. {$I+}
  63.   If IoResult <> 0 Then ReWrite(f); {- else create a new one -}
  64.  
  65.   For x := 1 to 25 do Writeln(F, Buf[x]); {- write it -}
  66.  
  67. {$I-}
  68.   Close(F);
  69. {$I+}
  70.   If IoResult <> 0 Then;
  71.  
  72.   GotoXy(x1,y1); {- return to original location -}
  73. end;
  74.  
  75. BEGIN
  76. DumpScreen;
  77. END.
  78.