[Back to SCREEN SWAG index] [Back to Main SWAG index] [Original]

    Uses CRT, DOS;

    {-- read the character at the cursor and return it as a Char --}
    Function ScreenChar : Char;
    Var
    R : Registers;
    begin
       Fillchar(R, SizeOf(R), 0);
       R.AH := 8;
       R.BH := 0;
       Intr($10, R);
       ScreenChar := Chr(R.AL);
    end;

    {-- sample routine to read the screen and dump it to an ASCII file --}
    {-- it uses ScreenChar ----}
    Procedure DumpScreen;
    Var
    Num : Integer;
    X1,Y1, x,y : Byte;
    S   : String[79]; {- line length string; some prefer string[80] -}
    Ch  : Char;
    Buf : Array[1..25] of String[79]; {- buffer to hold the screen contents -}
    F   : Text;
    FName:String[79];

    begin
       x1 := WhereX; y1 := WhereY; {- save present location of the cursor -}

       {- initialise the variables --}
       Num := 0;
       X := 1;
       Y := 1;
       S := '';
       FillChar(Buf, Sizeof(Buf), #0);

     {- do the stuff --}
     Repeat
       GotoXy(X,Y);         {-- start from top left of screen --}
       Inc(Num);            {-- increase line counter --}
       Ch := ScreenChar;    {-- read the character at screen location --}
       S := S+Ch;                {-- add it to temporary string --}

       Inc(X);                {-- goto next screen column -}
       If (Ch = #13) or (X = 79) Then {- CR, or end of screen-width-}
       begin
         X := 1;            {- back to column 1 -}
         Buf[Y] := s;       {- put the line in buffer (string array) -}
         s      := '';      {- empty the temporary string -}
         Inc(Y);            {- goto next line (row) -}
       end;
     Until (Num = 1975);    {- until we have read the screen (79*25 chars )-}

    {-- write the buffer to a text file --}
     FName := 'SCREEN.SAV';
     Assign(F, FName);
     SetTextBuf(F, Buf);

     {$I-}
     Append(f); {- if the file exists, append buffer to it -}
    {$I+}
      If IoResult <> 0 Then ReWrite(f); {- else create a new one -}

      For x := 1 to 25 do Writeln(F, Buf[x]); {- write it -}

    {$I-}
      Close(F);
    {$I+}
      If IoResult <> 0 Then;

      GotoXy(x1,y1); {- return to original location -}
    end;

    BEGIN
    DumpScreen;
    END.

[Back to SCREEN SWAG index] [Back to Main SWAG index] [Original]