home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 05 / praxis / showpcx.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-02-14  |  3.3 KB  |  119 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    SHOWPCX.PAS                         *)
  3. (* ------------------------------------------------------ *)
  4. {$R-,S-,I-,D-,V-,B-,N-}
  5. PROGRAM ShowPCX;
  6.  
  7. USES Crt, Graph, PCXTools;
  8.  
  9. VAR
  10.   Header      : PCX_HEADER;
  11.   screen, col : BYTE;
  12.   s           : STRING;
  13.  
  14.   PROCEDURE EncodePCX(VAR Header : PCX_HEADER;
  15.                           name : STRING);
  16.   VAR
  17.     F    : FILE;
  18.     I, J : INTEGER;
  19.     l    : WORD;
  20.     n, w : BYTE;
  21.     P    : POINTER;
  22.   BEGIN
  23.     Assign(F, name);
  24.     Reset(F, 1);
  25.     Seek(f, 128);
  26.     SetEgaReg(5, 0);
  27.     SetEgaReg(1, 0);
  28.     FOR L := 0 TO Header.ymax-Header.ymin DO BEGIN
  29.       FOR J := 0 TO Header.Planes-1 DO BEGIN
  30.         FOR I:= 0 TO Header.BytePerLine-1 DO BEGIN
  31.           z[J]^[I] := GetPCXByte(F);
  32.         END;
  33.       END;
  34.       CASE screen OF
  35.         0 : BEGIN     { alle Planes anzeigen  }
  36.               P := Ptr($A000, L*80);
  37.               FOR J := 0 TO Header.Planes-1 DO BEGIN
  38.                 SetWritePlane(J);
  39.                 Move(Z[J]^, P^, 80);
  40.               END;
  41.             END;
  42.         1 : BEGIN   { nur das erste Plane wird geschrieben }
  43.               P := Ptr($B800, WORD((L AND 3) SHL 13 + 90 *
  44.                                                 (L SHR 2)));
  45.               Move(Z[0]^, P^, 80);
  46.             END;
  47.         2 : BEGIN   { nur das erste Plane wird geschrieben }
  48.               P := Ptr($B800, WORD((L AND 1) SHL 13 + 80 *
  49.                                                 (L SHR 1)));
  50.               Move(Z[0]^, P^, 80);
  51.             END;
  52.       END;
  53.     END;
  54.     Close(F);
  55.     SetWritePlane($F);
  56.   END;
  57.  
  58.   VAR
  59.     ch     : CHAR;
  60.     gm, gd : INTEGER;
  61.     name   : STRING;
  62.  
  63. {$F+}
  64.   PROCEDURE ExitProc;
  65.   VAR
  66.     I : INTEGER;
  67.   BEGIN
  68.     FOR I := 0 TO Header.planes-1 DO
  69.       FreeMem(z[I], Header.BytePerLine);
  70.   END;
  71. {$F-}
  72.  
  73. BEGIN
  74.   DetectGraph(gd, gm);
  75.   CASE gd OF
  76.    3,4,5,9 : Screen := 0;
  77.    7       : Screen := 1;
  78.    1,2     : Screen := 2;
  79.    ELSE    BEGIN
  80.              WriteLn('Ihre Grafikkarte wird nicht',
  81.              'unterstützt.');
  82.              Halt(0);
  83.            END;
  84.   END;
  85.   IF ParamCount >= 1 THEN name := ParamStr(1)
  86.                      ELSE Halt(0);
  87.   IF POS('.', name) = 0 THEN name := name + '.PCX';
  88.   gd := GetPCXHeader(Header, name);
  89.   IF gd <> 0 THEN BEGIN
  90.     WriteLn('Fehler beim Lesen der PCX-Datei');
  91.     Halt(0);
  92.   END;
  93.   IF (Header.Bits > 1) AND (gd <>1) AND (gd<>2) THEN BEGIN
  94.     WriteLn(name, ' ist vermutlich eine CGA-PCX-Datei,');
  95.     WriteLn('die ich nur auf einem',
  96.             'CGA-Bildschirm anzeigen kann.');
  97.     Halt(0);
  98.   END;
  99.   IF (Header.Bits = 1) AND ((gd =1) OR (gd=2)) THEN BEGIN
  100.     WriteLn(name, ' ist vermutlich eine',
  101.                   'EGA/VGA/Hercules-PCX-Datei,');
  102.     WriteLn('die ich nur auf diesen',
  103.             'Bildschirmen anzeigen kann.');
  104.     Halt(0);
  105.   END;
  106.   FOR gd := 0 TO Header.planes DO
  107.     GetMem(z[gd], Header.BytePerLine);
  108.   gd := Detect;
  109.   InitGraph(gd, gm, '');
  110.   IF GraphResult <> 0 THEN BEGIN
  111.     WriteLn('Fehler beim Umschalten in die Grafik');
  112.     Halt(0);
  113.   END;
  114.   EncodePCX(Header, name);
  115.   REPEAT UNTIL KeyPressed;
  116.   CloseGraph;
  117. END.
  118. (* ------------------------------------------------------ *)
  119. (*                Ende von SHOWPCX.PAS                    *)