home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / pcx / pcx_unit / pcxunit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1990-08-08  |  4.9 KB  |  148 lines
  1. UNIT PCXUNIT;
  2.  
  3. {Diese Unit stellt eine Moeglichkeit dar, EGA-Hires Bilder
  4. zu laden und darzustellen. Sie kann jederzeit um weitere,
  5. nicht vorhandene Laderoutine für Bilder eines anderen
  6. Formates als des hier verwendeten PC-Paintbrush-Formates
  7. erweitert werden.}
  8.  
  9. INTERFACE
  10. USES Crt, Graph, Dos;
  11.  
  12. VAR
  13.            p                  : Pointer;
  14.            f                  : FILE OF Byte;
  15.            nx                 : Char;
  16.            n                  : String;
  17.            fin,ny             : Boolean;
  18.            a,co,k,x,y,c,r,l,d : Integer;
  19.            b,xx1,yy1,xx,yy    : Integer;
  20.            bx1,bx2,by1,by2    : Byte;
  21.            s                  : Byte;
  22.            Color              : ARRAY[0..640,0..4] OF Boolean;
  23.  
  24. PROCEDURE LOADPIC;
  25.  
  26. IMPLEMENTATION
  27.  
  28.  
  29. PROCEDURE LOADPIC;
  30.  
  31. {Prozedur zum Laden von PC-Paintbrush-Bildern}
  32. {--------------------------------------------}
  33.  
  34. BEGIN;
  35.   Assign(f,n);         {Dateiname "n" wird vom Hauptprogramm}
  36.   Reset(f);            {uebergeben                           }
  37.   FOR a:=1 TO 4 DO     {Die ersten 4 Byte ueberspringen}
  38.   Read(f,s);
  39.   Read(f,bx1);
  40.   Read(f,bx2);
  41.   Read(f,by1);
  42.   Read(f,by2);
  43.   xx1:=bx1+bx2*256;
  44.   yy1:=by1+by2*256;
  45.   Read(f,bx1);
  46.   Read(f,bx2);
  47.   Read(f,by1);
  48.   Read(f,by2);
  49.   xx:=(bx1+(bx2*256))-xx1;  {Berechnung der Groesse des}
  50.   yy:=(by1+(by2*256))-yy1;  {Bildes}
  51.   Reset(f);
  52.   FOR a:=1 TO 128 DO      {Die ersten 128 Byte ueberspringen}
  53.   Read(f,s);
  54.   fin:=EoF(f);
  55.   ClearDevice;
  56.   co:=Blue;
  57.   FOR k:=0 TO xx DO BEGIN;
  58.     FOR l:=1 TO 4 DO Color[k,l]:=FALSE;
  59.   END;
  60.   x:=0; y:=0; c:=1; r:=0;
  61.   REPEAT;
  62.     d:=1;
  63.     Read(f,s);
  64.     fin:=EoF(f);
  65.     IF (s AND 192)=192 THEN BEGIN;
  66.                         { Zaehler vorhanden }
  67.                         d:=(s XOR 192);
  68.                         Read(f,s);
  69.                         fin:=EoF(f);
  70.                        END;
  71.     FOR b:=1 TO d DO BEGIN;
  72.       IF (s AND 128)=0 THEN Color[x,co]:=TRUE;
  73.       IF (s AND  64)=0 THEN Color[x+1,co]:=TRUE;
  74.       IF (s AND  32)=0 THEN Color[x+2,co]:=TRUE;
  75.       IF (s AND  16)=0 THEN Color[x+3,co]:=TRUE;
  76.       IF (s AND   8)=0 THEN Color[x+4,co]:=TRUE;
  77.       IF (s AND   4)=0 THEN Color[x+5,co]:=TRUE;
  78.       IF (s AND   2)=0 THEN Color[x+6,co]:=TRUE;
  79.       IF (s AND   1)=0 THEN Color[x+7,co]:=TRUE;
  80.       x:=x+8;
  81.       IF x>=(xx) THEN BEGIN;
  82.         x:=0;
  83.         c:=c+1;
  84.         IF c>4 THEN BEGIN;  {CGA: IF C>2 ...}
  85.           c:=1;
  86.           FOR k:=0 TO xx DO BEGIN;
  87.             co:=15;
  88.  
  89.             {Die folgenden Abfragen bestimmen die Farben. Sie
  90.              koennen selbstverstaendlich nach eigenen Wuenschen
  91.              abgeaendert werden}
  92.  
  93. IF (Color[k,1]=TRUE) AND (Color[k,2]=TRUE) AND (Color[k,3]=TRUE) AND
  94.    (Color[k,4]=TRUE) THEN co:=0;
  95. IF (Color[k,1]=FALSE) AND (Color[k,2]=TRUE) AND (Color[k,3]=TRUE) AND
  96.    (Color[k,4]=TRUE) THEN co:=1;
  97. IF (Color[k,1]=FALSE) AND (Color[k,2]=TRUE) AND (Color[k,3]=TRUE) AND
  98.    (Color[k,4]=FALSE) THEN co:=9;
  99. IF (Color[k,1]=TRUE) AND (Color[k,2]=FALSE) AND (Color[k,3]=TRUE) AND
  100.    (Color[k,4]=TRUE) THEN co:=2;
  101. IF (Color[k,1]=TRUE) AND (Color[k,2]=FALSE) AND (Color[k,3]=TRUE) AND
  102.    (Color[k,4]=FALSE) THEN co:=10;
  103. IF (Color[k,1]=FALSE) AND (Color[k,2]=FALSE) AND (Color[k,3]=TRUE) AND
  104.    (Color[k,4]=TRUE) THEN co:=3;
  105. IF (Color[k,1]=FALSE) AND (Color[k,2]=FALSE) AND (Color[k,3]=TRUE) AND
  106.    (Color[k,4]=FALSE) THEN co:=11;
  107. IF (Color[k,1]=TRUE) AND (Color[k,2]=TRUE) AND (Color[k,3]=FALSE) AND
  108.    (Color[k,4]=TRUE) THEN co:=4;
  109. IF (Color[k,1]=TRUE) AND (Color[k,2]=TRUE) AND (Color[k,3]=FALSE) AND
  110.    (Color[k,4]=FALSE) THEN co:=12;
  111. {if (color[k,1]=false) and (color[k,2]=true) and (color[k,3]=true) and
  112.    (color[k,4]=true) then co:=5; }
  113. IF (Color[k,1]=FALSE) AND (Color[k,2]=TRUE) AND (Color[k,3]=FALSE) AND
  114.    (Color[k,4]=FALSE) THEN co:=13;
  115. IF (Color[k,1]=TRUE) AND (Color[k,2]=FALSE) AND (Color[k,3]=FALSE) AND
  116.    (Color[k,4]=TRUE) THEN co:=6;
  117. IF (Color[k,1]=TRUE) AND (Color[k,2]=FALSE) AND (Color[k,3]=FALSE) AND
  118.    (Color[k,4]=FALSE) THEN co:=14;
  119. IF (Color[k,1]=FALSE) AND (Color[k,2]=FALSE) AND (Color[k,3]=FALSE) AND
  120.    (Color[k,4]=TRUE) THEN co:=7;
  121. IF (Color[k,1]=TRUE) AND (Color[k,2]=TRUE) AND (Color[k,3]=TRUE) AND
  122.    (Color[k,4]=FALSE) THEN co:=8;
  123.             PutPixel(k,y,co);
  124.           END;  (* for k *)
  125.           y:=y+1;
  126.           FOR k:=0 TO xx DO BEGIN;
  127.               FOR l:=1 TO 4 DO Color[k,l]:=FALSE;
  128.           END; (* for k *)
  129.         END;   (* if c>4 *)
  130.       END;     (* if x>=(xx) *)
  131.       IF c=1 THEN co:=1;
  132.       IF c=2 THEN co:=2;
  133.       IF c=3 THEN co:=3;
  134.       IF c=4 THEN co:=4;
  135.     END; (* for b *)
  136.     nx:=' ';
  137.     IF KeyPressed=TRUE THEN BEGIN;
  138.                                 nx:=ReadKey;
  139.                                 IF nx=#59 THEN
  140.                                 ny:=TRUE;
  141.                             END;
  142.   UNTIL (fin=TRUE) OR (ny=TRUE);
  143.   Close(f);
  144. END;   (* proc LoadPic *)
  145.  
  146. BEGIN;  {Ende des Unit-Files}
  147. END.    (* Unit PCXUNIT *)
  148.