SWAG Pascal

Sommaire > DOS > Console > Contrôle et output ANSI
        Procédure Display_ANSI
        Unité ANSI
        Programme AnsiWrite
        Affichage direct ANSI
        Unité AnsiOut
        Sortie ANSI avec l'interruption 29h
        Clone ANSI de l'unité Crt
        Détecter si ANSI.SYS est installé
        Lecture dans une image TheDraw
        Affichage d'images TheDraw
        Comment importer et afficher un fichier TheDraw ?
        Comment utiliser TheDraw ?
        Displaying TheDraw images
        Display TheDraw BIN file
        Ansi Screens
        Detect if ANSI.SYS is present
        Program SHOWANSI.PAS
        Combine ANSI Screens
        ANSI Music
        ANSI Bulletin files
        ANSI in a window
        Detect ANSI.SYS
        ANSI string scrolling
        ANSI Driver
        ANSI save screen
        Direct ANSI write
        ANSI screen dump
        ANSI color strings
        Full ANSI output unit
        Complete ANSI output unit
        Fast ANSI display unit
        ANSI file dump
        Pascal ANSI engine
        Full ANSI unit
        Use LVI color on BBS
        ANSI save to file
        ANSI BIOS write
        ANSI color setting
        ANSI in Turbo Vision
        ANSI viewer
        ANSI screen bounce
        Local ANSI detect
        ANSI unit
        An ANSI viewer for Sauce
        ANSI file scroller
        Object-oriented ANSI unit
        Display ANSI files fast
        ANSI Input/Output
        The fastest CD-Audio unit
        Display ANSI char set

Procédure Display_ANSI

[haut]

auteur : Equipe SWAG


Unit Ansi; (* Ho ho ho - Santa Claus) *)

Interface

Uses Crt;

Procedure Display_ANSI(ch:Char);
{ Affiche ch suivant le protocole graphique ANSI }

{---------------------------------------------------------------------- -----}
{ Information utile pour le portage :

  Changement couleur du fond          Changement couleur du texte
  TextBackground(0) = black           TextColor(0) = black
  TextBackground(1) = blue            TextColor(1) = blue
  TextBackground(2) = green           TextColor(2) = green
  TextBackground(3) = cyan            TextColor(3) = cyan
  TextBackground(4) = red             TextColor(4) = red
  TextBackground(5) = Magenta         TextColor(5) = magenta
  TextBackground(6) = brown           TextColor(6) = brown
  TextBackground(7) = light grey      TextColor(7) = white
                                      TextColor(8) = grey
  Delete(s,i,c);                      TextColor(9) = bright blue
    Supprime c caractères dans la     TextColor(10)= bright green
    chaîne s à partir de l'indice i   TextColor(11)= bright cyan
  Val(s,v,c);                         TextColor(12)= bright red
    Convertit chaîne s --> nombre v.  TextColor(13)= bright magenta
    c = 0 si Ok.                      TextColor(14)= bright yellow
  Length(s)                           TextColor(15)= bright white
    Longueur de la chaîne s
}

Implementation

