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

    program loadpcx;

    { only 256 colors pcx-images }
    { Svga256.bgi driver necessary }

    uses dos,crt,graph;

    const
      BufferLengte = $FFFE;
      Klaar    : boolean = false;

    type PcxType = Object
            Kenmerk, Versie: byte;
            Gecomprimeerd: boolean;
            BitsPerPixel: byte;
            Raam: Record Links, Boven, Rechts, Onder: word End;
            HorResolutie, VerResolutie: word;
            Kleuren: array[0..15] of Record Rood, Groen, Blauw: byte End;
            Reserve: byte;
            AantalVlakken: byte;
            AantalBytesPerLijn: word;
            PaletInformatie: word;
            ReserveArray: array[1..58] of byte;
          End;
          ArByte = array[0..$FFFE] of byte;

          RGBColor   = record R,G,B :byte; end;
          VGAPalette = array[0..255] of RGBColor;

    var
      Herhaal,Teller,m,
      xx,yy,MaxX,MaxY       :word;
      PCX                   :PCXType;
      Buffer,Lijnx          :^ArByte;
      PCX_Bestand           :File;
      BufSize               :word;
      Regs                  :Registers;
      Kleuren256            :array[0..255] of Record Rood,Groen,Blauw :byte End;
      PaletNr,ID            :byte;

    Procedure LeesBuffer;

    Begin
      Klaar := Klaar or EOF(PCX_Bestand);
      BlockRead(PCX_Bestand, Buffer^, SizeOf(Buffer^), BufSize)
    End;

    Procedure Lees256Kleuren;

    Begin
      Seek(PCX_Bestand, FileSize(PCX_Bestand) - 769);
      ID := 0;
      BlockRead(PCX_Bestand, ID, 1);
      If ID = 12 then With Regs do Begin
        BlockRead(PCX_Bestand, Kleuren256, 768);
        For PaletNr := 0 to 255 do With Kleuren256[PaletNr] do Begin
          Rood := Rood shr 2; Groen := Groen shr 2; Blauw := Blauw shr 2
        End;
        AX := $1012;
        BX := 0;
        CX := 256;
        ES := Seg(Kleuren256);
        DX := Ofs(Kleuren256);
        Intr($10, Regs)
      end;
      seek(PCX_Bestand, SizeOf(PCX))
    end;

    Procedure Increment;

    Begin
      If Teller < BufferLengte then Inc(Teller)
      else Begin
        Teller := 0;
        LeesBuffer;
      End;
    End;

    procedure load_pcx(posx,posy,breedte,hoogte :word;pcxnaam :string);

    begin
      MaxX :=(breedte+posx)-1; MaxY :=(hoogte+posy)-1;
      Assign(PCX_Bestand,pcxnaam +'.pcx');
      {$I-} Reset(PCX_Bestand, 1); {$I+}
      if ioresult =0 then Begin
        BlockRead(PCX_Bestand, PCX, SizeOf(PCX));
        GetMem(Buffer,BufferLengte);
        Lees256Kleuren;
        xx :=posx;yy :=posy;Teller :=0;
        LeesBuffer;
        While not Klaar do Begin
          If Buffer^[Teller] and $C0 = $C0 then Begin
            Herhaal := Buffer^[Teller] - $C0;
            Increment;
          End
          else Herhaal := 1;
          For m := 1 to Herhaal do Begin
            If xx <= MaxX then PutPixel(xx, yy, Buffer^[Teller]);
            Inc(xx);
          End;
          If xx >= pcx.AantalBytesPerLijn +posx then Begin
            xx := posx; Inc(yy);
            If yy > MaxY then Klaar := true;
          End;
          Increment;
        end;
        freemem(buffer,bufferlengte);
        close(pcx_bestand);
        klaar :=false;
      end;
    end;

    procedure Setvideo(scherm :byte);

    var  AutoDetect : pointer;  GrMd,GrDr  : integer;

    {$F+}
    function DetectVGA0 : Integer;
    begin detectvga0 :=0;end;
    function DetectVGA1 : Integer;
    begin detectvga1 :=1;end;
    function DetectVGA2 : Integer;
    begin detectvga2 :=2;end;
    function DetectVGA3 : Integer;
    begin detectvga3 :=3;end;
    function DetectVGA4 : Integer;
    begin detectvga4 :=4;end;
    {$F-}

    begin
      AutoDetect := @DetectVGA2;
      case scherm of
        0:AutoDetect := @DetectVGA0;
        1:AutoDetect := @DetectVGA1;
        2:AutoDetect := @DetectVGA2;
        3:AutoDetect := @DetectVGA3;
        4:AutoDetect := @DetectVGA4;
      end;
      GrDr := InstallUserDriver('SVGA256',AutoDetect);
      GrDr := Detect;
      InitGraph(GrDr,GrMd,'');
    end;

    begin
      setvideo(2);
      setcolor(15);
      settextstyle(0,0,2);
      outtextxy(140,60,'GROETEN UIT DOETINCHEM');
      setcolor(2);
      outtextxy(141,61,'GROETEN UIT DOETINCHEM');
      load_pcx(120,100,192,128,'demo1');  { 192 is width / 128 is height image }
      load_pcx(320,100,192,128,'demo2');
      load_pcx(120,240,192,128,'demo3');
      load_pcx(320,240,192,128,'demo4');
      readln;
      closegraph;
      halt;
    end.

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