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

    {
    Here you have the PCX source code. It works in 320x200 in 256 colors
    I still haven't study the SVGA modes.

    I hope it could serves you.

     JL> Thanks in advance.

    (In the other message i've send you the GIF routine (in two messages cos the
    extension)

    ==============Cut===============================Cut========================}

          PROGRAM GPCX;      {Por: Javier Perez Vigo 1994}
          USES Crt,graph,dos;
          TYPE
            PFich=^RFich;
            RFich=Record
              Size:Word;
              Octeto:Array[0..64999] of Byte;
              Sig:pFich;
            End;
          VAR
            BORRA:FILE;
            cadena:string[11];
            f: text;
           TECLA:BOOLEAN;
           largo:integer;
           muu:Longint;
           ch:char;
           Fich:File;
           i,j,k:Integer;
           a,b,c:Byte;
           X,Y:Integer;
           GD,GM,a14:Integer;
           a17:LongInt;
           s,F1:String;
           Primero,Actual,Siguiente:PFich;
           Count:Word;
           Pall:Array[0..767] of Byte;
           Reg:Registers;
           {$F+}

           Procedure Inicia;assembler;
            asm
            mov ax,$13
            int $10
            end;

          FUNCTION EXISTE_ARCH(Nombre:STRING):BOOLEAN;
             VAR
               F:FILE;
               OK:BOOLEAN;
             BEGIN            { Existe_Arch }
               Assign (f,Nombre);
               {$I-}
               Reset(f);
               {$I+}
               OK:=IOresult=0;
               If Not OK then
                  Existe_Arch:=False
                else
                  begin
                    close(f);
                    existe_Arch:=True;
                  end;        { else }
             END;             { Existe_Arch }

           FUNCTION DetectVga256:integer;
            begin
            DetectVGA256:=1;
            end;
           {$F-}

           PROCEDURE no_tecla;
            var
              cabeza_Tampon:integer absolute $0000:$041A;{cabeza actual}
              cola_Tampon:integer absolute $0000:$041C;{cola actual}
            begin
               cola_Tampon:=cabeza_Tampon;
            end;

           BEGIN {Bloque principal}
            clrscr;
            wRITELn('   Utilidad de ficheros PCX');
            F1:=ParamStr(1);
           If Pos('.',F1)<1 THEN
           F1:=F1+'.pcx';
            Largo:=LENGTH(Paramstr(1));
            if largo=0 then
             begin
              Textcolor(red);
              writeLn('Escriba nombre de fichero');
              TextColor(white);
              textcolor(white);
              writeLN;
              halt(2)
             end;
           if not(existe_arch(f1)) then
             BEGIN
               TextColor(RED);
               WriteLn('  No existe el fichero ORIGEN ! ');
               TextColor(WHITE);
               writeLn;
               Halt(3);
             END
          else
          begin
           INICIA;
           gm:=0;
           gd:=1;
           initgraph(gd,gm,'c:\tp\bgi'); {the directory where the Unit is}
           x:=0;y:=0;
           Assign(Fich,F1);
           Reset(Fich,1);
           New(Actual);

           Primero:=Actual;
           BlockRead(Fich,Actual^.Octeto,65000,Actual^.Size);
           While not EOF(Fich) do
            Begin
             New(Siguiente);
             Actual^.sig:=Siguiente;
             Actual:=Siguiente;
             BlockRead(Fich,Actual^.Octeto,65000,Actual^.Size);
            End;
           Actual^.Sig:=Nil;
           Close(Fich);
           For i:=0 to 255 do
            Begin
             SetPalette(i,i);
             Pall[3*i]:=Actual^.Octeto[Actual^.Size-768+3*i] div 4;
            Pall[3*i+1]:=Actual^.Octeto[Actual^.Size-767+3*i] div 4;
            Pall[3*i+2]:=Actual^.Octeto[Actual^.Size-766+3*i] div 4;

            end;
           reg.ax:=$1012;
           reg.bx:=$00;
           reg.cx:=$100;
           reg.es:=seg(pall);
           reg.dx:=ofs(pall);
           Intr($10,reg);
           Count:=128;
           Actual:=Primero;
           j:=0;
          REPEAT
          a:=Actual^.Octeto[Count];
          Inc(Count);
          if Count>Actual^.Size then
           BEGIN
             Actual:=Actual^.Sig;
             Count:=0;
           END;
          If a>192 then
          BEGIN
            b:=a-192;
            a:=Actual^.Octeto[Count];
            Inc(Count);
            If Count>Actual^.Size then
            BEGIN
              Actual:=Actual^.Sig;
              Count:=0;
            End;
          END
           else
            b:=1;
           While b<>0 do
           begin
             dec(b);
             if a<>0 then
               mem[$A000:320*Y+X]:=a;
             Inc(X);
             If X>319 then
              begin
                x:=0;
                Inc(y);
              end;
            end;
         Until(Actual^.sig=NIL) and (Actual^.size<768+count);
             muu:=0;
             repeat
                NO_TECLA;
                TECLA:=KEYPRESSED;
                muu:=muu+1;
             until (muu=150000) or TECLA;

           begin
              textmode(c80);
              Halt(4);
            end;
        end;
      end.

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