Var
  ANSI_St   :String ;  {charge une séquence d'échappement ANSI si reçoit ANSI}
  ANSI_SCPL :Integer;  {charge ligne de la position du curseur sauvegardée}
  ANSI_SCPC :Integer;  {charge colonne de la position du curseur sauvegardée}
  ANSI_FG   :Integer;  {charge couleur de texte courante}
  ANSI_BG   :Integer;  {charge couleur de fond courante}
  ANSI_C,ANSI_I,ANSI_B,ANSI_R:Boolean ;  {charge attributs courants}

p,x,y : Integer;

Procedure Display_ANSI(ch:Char);
{ Affiche ch selon le protocole graphique ANSI }

  Procedure TABULATE;
  Var x:Integer;
  begin
    x:=WhereX;
    if x<80 then
      Repeat
        Inc(x);
      Until (x MOD 8)=0;
    if x=80 then x:=1;
    GotoXY(x,WhereY);
    if x=1 then WriteLN;
  end;

  Procedure BACKSPACE;
  Var x:Integer;
  begin
    if WhereX>1 then
      Write(^H,' ',^H)
    else
      if WhereY>1 then begin
        GotoXY(80,WhereY-1);
        Write(' ');
        GotoXY(80,WhereY-1);
      end;
  end;

  Procedure TTY(ch:Char);
  Var x:Integer;
  begin
    if ANSI_C then begin
      if ANSI_I then ANSI_FG:=ANSI_FG or 8;
      if ANSI_B then ANSI_FG:=ANSI_FG or 16;
      if ANSI_R then begin
        x:=ANSI_FG;
        ANSI_FG:=ANSI_BG;
        ANSI_BG:=x;
      end;
      ANSI_C:=False;
    end;
    TextColor(ANSI_FG);
    TextBackground(ANSI_BG);
    Case Ch of
      ^G: begin
            Sound(2000);
            Delay(75);
            NoSound;
          end;
      ^H: Backspace;
      ^I: Tabulate;
      ^J: begin
            TextBackground(0);
            Write(^J);
          end;
      ^K: GotoXY(1,1);
      ^L: begin
            TextBackground(0);
            ClrScr;
          end;
      ^M: begin
            TextBackground(0);
            Write(^M);
          end;
      else Write(Ch);
    end;
  end;

  Procedure ANSIWrite(S:String);
  Var x:Integer;
  begin
    For x:=1 to Length(S) do
      TTY(S[x]);
  end;

  Function Param:Integer;   {returns -1 if no more parameters}
  Var S:String;
      x,XX:Integer;
      B:Boolean;
  begin
    B:=False;
    For x:=3 to Length(ANSI_St) DO
      if ANSI_St[x] in ['0'..'9'] then B:=True;
    if not B then
      Param:=-1
    else begin
      S:='';
      x:=3;
      if ANSI_St[3]=';' then begin
        Param:=0;
        Delete(ANSI_St,3,1);
        Exit;
      end;
      Repeat
        S:=S+ANSI_St[x];
        x:=x+1;
      Until (NOT (ANSI_St[x] in ['0'..'9'])) or (Length(S)>2) or (x>Length(ANSI_St));
      if Length(S)>2 then begin
        ANSIWrite(ANSI_St+Ch);
        ANSI_St:='';
        Param:=-1;
        Exit;
      end;
      Delete(ANSI_St,3,Length(S));
      if ANSI_St[3]=';' then Delete(ANSI_St,3,1);
      Val(S,x,XX);
      Param:=x;
    end;
  end;

begin
  if (Ch<>#27) and (ANSI_St='') then begin
    TTY(Ch);
    Exit;
  end;
  if Ch=#27 then begin
    if ANSI_St<>'' then begin
      ANSIWrite(ANSI_St+#27);
      ANSI_St:='';
    end else ANSI_St:=#27;
    Exit;
  end;
  if ANSI_St=#27 then begin
    if Ch='[' then
      ANSI_St:=#27+'['
    else begin
      ANSIWrite(ANSI_St+Ch);
      ANSI_St:='';
    end;
    Exit;
  end;
  if (Ch='[') and (ANSI_St<>'') then begin
    ANSIWrite(ANSI_St+'[');
    ANSI_St:='';
    Exit;
  end;
  if not (Ch in ['0'..'9',';','A'..'D','f','H','J','K','m','s','u']) then begin
    ANSIWrite(ANSI_St+Ch);
    ANSI_St:='';
    Exit;
  end;
  if Ch in ['A'..'D','f','H','J','K','m','s','u'] then begin
    Case Ch of
    'A': begin
           p:=Param;
           if p=-1 then p:=1;
           if WhereY-p<1 then
             GotoXY(WhereX,1)
           else GotoXY(WhereX,WhereY-p);
         end;
    'B': begin
           p:=Param;
           if p=-1 then p:=1;
           if WhereY+p>25 then
             GotoXY(WhereX,25)
           else GotoXY(WhereX,WhereY+p);
         end;
    'C': begin
           p:=Param;
           if p=-1 then p:=1;
           if WhereX+p>80 then
             GotoXY(80,WhereY)
           else GotoXY(WhereX+p,WhereY);
         end;
    'D': begin
           p:=Param;
           if p=-1 then p:=1;
           if WhereX-p<1 then
             GotoXY(1,WhereY)
           else GotoXY(WhereX-p,WhereY);
         end;
'H','f': begin
           Y:=Param;
           x:=Param;
           if Y<1 then Y:=1;
           if x<1 then x:=1;
           if (x>80) or (x<1) or (Y>25) or (Y<1) then begin
             ANSI_St:='';
             Exit;
           end;
           GotoXY(x,Y);
         end;
    'J': begin
           p:=Param;
           if p=2 then begin
             TextBackground(0);
             ClrScr;
           end;
           if p=0 then begin
             x:=WhereX;
             Y:=WhereY;
             Window(1,y,80,25);
             TextBackground(0);
             ClrScr;
             Window(1,1,80,25);
             GotoXY(x,Y);
           end;
           if p=1 then begin
             x:=WhereX;
             Y:=WhereY;
             Window(1,1,80,WhereY);
             TextBackground(0);
             ClrScr;
             Window(1,1,80,25);
             GotoXY(x,Y);
           end;
         end;
    'K': begin
           TextBackground(0);
           ClrEol;
         end;
    'm': begin
           if ANSI_St=#27+'[' then begin
             ANSI_FG:=7;
             ANSI_BG:=0;
             ANSI_I:=False;
             ANSI_B:=False;
             ANSI_R:=False;
           end;
           Repeat
             p:=Param;
             Case p of
               -1:;
                0:begin
                    ANSI_FG:=7;
                    ANSI_BG:=0;
                    ANSI_I:=False;
                    ANSI_R:=False;
                    ANSI_B:=False;
                  end;
                1:ANSI_I:=True;
                5:ANSI_B:=True;
                7:ANSI_R:=True;
               30:ANSI_FG:=0;
               31:ANSI_FG:=4;
               32:ANSI_FG:=2;
               33:ANSI_FG:=6;
               34:ANSI_FG:=1;
               35:ANSI_FG:=5;
               36:ANSI_FG:=3;
               37:ANSI_FG:=7;
               40:ANSI_BG:=0;
               41:ANSI_BG:=4;
               42:ANSI_BG:=2;
               43:ANSI_BG:=6;
               44:ANSI_BG:=1;
               45:ANSI_BG:=5;
               46:ANSI_BG:=3;
               47:ANSI_BG:=7;
             end;
             if ((p>=30) and (p<=47)) or (p=1) or (p=5) or (p=7) then
ANSI_C:=True;
           Until p=-1;
         end;
    's': begin
           ANSI_SCPL:=WhereY;
           ANSI_SCPC:=WhereX;
         end;
    'u': begin
           if ANSI_SCPL>-1 then GotoXY(ANSI_SCPC,ANSI_SCPL);
           ANSI_SCPL:=-1;
           ANSI_SCPC:=-1;
         end;
    end;
    ANSI_St:='';
    Exit;
  end;
  if Ch in ['0'..'9',';'] then
    ANSI_St:=ANSI_St+Ch;
  if Length(ANSI_St)>50 then begin
    ANSIWrite(ANSI_St);
    ANSI_St:='';
    Exit;
  end;
end;


begin
  ANSI_St:='';
  ANSI_SCPL:=-1;
  ANSI_SCPC:=-1;
  ANSI_FG:=7;
  ANSI_BG:=0;
  ANSI_C:=False;
  ANSI_I:=False;
  ANSI_B:=False;
  ANSI_R:=False;
END.

Unité ANSI

[haut]

auteur : Equipe SWAG


UNIT Ansi;

INTERFACE


USES Crt, Dos;

CONST
     RecANSI : BOOLEAN = FALSE;

PROCEDURE AnsiWrite (ch : CHAR);
PROCEDURE AnsiWriteLn (S : STRING);

IMPLEMENTATION


VAR
    Escape, Saved_X,
    Saved_Y               : BYTE;
    Control_Code          : STRING;

FUNCTION GetNumber (VAR LINE : STRING) : INTEGER;

   VAR
     i, j, k         : INTEGER;
     temp0, temp1   : STRING;

  BEGIN
       temp0 := LINE;
       VAL (temp0, i, j);
      IF j = 0 THEN temp0 := ''
       ELSE
      BEGIN
         temp1 := COPY (temp0, 1, j - 1);
         DELETE (temp0, 1, j);
         VAL (temp1, i, j);
      END;
    LINE := temp0;
    GetNumber := i;
  END;

 PROCEDURE loseit;
    BEGIN
      escape := 0;
      control_code := '';
      RecANSI := FALSE;
    END;

 PROCEDURE Ansi_Cursor_move;

     VAR
      x, y       : INTEGER;

    BEGIN
     y := GetNumber (control_code);
     IF y = 0 THEN y := 1;
     x := GetNumber (control_code);
     IF x = 0 THEN x := 1;
     IF y > 25 THEN y := 25;
     IF x > 80 THEN x := 80;
     GOTOXY (x, y);
    loseit;
    END;

PROCEDURE Ansi_Cursor_up;

 VAR
   y, new_y, offset          : INTEGER;

   BEGIN
     Offset := getnumber (control_code);
        IF Offset = 0 THEN offset := 1;
      y := WHEREY;
      IF (y - Offset) < 1 THEN
             New_y := 1
          ELSE
             New_y := y - offset;
       GOTOXY (WHEREX, new_y);
  loseit;
  END;

PROCEDURE Ansi_Cursor_Down;

 VAR
   y, new_y, offset          : INTEGER;

   BEGIN
     Offset := getnumber (control_code);
        IF Offset = 0 THEN offset := 1;
      y := WHEREY;
      IF (y + Offset) > 25 THEN
             New_y := 25
          ELSE
             New_y := y + offset;
       GOTOXY (WHEREX, new_y);
  loseit;
  END;

PROCEDURE Ansi_Cursor_Left;

 VAR
   x, new_x, offset          : INTEGER;

   BEGIN
     Offset := getnumber (control_code);
        IF Offset = 0 THEN offset := 1;
      x := WHEREX;
      IF (x - Offset) < 1 THEN
             New_x := 1
          ELSE
             New_x := x - offset;
       GOTOXY (new_x, WHEREY);
  loseit;
  END;

PROCEDURE Ansi_Cursor_Right;

 VAR
   x, new_x, offset          : INTEGER;

   BEGIN
     Offset := getnumber (control_code);
        IF Offset = 0 THEN offset := 1;
      x := WHEREX;
      IF (x + Offset) > 80 THEN
             New_x := 1
          ELSE
             New_x := x + offset;
       GOTOXY (New_x, WHEREY);
  loseit;
  END;

 PROCEDURE Ansi_Clear_Screen;

   BEGIN                         {   0J = cusor to Eos           }
     CLRSCR;                      {  1j start to cursor           }
     loseit;                       { 2j entie screen/cursor no-move}
   END;

 PROCEDURE Ansi_Clear_EoLine;

   BEGIN
     CLREOL;
     loseit;
   END;


 PROCEDURE Reverse_Video;

 VAR
      tempAttr, tblink, tempAttrlo, tempAttrhi : BYTE;

 BEGIN
            LOWVIDEO;
            TempAttrlo := (TextAttr AND $7);
            tempAttrHi := (textAttr AND $70);
            tblink     := (textattr AND $80);
            tempattrlo := tempattrlo * 16;
            tempattrhi := tempattrhi DIV 16;
            TextAttr   := TempAttrhi + TempAttrLo + TBlink;
  END;


 PROCEDURE Ansi_Set_Colors;

 VAR
    temp0, Color_Code   : INTEGER;

    BEGIN
        IF LENGTH (control_code) = 0 THEN control_code := '0';
           WHILE (LENGTH (control_code) > 0) DO
           BEGIN
            Color_code := getNumber (control_code);
                CASE Color_code OF
                   0          :  BEGIN
                                   LOWVIDEO;
                                   TEXTCOLOR (LightGray);
                                   TEXTBACKGROUND (Black);
                                 END;
                   1          : HIGHVIDEO;
                   5          : TextAttr := (TextAttr OR $80);
                   7          : Reverse_Video;
                   30         : textAttr := (TextAttr AND $F8) + black;
                   31         : textattr := (TextAttr AND $f8) + red;
                   32         : textattr := (TextAttr AND $f8) + green;
                   33         : textattr := (TextAttr AND $f8) + brown;
                   34         : textattr := (TextAttr AND $f8) + blue;
                   35         : textattr := (TextAttr AND $f8) + magenta;
                   36         : textattr := (TextAttr AND $f8) + cyan;
                   37         : textattr := (TextAttr AND $f8) + Lightgray;
                   40         : TEXTBACKGROUND (black);
                   41         : TEXTBACKGROUND (red);
                   42         : TEXTBACKGROUND (green);
                   43         : TEXTBACKGROUND (yellow);
                   44         : TEXTBACKGROUND (blue);
                   45         : TEXTBACKGROUND (magenta);
                   46         : TEXTBACKGROUND (cyan);
                   47         : TEXTBACKGROUND (white);
                 END;
             END;
       loseit;
  END;


 PROCEDURE Ansi_Save_Cur_pos;

    BEGIN
      Saved_X := WHEREX;
      Saved_Y := WHEREY;
      loseit;
    END;


 PROCEDURE Ansi_Restore_cur_pos;

    BEGIN
      GOTOXY (Saved_X, Saved_Y);
      loseit;
    END;


 PROCEDURE Ansi_check_code ( ch : CHAR);

   BEGIN
       CASE ch OF
            '0'..'9', ';'     : control_code := control_code + ch;
            'H', 'f'          : Ansi_Cursor_Move;
            'A'              : Ansi_Cursor_up;
            'B'              : Ansi_Cursor_Down;
            'C'              : Ansi_Cursor_Right;
            'D'              : Ansi_Cursor_Left;
            'J'              : Ansi_Clear_Screen;
            'K'              : Ansi_Clear_EoLine;
            'm'              : Ansi_Set_Colors;
            's'              : Ansi_Save_Cur_Pos;
            'u'              : Ansi_Restore_Cur_pos;
        ELSE
          loseit;
        END;
   END;


PROCEDURE AnsiWrite (ch : CHAR);

VAR
  temp0      : INTEGER;

BEGIN
       IF escape > 0 THEN
          BEGIN
              CASE Escape OF
                1    : BEGIN
                         IF ch = '[' THEN
                            BEGIN
                              escape := 2;
                              Control_Code := '';
                            END
                         ELSE
                             escape := 0;
                       END;
                2    : Ansi_Check_code (ch);
              ELSE
                BEGIN
                   escape := 0;
                   control_code := '';
                   RecANSI := FALSE;
                END;
              END;
          END
       ELSE
         BEGIN
          CASE Ch OF
             #27       : Escape := 1;
             #9        : BEGIN
                            temp0 := WHEREX;
                            temp0 := temp0 DIV 8;
                            temp0 := temp0 + 1;
                            temp0 := temp0 * 8;
                            GOTOXY (temp0, WHEREY);
                         END;
             #12       : CLRSCR;
          ELSE
                 BEGIN
                    IF ( (WHEREX = 80) AND (WHEREY = 25) ) THEN
                      BEGIN
                        windmax := (80 + (24 * 256) );
                        WRITE (ch);
                        windmax := (79 + (24 * 256) );
                      END
                    ELSE
                      WRITE (ch);
                    escape := 0;
                 END;
           END;
         END;
  RecANSI := (Escape <> 0);
  END;

PROCEDURE AnsiWriteLn (S : STRING);
VAR I : BYTE;
BEGIN
FOR I := 1 TO LENGTH (S) DO Ansiwrite (S [i]);
END;

END.

Programme AnsiWrite

[haut]

auteur : Equipe SWAG

How do I make an ansi and put it in my Pascal File ? I know there is an option to save as pascal, but it does not look like anything to me !
Any help is appreciated !

Here is a Program that will read an ANSI File into a buffer in 2k chunks then Write it (to screen) Character by Character. BUT - it will Write all ANSI-escape-sequences as StringS.

Two reasons For this :

1) I just 'feel happier' if each ANSI escape sequence is written to screen as a String instead of as individual Characters. (Its just an irrational 'thing' I have)

2) By assembling all the Characters in the escape sequence together, it make its _easy_ to FILTER OUT all ANSI sequences if you want to just output plain black-and-white Text. This is For those people who for some strange reason would rather not have ANSI.SYS installed, but complain about getting 'garbage' Characters on the screen.

All you have to do to filter out the escape sequences is to un-bracket the 'if AnsiDetected then' part.

If you want me to post 'Function AnsiDetected: Boolean' just let me know.


Program ansiWrite;

Const esc = chr(27);
      termnChar: SET of Char =
                 ['f','A'..'D','H','s','u','J','K','l'..'n','h'];

Var f: File;
    buf:Array[1..2048] of Char;
    Numread: Word;
    num: Integer;
    escString: String;
    escseq: Boolean;

begin
  Assign(f,'FRINGE3.ANS');
  Reset(f,1);
  escseq := False;
  escString:='';
  Repeat
    BlockRead(f,buf,Sizeof(Buf),Numread);
    { Write Block to Screen }
    For NUM := 1 to Numread DO
    begin
      if Buf[Num] = esc then escseq := True;
      if escseq=True then
      begin
        escString:= escString+buf[num];
        if Buf[num] in termnChar  then
        begin
          escseq:=False;
          {if AnsiDetected then} Write(escString);
          escString:=''
        end
      end
      else Write(Buf[num])
    end; { For }
  Until NumRead < SizeOf(Buf);
  close(f)
end.

Affichage direct ANSI

[haut]

auteur : Dustin Nulf

I've run into that familiar problem in trying to view Ansi colored pictures and using the Crt Unit at the same time. The Crt Unit doesn't translate the Ansi codes and displays them literally. Now, I've created an Ansi interpreter Procedure that reads each line in an ansi File and calls the appropriate TextColor/TextBackground Procedures, according to what ansi escape String was found. This is groovy and all, but I just found out something new today With :


Assign(Output,'');
ReWrite(Output);

...and that it translates all the ansi codes For me already! Now, the big question is, what are the advantages and disadvantages of using this Assign method vs. the Ansi interpreter method ? Is this Assign method slower/faster, take up more memory, more disk space, etc. Any information would be highly appreciated! :)

