home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / pasgraph / pcx1.pas < prev    next >
Pascal/Delphi Source File  |  1994-07-24  |  4KB  |  147 lines
  1. Uses Crt;
  2. { Sample program to display a 320x200x256 PCX in
  3.   mode 13h.  PCX source copied from MCGA07, a MCGA
  4.   graphics unit written by James Cook in his MCGA
  5.   programming tutorial on Quantum Leap BBS }
  6.  
  7. TYPE
  8.   TPalette = array[0..767] of Byte;
  9.   PalettePtr = ^TPalette;
  10. { PCX stuff }
  11.   PCXHeaderPtr=  ^PCXHeader;
  12.   PCXHeader   =  record
  13.                    Signature      :  Char;
  14.                    Version        :  Char;
  15.                    Encoding       :  Char;
  16.                    BitsPerPixel   :  Char;
  17.                    XMin,YMin,
  18.                    XMax,YMax      :  Integer;
  19.                    HRes,VRes      :  Integer;
  20.                    Palette        :  Array [0..47] of byte;
  21.                    Reserved       :  Char;
  22.                    Planes         :  Char;
  23.                    BytesPerLine   :  Integer;
  24.                    PaletteType    :  Integer;
  25.                    Filler         :  Array [0..57] of byte;
  26.                  end;
  27.  
  28. Procedure ExtractLineASM (BytesWide:Integer;Var Source,Dest:Pointer);
  29. var
  30.   DestSeg,
  31.   DestOfs,
  32.   SourceSeg,
  33.   SourceOfs   :  Word;
  34. begin
  35.   SourceSeg := Seg (Source^);
  36.   SourceOfs := Ofs (Source^);
  37.   DestSeg   := Seg (Dest^);
  38.   DestOfs   := Ofs (Dest^);
  39.  
  40.   asm
  41.     push  ds
  42.     push  si
  43.  
  44.     cld
  45.  
  46.     mov   ax,DestSeg
  47.     mov   es,ax
  48.     mov   di,DestOfs     { es:di -> destination pointer }
  49.     mov   ax,SourceSeg
  50.     mov   ds,ax
  51.     mov   si,SourceOfs   { ds:si -> source buffer }
  52.  
  53.     mov   bx,di
  54.     add   bx,BytesWide   { bx holds position to stop for this row }
  55.     xor   cx,cx
  56.  
  57.   @@GetNextByte:
  58.     cmp   bx,di          { are we done with the line }
  59.     jbe   @@ExitHere
  60.  
  61.     lodsb                { al contains next byte }
  62.  
  63.     mov   ah,al
  64.     and   ah,0C0h
  65.     cmp   ah,0C0h
  66.  
  67.     jne    @@SingleByte
  68.                          { must be a run of bytes }
  69.     mov   cl,al
  70.     and   cl,3Fh
  71.     lodsb
  72.     rep   stosb
  73.     jmp   @@GetNextByte
  74.  
  75.   @@SingleByte:
  76.     stosb
  77.     jmp   @@GetNextByte
  78.  
  79.   @@ExitHere:
  80.     mov   SourceSeg,ds
  81.     mov   SourceOfs,si
  82.     mov   DestSeg,es
  83.     mov   DestOfs,di
  84.  
  85.     pop   si
  86.     pop   ds
  87.   end;
  88.  
  89.   Source := Ptr (SourceSeg,SourceOfs);
  90.   Dest   := Ptr (DestSeg,DestOfs);
  91. end;
  92.  
  93. Procedure DisplayPCX (X,Y:Integer;Buf:Pointer);
  94. var
  95.   I,NumRows,
  96.   BytesWide   :  Integer;
  97.   Header      :  PCXHeaderPtr;
  98.   DestPtr     :  Pointer;
  99.   Offset      :  Word;
  100.  
  101.  
  102. begin
  103.   Header    := Ptr (Seg(Buf^),Ofs(Buf^));
  104.   Buf       := Ptr (Seg(Buf^),Ofs(Buf^)+128);
  105.   Offset    := Y * 320 + X;
  106.   NumRows   := Header^.YMax - Header^.YMin + 1;
  107.   BytesWide := Header^.XMax - Header^.XMin + 1;
  108.   If Odd (BytesWide) then Inc (BytesWide);
  109.  
  110.   For I := 1 to NumRows do begin
  111.     DestPtr := Ptr ($A000,Offset);
  112.     ExtractLineASM (BytesWide,Buf,DestPtr);
  113.     Inc (Offset,320);
  114.     end;
  115. end;
  116. { end PCX stuff }
  117.  
  118. Procedure Graph13h; assembler;
  119. asm
  120.   mov al,$13
  121.   mov ah,0
  122.   int 10h
  123. end;
  124.  
  125. VAR
  126.   F: File;           { PCX file }
  127.   Hdr: PCXHeaderPtr; { PCX header structure & file }
  128.   Pal: PalettePtr;   { PCX palette }
  129.   Shade, Size: Word; { RGB shade, file size }
  130.  
  131. BEGIN
  132.   Graph13h;                          { set mode 13h }
  133.   Assign(F, 'filename.pcx');         { open PCX file }
  134.   Reset(F,1);
  135.   Size := FileSize(F);
  136.   GetMem(Hdr, Size);                 { load PCX into memory }
  137.   Blockread(F, Hdr^, Size);
  138.   Close(F);
  139.   Pal := Ptr( Seg(Hdr^), Ofs(Hdr^) + Size - 768);    { get palette location }
  140.   Port[968] := 0;                                    { set palette }
  141.   FOR Shade := 0 TO 767 DO
  142.     Port[969] := Pal^[Shade] SHR 2;
  143.   DisplayPCX(0, 0, Hdr);                             { decode PCX to screen }
  144.   WHILE Readkey <> #13 DO;                           { wait for return key }
  145.   TextMode(CO80);
  146. END.
  147.