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

    {
    I have code that will save a textmode screen to an ANSI format
     text file by reading the text mode screen directly. The code came
     from another discussion on saving text screens to ANSI files;
     the code is not mine.
    }

    PROGRAM Ansi_Save_Screen;
    {*
     * Save a color-screen in Ansi-format. Simple way, char by char: blanks
     * not skipped.
     *}
    Uses
     Dos;

    PROCEDURE SaveANSI(Filename : PathStr);
    CONST
     Esc = #27;
     MaxCol  = 70;
     AnsiCols : array [0..7] of char = '04261537';

    TYPE
     TCell = RECORD
    C : Char;
    A : byte;
     END;
     TScreen = array [1..25, 1..80] of TCell;

     ANSIATTR = record
    Bright : boolean;
    Blink : boolean;
    FG : byte;
    BG : byte;
     end;

    VAR
     Screen  : TSCreen ABSOLUTE $B800:$0000;
     F: text;
     X, Y : byte;
     s, s1: String;
     AnsiLast,
     AnsiTmp : ANSIATTR;

    function WriteAttr(var Old, New : ANSIATTR) : string;
    { Write Attributes (ESC[..m) into a string }
    var
     s : string;
    begin
     WriteAttr := '';
     s := ESC + '[';
     if (not(New.Bright = Old.Bright)) or (not(New.Blink = Old.Blink)) then
     begin
    if (Not (New.Bright and New.Blink)) then
     s := s + '0;'
    else
    if (not New.Bright) and (New.Blink) then
    begin
     if Old.Bright then
    s := s + '0;5;'
     else
    s := s + '5;';
    end
    else
    if (New.Bright) and (not New.Blink) then
    begin
     if Old.Blink then
    s := s + '0;1;'
     else
    s := s + '1;';
    end
    else
    begin
     if not Old.Bright then
    s := s + '1;';
     if not Old.Blink then
    s := s + '5;';
    end;
     end;

     if (Old.FG <> New.FG) or ((not New.Bright) and Old.Bright) or
      ((not New.Blink) and Old.Blink) then
     begin
    {* I don't have no info why, but obviously backswitching to dark
     * colorset, what has to be done via ^[0m, must turn fg/bg colors to
     * 37/40. However, we can optimize still then a bit !-. *}
    if not ( (New.FG=7) and ((not New.Bright) and Old.Bright) )
      then s:=s+'3'+AnsiCols[New.FG]+';';
     end;

     if (Old.BG<>New.BG) or ((not New.Bright) and Old.Bright) or
     ((not New.Blink) and Old.Blink) then
     begin
    if not ( (New.BG=0) and ((not New.Bright) and Old.Bright) )
      then s:=s+'4'+AnsiCols[New.BG]+';';
     end;

     if s[length(s)]=';' then s[length(s)]:='m' else s:=s+'m';

     if length(s)>length(ESC+'[m') then WriteAttr:=s;
    end;

    BEGIN
     Assign(F, filename);
     Rewrite(F);

     AnsiTmp.FG := Screen[1, 1].A and 15;
     AnsiTmp.BG := Screen[1, 1].A SHR 4;
     AnsiTmp.Blink := (AnsiTmp.BG AND 8) = 8;
     AnsiTmp.Bright := (AnsiTmp.FG AND 8) = 8;
     AnsiTmp.FG:=AnsiTmp.FG and 7;
     AnsiTmp.BG:=AnsiTmp.BG and 7;

     s:=Esc+'[2J'+Esc+'[0m'+ESC+'[';
     if AnsiTmp.Bright then s:=s+'1;';
     if AnsiTmp.Blink then s:=s+'5;';
     s:=s+'3'+ansicols[AnsiTmp.FG]+';';
     s:=s+'4'+ansicols[AnsiTmp.BG]+'m';

     FOR Y := 1 TO 25 DO
    BEGIN
     FOR X := 1 TO 80 DO
      BEGIN
     AnsiLast:=AnsiTmp;

     AnsiTmp.FG := Screen[Y, X].A AND 15;
     AnsiTmp.BG := Screen[Y, X].A SHR 4;
     AnsiTmp.Bright := (AnsiTmp.FG AND 8)<>0;
     AnsiTmp.Blink := (AnsiTmp.BG AND 8)<>0;
     AnsiTmp.FG:=AnsiTmp.FG and 7;
     AnsiTmp.BG:=AnsiTmp.BG and 7;

     s1:=WriteAttr(AnsiLast, AnsiTmp);
     s1:=s1+Screen[Y, X].C;

     IF (length(s+s1+ESC+'[s')) <= MaxCol then s:=s+s1 else
     begin
      Write(F,s+ESC+'[s'+#13#10);
      s:=ESC+'[u'+s1;
     end;

      END;
    END;
    Write(F, Esc+'[0;37;40m');
    Close(F);
    END;
    BEGIN
     SaveANSI('test3.ans');
    END.

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