Unité AnsiOut

[haut]

auteur : Equipe SWAG

Now that I need to make a .ANS bulletin Type File, I was wondering how to Write from a Pascal Program, ANSI control Characters to a File and produce nice color bulletin screen to be displayed by RA.

The following Unit will enable you to Write Ansi sequences to a Text File Without having to look them up yourself. It enables you to do this using the (easier) Crt Unit style of commands, and provides the optimum Ansi sequence to do the job.


Unit AnsiOut;
{1. Contains reduced set of Procedures from AnsiCrt Unit by I.Hinson.}
{2. Modified to provide output to a Text File.}

Interface

Const Black = 0;     Blue = 1;          Green = 2;       Cyan = 3;
      Red =   4;     Magenta = 5;       Brown = 6;       LightGray = 7;
      DarkGray = 8;  LightBlue = 9;     LightGreen = 10; LightCyan = 11;
      LightRed = 12; LightMagenta = 13; Yellow = 14;     White = 15;
      Blink = 128;

Var AnsiFile: Text;

Procedure TextColor(fore : Byte);
Procedure TextBackGround(back : Byte);
Procedure NormVideo;
Procedure LowVideo;
Procedure HighVideo;
Procedure ClrEol;
Procedure ClrScr;

Implementation

Const forestr: Array[Black..LightGray] of String[2]
               = ('30','34','32','36','31','35','33','37');
      backstr: Array[Black..LightGray] of String[2]
               = ('40','44','42','46','41','45','43','47');
      decisiontree: Array[Boolean, Boolean, Boolean, Boolean] of Integer =
      ((((0,1),(2,0)),((1,1),(3,3))),(((4,5),(6,4)),((0,5),(2,0))));

Var forecolour, backcolour: Byte; { stores last colours set }
    boldstate, blinkstate: Boolean;

Procedure TextColor(fore : Byte);
  Var
    blinknow, boldnow: Boolean;
    outstr: String;
  begin
    blinknow := (fore and $80) = $80;
    boldnow := (fore and $08) = $08;
    fore := fore and $07;  { mask out intensity and blink attributes }
    forecolour := fore;
    Case decisiontree[blinknow, blinkstate, boldnow, boldstate] OF
    0: outstr := Concat(#27,'[',forestr[fore],'m');
    1: outstr := Concat(#27,'[0;',backstr[backcolour],';',forestr[fore],'m');
    2: outstr := Concat(#27,'[1;',forestr[fore],'m');
    3: outstr :=
         Concat(#27,'[0;1;',backstr[backcolour],';',forestr[fore],'m');
    4: outstr := Concat(#27,'[5;',forestr[fore],'m');
    5: outstr :=
         Concat(#27,'[0;5;',backstr[backcolour],';',forestr[fore],'m');
    6: outstr := Concat(#27,'[1;5;',forestr[fore],'m');
    end; { Case }
    Write(AnsiFile,outstr);
    blinkstate := blinknow;
    boldstate := boldnow;
  end;

Procedure TextBackGround(back: Byte);
  Var outString: String;
  begin
    if Back > 7 then Exit; { No such thing as bright or blinking backgrounds }
    BackColour := Back;
    outString := Concat(#27,'[',backstr[back],'m');
    Write(AnsiFile,outString)
  end;

Procedure NormVideo;
  begin
    Write(AnsiFile,#27'[0m');
    forecolour := LightGray;
    backcolour := Black;
    boldstate := False;
    blinkstate := False
  end;

Procedure LowVideo;
  begin
    if blinkstate then forecolour := forecolour or $80;  { retain blinking }
    TextColor(forecolour);   { stored forecolour never contains bold attr }
  end;

Procedure HighVideo;
  begin
    if not boldstate then
    begin
      boldstate := True;
      Write(AnsiFile,#27,'[1m')
    end;
  end;

Procedure ClrEol;
  begin
    Write(AnsiFile,#27'[K')
  end;

Procedure ClrScr;
  begin
    Write(AnsiFile,#27'[2J');
  end;

begin
  forecolour := LightGray;
  backcolour := Black;
  boldstate := False;
  blinkstate := False
end.

___------------------------------------------------------------------
Program Demo;
Uses AnsiOut;
begin
  Assign(AnsiFile,'CON');   { or a File - e.g. 'MYSCREEN.ANS' }
  ReWrite(AnsiFile);
  ClrScr;
  TextColor(Blue); TextBackGround(LightGray);
  Writeln(AnsiFile,' Blue Text on LightGray ');
  HighVideo; Write(AnsiFile,' Now the Text is LightBlue ');
  TextBackground(Red); Writeln(AnsiFile,' on a Red background');
  TextColor(Black+Blink); TextBackground(Cyan);
  Writeln(AnsiFile,' Blinking Black ');
  TextBackGround(Green); ClrEol;         { a blank Green line }
(53 min left), (H)elp, More?   Writeln(AnsiFile);
  NormVideo;
  Close(AnsiFile);
end.

Sortie ANSI avec l'interruption 29h

[haut]

auteur : Robert Rothenburg

For those interested in using ANSI in Turbo Pascal (at least Dos v2-5...I don't know if Dos 6 Uses this routine--Interrupt $29--or not) here's a tip: The "undocumented" Fast PutChar interrupt is used by ANSI.SYS, and thus anything you send to that interrupt will be ANSI-interpreted (provided ANSI.SYS is loaded :).

Use this routine to output a Character to ANSI: (you'll have to modify it to output Strings, of course).


Uses
  Dos;

Procedure FastPutChar(C : Char);
{ Outputs only to "display", not stdout! Uses Dos v2-5. }
Var
  Reg : Registers;
begin
  Reg.AL := Ord(C);
  Intr($29, Reg)
end;

Clone ANSI de l'unité Crt

[haut]

auteur : Equipe SWAG

Well here it is again, its a little rough and some of the Crt.tpu Functions are left out. This Unit will generate Ansi TextColor and TextBackGrounds.
Because of the Ansi screen Writes you can send the Program to the com port just by using CTTY or GateWay in a bat File before you start your Program.


Unit Crtclone;

Interface

Const
{ Foreground and background color Constants }

  Black         = 0;
  Blue          = 1;
  Green         = 2;
  Cyan          = 3;
  Red           = 4;
  Magenta       = 5;
  Brown         = 6;
  LightGray     = 7;

{ Foreground color Constants }

  DarkGray      = 8;
  LightBlue     = 9;
  LightGreen    = 10;
  LightCyan     = 11;
  LightRed      = 12;
  LightMagenta  = 13;
  Yellow        = 14;
  White         = 15;

{ Add-in For blinking }

  Blink         = 128;

Var

{ Interface Variables }

  CheckBreak: Boolean;    { Enable Ctrl-Break }
  CheckEOF: Boolean;      { Enable Ctrl-Z }
  Procedure TextColor(Color: Byte);
  Procedure TextBackground(Color: Byte);
  Function KeyPressed  : Boolean;
  Function GetKey      : Char;
  Function ReadKey     : Char;
  Function WhereX      : Byte;
  Function WhereY      : Byte;
  Procedure NormVideo;
  Procedure ClrEol;
  Procedure ClrScr;
  Procedure GotoXY(X, Y : Byte);


  Implementation

  Function KeyPressed : Boolean;   { Replacement For Crt.KeyPressed }
                         {  ;Detects whether a key is pressed}
                         {  ;Does nothing With the key}
                         {  ;Returns True if key is pressed}
                         {  ;Otherwise, False}
                         {  ;Key remains in kbd buffer}
    Var IsThere : Byte;
    begin
      Inline(
      $B4/$0B/               {    MOV AH,+$0B         ;Get input status}
      $CD/$21/               {    INT $21             ;Call Dos}
      $88/$86/>ISTHERE);     {    MOV >IsThere[BP],AL ;Move into Variable}
      if IsThere = $FF then KeyPressed := True else KeyPressed := False;
    end;

  Procedure  ClrEol;     { ANSI replacement For Crt.ClrEol }
    begin
      Write(#27'[K');
    end;

  Procedure ClrScr;     { ANSI replacement For Crt.ClrScr }
    begin
      Write(#27'[2J');
    end;

  Function GetKey : Char;     { Additional Function.  Not in Crt Unit }
    Var CH : Char;
    begin
      Inline(
                     {; Function GetKey : Char}
                     {; Clears the keyboard buffer then waits Until}
                     {; a key is struck.  if the key is a special, e.g.}
                     {; Function key, goes back and reads the next}
                     {; Byte in the keyboard buffer.  Thus does}
                     {; nothing special With Function keys.}
       $B4/$0C       {       MOV  AH,$0C      ;Set up to clear buffer}
      /$B0/$08       {       MOV  AL,8        ;then to get a Char}
      /$CD/$21       {SPCL:  INT  $21         ;Call Dos}
      /$3C/$00       {       CMP  AL,0        ;if it's a 0 Byte}
      /$75/$04       {       JNZ  CHRDY       ;is spec., get second Byte}
      /$B4/$08       {       MOV  AH,8        ;else set up For another}
      /$EB/$F6       {       JMP  SHORT SPCL  ;and get it}
      /$88/$46/>CH   {CHRDY: MOV  >CH[BP],AL  ;else put into Function return}
       );
      if CheckBreak and (Ch = #3) then
        begin        {if CheckBreak is True and it's a ^C}
          Inline(    {then execute Ctrl_Brk}
          $CD/$23);
        end;
      GetKey := Ch;
    end; {Inline Function GetKey}


  Function ReadKey : Char;  { Replacement For Crt.ReadKey }
    Var chrout : Char;
    begin
                         {  ;Just like ReadKey in Crt Unit}
      Inline(
      $B4/$07/               {  MOV AH,$07          ;Char input w/o echo}
      $CD/$21/               {  INT $21             ;Call Dos}
      $88/$86/>CHROUT);      {  MOV >chrout[bp],AL  ;Put into Variable}
      if CheckBreak and (chrout = #3) then  {if it's a ^C and CheckBreak True}
        begin                             {then execute Ctrl_Brk}
          Inline(
          $CD/$23);           {     INT $23}
        end;
      ReadKey := chrout;                    {else return Character}
    end;

  Function WhereX : Byte;       { ANSI replacement For Crt.WhereX }
    Var                         { Cursor position report. This is column or }
      ch  : Char;               { X axis report.}
      st  : String;
      st1 : String[2];
      x   : Byte;
      i   : Integer;

    begin
      Write(#27'[6n');          { Ansi String to get X-Y position }
      st := '';                 { We will only use X here }
      ch := #0;                 { Make sure Character is not 'R' }
      While ch <> 'R' do        { Return will be }
        begin                   { Esc - [ - Ypos - ; - Xpos - R }
          ch := #0;
          ch := ReadKey;        { Get one }
          st := st + ch;        { Build String }
        end;
        St1 := copy(St,6,2);    { Pick off subString having number in ASCII}
        Val(St1,x,i);           { Make it numeric }
        WhereX := x;            { Return the number }
    end;

  Function WhereY : Byte;       { ANSI replacement For Crt.WhereY }
    Var                         { Cursor position report.  This is row or }
      ch  : Char;               { Y axis report.}
      st  : String;
      st1 : String[2];
      y   : Byte;
      i   : Integer;

    begin
      Write(#27'[6n');          { Ansi String to get X-Y position }
      st := '';                 { We will only use Y here }
      ch := #0;                 { Make sure Character is not 'R' }
      While ch <> 'R' do        { Return will be }
        begin                   { Esc - [ - Ypos - ; - Xpos - R }
          ch := #0;
          ch := ReadKey;        { Get one }
          st := st + ch;        { Build String }
        end;
        St1 := copy(St,3,2);    { Pick off subString having number in ASCII}
        Val(St1,y,i);           { Make it numeric }
        WhereY := y;            { Return the number }
    end;


    Procedure GotoXY(x : Byte ; y : Byte); { ANSI replacement For Crt.GoToXY}
      begin
        if (x < 1) or (y < 1) then Exit;
        if (x > 80) or (y > 25) then Exit;
        Write(#27'[',y,';',x,'H');
      end;

   Procedure TextBackGround(Color:Byte);
    begin
     Case color of
          0: begin      Write(#27#91#52#48#109); end;
          1: begin      Write(#27#91#52#52#109); end;
          2: begin      Write(#27#91#52#50#109); end;
          3: begin      Write(#27#91#52#54#109); end;
          4: begin      Write(#27#91#52#49#109); end;
          5: begin      Write(#27#91#52#53#109); end;
          6: begin      Write(#27#91#52#51#109); end;
          6: begin      Write(#27#91#52#55#109); end;
     end;
   end;

   Procedure TextColor(Color:Byte);
     begin
      Case color of
         0: begin  Write(#27#91#51#48#109); end;
         1: begin  Write(#27#91#51#52#109); end;
         2: begin  Write(#27#91#51#50#109); end;
         3: begin  Write(#27#91#51#54#109); end;
         4: begin  Write(#27#91#51#49#109); end;
         5: begin  Write(#27#91#51#53#109); end;
         6: begin  Write(#27#91#51#51#109); end;
         7: begin  Write(#27#91#51#55#109); end;
         8: begin  Write(#27#91#49#59#51#48#109); end;
         9: begin  Write(#27#91#49#59#51#52#109); end;
        10: begin  Write(#27#91#49#59#51#50#109); end;
        11: begin  Write(#27#91#49#59#51#54#109); end;
        12: begin  Write(#27#91#49#59#51#49#109); end;
        13: begin  Write(#27#91#49#59#51#53#109); end;
        14: begin  Write(#27#91#49#59#51#51#109); end;
        15: begin  Write(#27#91#49#59#51#55#109); end;
       128: begin  Write(#27#91#53#109); end;
      end;
     end;

 Procedure NormVideo;
      begin
        Write(#27#91#48#109);
      end;

end.

Détecter si ANSI.SYS est installé

[haut]

auteur : Equipe SWAG

The following Functions provide a way to determine if the machine the your application is running on has ANSI installed.

If your Program is written using the Crt Unit the Function may return the result as False even if ANSI is present, unless you successfully use a 'work around' method to ensure all Writes go through Dos.

I find it's easier just to not use Crt if my Program is working With ANSI - since there is not much that you use the Crt Unit For that can't be done in some other way.

The Dos-based alternatives to ReadKey and KeyPressed are included since they are needed For the AnsiDetect Function.


Uses
  Dos;

Function KeyPressed : Boolean;
  { Detects whether a key is pressed. Key remains in kbd buffer}
Var
  r: Registers;
begin
  r.AH := $0B;
  MsDos(r);
  KeyPressed := (r.AL = $FF)
end;

Function ReadKey : Char;
Var
  r: Registers;
begin
  r.AH := $08;
  MsDos(r);
  ReadKey := Chr(r.AL)
end;

Function AnsiDetected: Boolean;
{ Detects whether ANSI is installed }
Var
  dummy: Char;
begin
  Write(#27'[6n');               { Ask For cursor position report via }
  if not KeyPressed              { the ANSI driver. }
  then
    AnsiDetected := False
  else
  begin
    AnsiDetected := True;
    { empty the keyboard buffer }
    Repeat Dummy := ReadKey Until not KeyPressed
  end
end;

begin
end.

Lecture dans une image TheDraw

[haut]

auteur : Equipe SWAG


Procedure UNCRUNCH (Var Addr1,Addr2; BlkLen:Integer);

begin
  Inline (
    $1E/               {       PUSH    DS             ;Save data segment.}
    $C5/$B6/ADDR1/     {       LDS     SI,[BP+Addr1]  ;Source Address}
    $C4/$BE/ADDR2/     {       LES     DI,[BP+Addr2]  ;Destination Addr}
    $8B/$8E/BLKLEN/    {       MOV     CX,[BP+BlkLen] ;Length of block}
    $E3/$5B/           {       JCXZ    Done}
    $8B/$D7/           {       MOV     DX,DI          ;Save X coordinate For
later.}
    $33/$C0/           {       xor     AX,AX          ;Set Current attributes.}
    $FC/               {       CLD}
    $AC/               {LOOPA: LODSB                  ;Get next Character.}
    $3C/$20/           {       CMP     AL,32          ;if a control Character,
jump.}
    $72/$05/           {       JC      ForeGround}
    $AB/               {       StoSW                  ;Save letter on screen.}
    $E2/$F8/           {Next:  LOOP    LOOPA}
    $EB/$4C/           {       JMP     Short Done}
                       {ForeGround:}
    $3C/$10/           {       CMP     AL,16          ;if less than 16, then
change the}
    $73/$07/           {       JNC     BackGround     ;Foreground color.
otherwise jump.}
    $80/$E4/$F0/       {       and     AH,0F0H        ;Strip off old
Foreground.}
    $0A/$E0/           {       or      AH,AL}
    $EB/$F1/           {       JMP     Next}
                       {BackGround:}
    $3C/$18/           {       CMP     AL,24          ;if less than 24, then
change the}
    $74/$13/           {       JZ      NextLine       ;background color.  if
exactly 24,}
    $73/$19/           {       JNC     FlashBittoggle ;then jump down to next
line.}
    $2C/$10/           {       SUB     AL,16          ;otherwise jump to
multiple output}
    $02/$C0/           {       ADD     AL,AL          ;routines.}
    $02/$C0/           {       ADD     AL,AL}
    $02/$C0/           {       ADD     AL,AL}
    $02/$C0/           {       ADD     AL,AL}
    $80/$E4/$8F/       {       and     AH,8FH         ;Strip off old
background.}
    $0A/$E0/           {       or      AH,AL}
    $EB/$DA/           {       JMP     Next}
                       {NextLine:}
    $81/$C2/$A0/$00/   {       ADD     DX,160         ;if equal to 24,}
    $8B/$FA/           {       MOV     DI,DX          ;then jump down to}
    $EB/$D2/           {       JMP     Next           ;the next line.}
                       {FlashBittoggle:}
    $3C/$1B/           {       CMP     AL,27          ;Does user want to toggle
the blink}
    $72/$07/           {       JC      MultiOutput    ;attribute?}
    $75/$CC/           {       JNZ     Next}
    $80/$F4/$80/       {       xor     AH,128         ;Done.}
    $EB/$C7/           {       JMP     Next}
                       {MultiOutput:}
    $3C/$19/           {       CMP     AL,25          ;Set Z flag if
multi-space output.}
    $8B/$D9/           {       MOV     BX,CX          ;Save main counter.}
    $AC/               {       LODSB                  ;Get count of number of
times}
    $8A/$C8/           {       MOV     CL,AL          ;to display Character.}
    $B0/$20/           {       MOV     AL,32}
    $74/$02/           {       JZ      StartOutput    ;Jump here if displaying
spaces.}
    $AC/               {       LODSB                  ;otherwise get Character
to use.}
    $4B/               {       DEC     BX             ;Adjust main counter.}
                       {StartOutput:}
    $32/$ED/           {       xor     CH,CH}
    $41/               {       inC     CX}
    $F3/$AB/           {       REP StoSW}
    $8B/$CB/           {       MOV     CX,BX}
    $49/               {       DEC     CX             ;Adjust main counter.}
    $E0/$AA/           {       LOOPNZ  LOOPA          ;Loop if anything else to
do...}
    $1F);              {Done:  POP     DS             ;Restore data segment.}
end; {UNCRUNCH}

Affichage d'images TheDraw

[haut]

auteur : Equipe SWAG

If you save as Pascal, and follow the instructions in the manual For TheDraw everything will work fine. It is also much more efficient then using normal ANSI-Files, since TheDraw-Pascal Files can be Compressed...


Var
  VideoSeg : Word;

Procedure VisTheDrawImage(x, y, Depth, Width: Byte; Var Picture);
Var
  c       : Byte;
  scrpos  : Word;
begin
  Dec(y);
  Dec(x);
  ScrPos := y * (ScrCol Shl 1) + x * 2;
  For c := 0 to Depth-1 Do
    Move(Mem[Seg(Picture) : ofs(Picture) + c * (Width Shl 1)],
         Mem[VideoSeg : c * (ScrCol Shl 1) + ScrPos], Width Shl 1);
end;

If your picture is not crunched you can use this routine to show them With VideoSeg has to be $B000 or $B800, then use the Vars from the generated picture and insert when you call that procedure.

Comment importer et afficher un fichier TheDraw ?

[haut]

auteur : Equipe SWAG

Save the Files into Bin Format, then run BinOBJ on them. When you select a public name, remember that this will be the Procedure's name.
After that Write :


Procedure <public name>; External; {$L <objname>}

Walkthrough example :
- Saved File : Welcom.Bin


BinOBJ WELCOME WELCOME WELCOMESCREEN

In Pascal :


Procedure WelcomeScreen; External; {$L WELCOME.OBJ}

In order to display, dump the Procedure to b800:0 -


Move(@WelcomeScreen,Mem[$B800:0],4000];

4000 is the size For 80x25. The size is x*y*2.


Var
  VideoSeg : Word;

Procedure VisTheDrawImage(x, y, Depth, Width: Byte; Var Picture);
Var
  c       : Byte;
  scrpos  : Word;
begin
  Dec(y);
  Dec(x);
  ScrPos := y * (ScrCol Shl 1) + x * 2;
  For c := 0 to Depth-1 Do
    Move(Mem[Seg(Picture) : ofs(Picture) + c * (Width Shl 1)],
         Mem[VideoSeg : c * (ScrCol Shl 1) + ScrPos], Width Shl 1);
end;

If your picture is not crunched you can use this routine to show them With VideoSeg has to be $B000 or $B800, then use the Vars from the generated picture and insert when you call that procedure.

Comment utiliser TheDraw ?

[haut]

auteur : Equipe SWAG

Well, everyone is asking how to integrate a picture from TheDraw into your Pascal Program, so here is how to do it.
First start up TheDraw, and either Draw, or load your picture (pretty simple). Then select Save. When asked for a Save format, select (ObJect). For Save mode, select (Normal). For Memory model, select (Turbo Pascal v4+). For Reference identifier to use, type in the name that you wish to have the picture Procedure named, this will be explained later. Then, for the Filename, of course enter the Filename you wish to save it under.

Next, is the method to place The .OBJ image into your Program. Somewhere up in the declarations area (after the Var statements, and before your begin) place the following :

                 
{$L C:\PATH\PICTURE.OBJ}
Procedure ProcName; external;  {Change ProcName to the Reference Identifier
                                That you used when saving the picture}

Then, to call that picture, there is 1 of 2 ways. First of all, you can make another procedure immediatly after this one that goes as such :


Procedure DrawANSIScreen;
begin
  Move(Pointer(@ProcName)^,prt($B800,0)^,4000);
end;

Then all you have to do is call the procedure DrawANSIScreen to draw your picture. Or you can copy that line beginning With Move into your source code directly. Make sure to again replace the ProcName with your specified Reference Identifier. Make sure to give each picture a different identifier, I do not know what the outcome would be if you used the same one. Probably wouldn't even Compile. Also, I have not tried this with animation. Considering that this writes directly to screen, it probally won't work, or will be too fast For the human eye to follow. On top of this, I migh point out that since this IS a direct video access, the cursor WILL not move for it's last position when the screen is printed, so you can fill the Complete screen, and it will not scroll.

Hope that this has been helpful. It's very easy, and I pulled it direct from TheDraw docs. This is supposed to work with Pascal 6.0 and up only. To work with earlier Pascal versions, please read the docs. They entail the process completely (but not very understandibly <G>).

Displaying TheDraw images

[haut]

auteur : Equipe SWAG

Display TheDraw BIN file

[haut]

auteur : Equipe SWAG

Ansi Screens

[haut]

auteur : James Fielden

Detect if ANSI.SYS is present

[haut]

auteur : Steve Connet

Program SHOWANSI.PAS

[haut]

auteur : Guy McLoughlin

Combine ANSI Screens

[haut]

auteur : James Fielden

ANSI Music

[haut]

auteur : Jack Dybczak

auteur : Equipe SWAG

auteur : Maynard Philbrook

Detect ANSI.SYS

[haut]

auteur : Equipe SWAG

ANSI string scrolling

[haut]

auteur : Dave Lowe

ANSI Driver

[haut]

auteur : Stefan Xenos

auteur : Eric Miller

auteur : Robert Long

auteur : Greg Estabrooks

ANSI color strings

[haut]

auteur : Betabech Computing

Full ANSI output unit

[haut]

auteur : Gayle Davis

Complete ANSI output unit

[haut]

auteur : Greg Smith

Fast ANSI display unit

[haut]

auteur : Larry Hadley

ANSI file dump

[haut]

auteur : Erik Anderson

Pascal ANSI engine

[haut]

auteurs : Scott Earnest, Ben Kimball

Full ANSI unit

[haut]

auteurs : Gayle Davis, David Anderson

Use LVI color on BBS

[haut]

auteur : Tobin Fricke

auteur : Equipe SWAG

auteur : Robert Long

auteur : Ueli Rutishauser

ANSI in Turbo Vision

[haut]

auteur : Andrew Nowinski

ANSI viewer

[haut]

auteur : Jonathan Downes

ANSI screen bounce

[haut]

auteur : Aaron Schroeder

Local ANSI detect

[haut]

auteur : David Adamson

ANSI unit

[haut]

auteur : Nimrod Carmi

An ANSI viewer for Sauce

[haut]

auteur : Jonathan Downes

ANSI file scroller

[haut]

auteur : Jason Randall

Object-oriented ANSI unit

[haut]

auteur : Mike Phillips

Display ANSI files fast

[haut]

auteur : Brian Petersen

ANSI Input/Output

[haut]

auteur : Chad Moore

The fastest CD-Audio unit

[haut]

auteur : Yuval Melamed

Display ANSI char set

[haut]

auteur : Equipe SWAG

Consultez les autres F.A.Q's

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2010 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.