home *** CD-ROM | disk | FTP | other *** search
/ Graphics 16,000 / graphics-16000.iso / msdos / viewers / shwpcx10 / showpcx.pas < prev    next >
Pascal/Delphi Source File  |  1991-12-29  |  28KB  |  810 lines
  1. Program showpcx;
  2. { Free Software by TapirSoft Gisbert W.Selke, Dec 1991                       }
  3. {$A+,B-,D+,E+,F-,I-,L+,N-,O-,V- }
  4. {$M 65520,0,128000 }
  5.  
  6. {$UNDEF DEBUG }     { DEFINE while debugging }
  7.  
  8. {$IFDEF DEBUG }
  9. {$R+,S+ }
  10. {$ELSE }
  11. {$R-,S- }
  12. {$ENDIF }
  13.  
  14.   Uses Graph, CRT, Dos;
  15.  
  16.   Const progname = 'ShowPCX';
  17.         version  = '1.0';
  18.         copyright= 'Free Software by TapirSoft Gisbert W.Selke, Dec 1991';
  19.  
  20.         bufsize  = 60000;
  21.         maxlinlen= 2048; { maximum length of screen line }
  22.         Tab      = #9;
  23.         finishset: Set Of char = [#3,#27,'q','Q'];
  24.  
  25.   Type headrec = Record
  26.                    id           : byte;  { must be $0A }
  27.                    version      : byte;  { 0, 2, 3, or 5 }
  28.                    compr        : byte;  { 1 if RLE-coded }
  29.                    bitsperpixel : byte;
  30.                    xmin         : word;
  31.                    ymin         : word;
  32.                    xmax         : word;
  33.                    ymax         : word;
  34.                    horidpi      : word; { horizontal resolution, dots per inch }
  35.                    vertdpi      : word; { vertical   resolution, dots per inch }
  36.                    colormap     : Array [0..15,0..2] Of byte;
  37.                    reserved     : byte;
  38.                    ncolplanes   : byte; { number of colour planes; max 4 }
  39.                    bytesperline : word; { must be even }
  40.                    greyscale    : word; { 1 if colour or b/w; 2 if greyscale }
  41.                    filler       : Array [1..58] Of byte;
  42.                  End;
  43.        buffer   = Array [1..bufsize ] Of byte;
  44.        linbuffer= Array [0..maxlinlen] Of byte;
  45.  
  46.   Var listf : text;
  47.       inbufptr : ^buffer;
  48.       sr : SearchRec;
  49.       saveexit : Pointer;
  50.       dir, picname : string;
  51.       grdriver, grmode : integer;
  52.       maxx, maxy, maxcolour, deltime : word;
  53.       parampt, xscale, yscale, videomode : byte;
  54.       zverbose, zxcentre, zycentre, zprop, zmono, zconj, zebra : boolean;
  55.       zquiet, zgraph, zlist, zfirst, zfinish, zfound, zrepeat : boolean;
  56.  
  57.   { Link in graphics drivers for EGA, VGA and Hercules: }
  58.   Procedure egavga_driver; External;
  59.   {$L EGAVGA.OBJ }
  60.   Procedure svga256_driver; External;
  61.   {$L SVGA256.OBJ }
  62.   Procedure herc_driver; External;
  63.   {$L HERC.OBJ }
  64.  
  65. {$F+} function DetectVGA256 : integer; {$F-}
  66. var
  67.   DetectedDriver : integer;
  68.   SuggestedMode  : integer;
  69. begin
  70.   DetectGraph(DetectedDriver, SuggestedMode);
  71.   DetectVGA256 := SuggestedMode;
  72.   if (DetectedDriver = VGA) or (DetectedDriver = MCGA) then
  73.     DetectVGA256 := 0        { Default video mode = 0 }
  74.   else
  75.     DetectVGA256 := grError; { Couldn't detect hardware }
  76. end; { DetectVGA256 }
  77.  
  78.   {$F+ } Procedure myexit; {$F- }
  79.   { exit procedure to clean things up                                        }
  80.     Var c : char;
  81.   Begin                                                             { myexit }
  82.     ExitProc := saveexit;
  83.     NoSound;
  84.     If zgraph Then
  85.     Begin
  86.       SetGraphMode(GetGraphMode);
  87.       CloseGraph;
  88.       zgraph := False;
  89.     End;
  90.     If Not zfound Then writeln('No matching PCX files found.');
  91.     While KeyPressed Do c := ReadKey;
  92.   End;                                                              { myexit }
  93.  
  94.   Procedure beep;
  95.   { emit a short beep                                                        }
  96.   Begin                                                               { beep }
  97.     If Not zquiet Then
  98.     Begin
  99.       Sound(440);
  100.       Delay(50);
  101.       NoSound;
  102.     End;
  103.   End;                                                                { beep }
  104.  
  105.   Procedure abort(msg : string; ierr : byte);
  106.   { show error message and die                                               }
  107.   Begin                                                              { abort }
  108.     If zgraph Then CloseGraph;
  109.     zgraph := False;
  110.     If msg <> '' Then writeln(progname,': ',msg);
  111.     Halt(ierr);
  112.   End;                                                               { abort }
  113.  
  114.   Procedure usage;
  115.   { show usage hints and die                                                 }
  116.   Begin                                                              { usage }
  117.     writeln;
  118.     writeln(progname,' ',version,': display PCX files on screen');
  119.     writeln(copyright);
  120.     writeln;
  121.     writeln('Usage: ',progname,'  [<options>] <filespec> [<filespec>...]');
  122.     writeln('       where <filespec> is the name of a PCX file, possibly ',
  123.             'containing');
  124.     writeln('             wildcard characters (default extension .PCX),');
  125.     writeln('       or "@", followed immediately by the name of a file ');
  126.     writeln('             containing names of PCX files.');
  127.     writeln('       Options: /c  : centre image');
  128.     writeln('                /cx : centre image horizontally');
  129.     writeln('                /cy : centre image vertically');
  130.     writeln('                /d<num>  : delay in milliseconds after each ',
  131.             'image');
  132.     writeln('                /e<num>  : extended VGA mode (use at your own ',
  133.             'risk!)');
  134.     writeln('                /h  : display help');
  135.     writeln('                /m  : force monochrome mode');
  136.     writeln('                /p  : use alternate packing strategy for scaling');
  137.     writeln('                /q  : quiet behaviour (don''t beep)');
  138.     writeln('                /r  : repeat indefinitely');
  139.     writeln('                /s<num>  : scale image by factor ',
  140.             '1/<num> (0 = autoscale)');
  141.     writeln('                /sx<num> : scale horizontally only');
  142.     writeln('                /sy<num> : scale vertically only');
  143.     writeln('                /v  : verbose image info');
  144.     writeln('                /z  : zebra monochrome mode');
  145.     zfound := True;
  146.     abort('',1);
  147.   End;                                                               { usage }
  148.  
  149.   Procedure strip(Var s : string);
  150.   { remove leading and trailing white space                                  }
  151.   Begin                                                              { strip }
  152.     While (s <> '') And (s[1] In [' ',Tab]) Do Delete(s,1,1);
  153.     While (s <> '') And (s[Length(s)] In [' ',Tab]) Do Delete(s,Length(s),1);
  154.   End;                                                               { strip }
  155.  
  156.   Function getnextname : string;
  157.   { get name of next file to display                                         }
  158.     Var temp, nam, ext : string;
  159.         doserr : integer;
  160.   Begin                                                        { getnextname }
  161.     sr.name := '';
  162.     doserr := 0;
  163.     If zfirst Then
  164.     Begin
  165.       temp := '';
  166.       While zlist And (temp = '') Do
  167.       Begin
  168.         If EoLn(listf) And (Not EoF(listf)) Then readln(listf);
  169.         If IOResult <> 0 Then;
  170.         If zlist And EoF(listf) Then
  171.         Begin
  172.           Close(listf);
  173.           Dispose(inbufptr);
  174.           zlist := False;
  175.         End;
  176.         If zlist Then read(listf,temp);
  177.         If IOResult <> 0 Then;
  178.         strip(temp);
  179.       End;
  180.       If temp = '' Then
  181.       Begin
  182.         While (temp = '') And (parampt <= ParamCount) Do
  183.         Begin
  184.           If (parampt = ParamCount) And zrepeat And zfound Then parampt := 0;
  185.           Inc(parampt);
  186.           If parampt <= ParamCount Then temp := ParamStr(parampt);
  187.           If temp[1] In ['-','/'] Then temp := '';
  188.         End;
  189.         If temp[1] = '@' Then
  190.         Begin
  191.           Assign(listf,Copy(temp,2,255));
  192.           Reset(listf);
  193.           If IOResult <> 0 Then;
  194.           New(inbufptr);
  195.           SetTextBuf(listf,inbufptr^);
  196.           zlist := True;
  197.           temp := getnextname;
  198.         End;
  199.       End;
  200.       If temp <> '' Then
  201.       Begin
  202.         FSplit(temp,dir,nam,ext);
  203.         If ext = '' Then ext := '.PCX';
  204.         temp := dir + nam + ext;
  205.         FindFirst(temp,ReadOnly+Hidden+SysFile+Archive,sr);
  206.         doserr := DosError;
  207.         If doserr = 0 Then zfound := True;
  208.         zfirst := False;
  209.       End
  210.       Else
  211.       Begin
  212.         dir := '';
  213.         sr.name := '';
  214.       End;
  215.     End
  216.     Else
  217.     Begin
  218.       FindNext(sr);
  219.       doserr := DosError;
  220.     End;
  221.     If doserr = 18 Then
  222.     Begin
  223.       zfirst := True;
  224.       getnextname := getnextname;
  225.     End
  226.       Else getnextname := dir + sr.name;
  227.   End;                                                         { getnextname }
  228.  
  229.   Procedure init;
  230.   { do all necessary initializations                                         }
  231.     Var temp : string;
  232.         l : integer;
  233.         i : byte;
  234.  
  235.     Function getnumber(str : string; min, max, default : word) : word;
  236.     { convert a string to a number, checling bounds                          }
  237.       Var num : longint;
  238.           ires : integer;
  239.     Begin                                                        { getnumber }
  240.       ires := 0;
  241.       {$R- }
  242.       If str = '' Then num := default
  243.                   Else Val(str,num,ires);
  244. {$IFDEF DEBUG }
  245.       {$R+ }
  246. {$ENDIF }
  247.       If ires <> 0 Then num := default;
  248.       If num < min Then num := min;
  249.       If num > max Then num := max;
  250.       getnumber := num;
  251.     End;                                                         { getnumber }
  252.  
  253.   Begin                                                               { init }
  254.     If RegisterBGIDriver(@egavga_driver) < 0 Then
  255.                    abort('Illegal EGA/VGA graphics driver information',2);
  256.     If RegisterBGIDriver(@herc_driver) < 0 Then
  257.                    abort('Illegal Hercules graphics driver information',2);
  258.     zgraph   := False;
  259.     saveexit := ExitProc;
  260.     ExitProc := @myexit;
  261.     zfirst   := True;
  262.     zfinish  := False;
  263.     zlist    := False;
  264.     zquiet   := False;
  265.     zverbose := False;
  266.     zrepeat  := False;
  267.     zmono    := False;
  268.     zconj    := False;
  269.     zebra    := False;
  270.     zxcentre := False;
  271.     zycentre := False;
  272.     zprop    := False;
  273.     deltime  := 65535;
  274.     xscale   := 255;
  275.     yscale   := 255;
  276.     zfound   := False;
  277.     parampt  := 0;
  278.     FileMode := 0;
  279.     If ParamCount = 0 Then usage;
  280.     grdriver := Detect;
  281.     grmode   := 0;
  282.     videomode:= 255;
  283.     InitGraph(grdriver,grmode,'');
  284.     If GraphResult <> 0 Then abort('Cannot find graphics driver',2);
  285.     zgraph   := True;
  286.     For i := 1 To ParamCount Do
  287.     Begin
  288.       temp := ParamStr(i);
  289.       If (temp[1] In ['-','/']) And (Length(temp) >= 2) Then
  290.       Begin
  291.         Case UpCase(temp[2]) Of
  292.           'C' : Begin { centering }
  293.                   If (Length(temp) >= 3) Then
  294.                   Begin
  295.                     Case UpCase(temp[3]) Of
  296.                       'X' : zxcentre := True;
  297.                       'Y' : zycentre := True;
  298.                     End;
  299.                   End
  300.                   Else
  301.                   Begin
  302.                     zxcentre := True;
  303.                     zycentre := True;
  304.                   End;
  305.                 End;
  306.           'E' : Begin { extended video mode }
  307.                   If (Length(temp) >= 3) Then videomode :=
  308.                                          getnumber(Copy(temp,3,255),0,255,0)
  309.                                          Else videomode := 10;
  310.                 End;
  311.           'D' : Begin { delay }
  312.                   If (Length(temp) >= 3) Then deltime :=
  313.                                          getnumber(Copy(temp,3,255),0,65534,10)
  314.                                          Else deltime := 10;
  315.                 End;
  316.           'H','?' : usage;
  317.           'M' : zmono := True;
  318.           { monochrome }
  319.           'P' : Begin { packing strategy (for scaling) }
  320.                   If (Length(temp) <= 2) Or (UpCase(temp[3]) = 'C') Then
  321.                                                                 zconj := True;
  322.                 End;
  323.           'Q' : zquiet  := True;
  324.           'R' : zrepeat := True;
  325.           'S' : Begin { scaling }
  326.                   If (Length(temp) >= 3) Then
  327.                   Begin
  328.                     Case UpCase(temp[3]) Of
  329.                       'X' : xscale := getnumber(Copy(temp,4,255),0,255,0);
  330.                       'Y' : yscale := getnumber(Copy(temp,4,255),0,255,0);
  331.                       Else Begin
  332.                              xscale := getnumber(Copy(temp,3,255),0,255,0);
  333.                              yscale := xscale;
  334.                              zprop  := True;
  335.                            End;
  336.                     End;
  337.                   End
  338.                   Else
  339.                   Begin
  340.                     xscale := 0;
  341.                     yscale := 0;
  342.                     zprop  := True;
  343.                   End;
  344.                 End;
  345.           'V' : zverbose := True;
  346.           'Z' : Begin { zebra monochrome }
  347.                   zmono := True;
  348.                   zebra := True;
  349.                 End;
  350.           Else usage;
  351.         End;
  352.       End;
  353.     End;
  354.     If (videomode <> 255) And (grdriver = VGA) Then
  355.     Begin
  356.       l := InstallUserDriver('SVGA256', @DetectVGA256);
  357.       If l > 0 Then
  358.       Begin
  359.         grdriver := l;
  360.         grmode := videomode;
  361.         CloseGraph;
  362.         If RegisterBGIDriver(@svga256_driver) < 0 Then
  363.                    abort('Illegal SuperVGA graphics driver information',2);
  364.         InitGraph(grdriver,grmode,'');
  365.       End;
  366.     End;
  367.     maxx     := GetMaxX;
  368.     maxy     := GetMaxY;
  369.     maxcolour:= GetMaxColor;
  370.     If maxx > maxlinlen Then abort('Screen too wide for internal buffer',2);
  371.   End;                                                                { init }
  372.  
  373.   Procedure showfile(nam : string);
  374.   { display the given PCX file                                               }
  375.  
  376.     Var picf : File;
  377.         header : headrec;
  378.         linbuf : linbuffer;
  379.         picbuf : buffer;
  380.         ltemp  : longint;
  381.         iread, x, y, x2, y2, j, thisbyte : word;
  382.         answer : char;
  383.         repeatct, b, b2, c, i, horisub, vertsub, horict, vertct : byte;
  384.         bitsperplane : byte;
  385.         zdecomp, zcompr : boolean;
  386.  
  387.     Procedure showheader;
  388.     { if in verbose mode, display info on PCX file                           }
  389.     Begin                                                       { showheader }
  390.       RestoreCRTMode;
  391.       ClrScr;
  392.       write('File: ',nam);
  393.       writeln(' (Size: ',FileSize(picf),')');
  394.       With header Do
  395.       Begin
  396.         write  ('Version: ',version:4,'; ');
  397.         Case compr Of
  398.           0 : writeln('Uncompressed');
  399.           1 : writeln('RLE-compressed');
  400.           Else writeln('Unknown compression method');
  401.         End;
  402.         write  ('Upper left corner: (',xmin:4,',',ymin:4,'); ');
  403.         writeln('lower right corner: (',xmax:4,',',ymax:4,')');
  404.         write  ('Resolution: horizontal: ',horidpi:4,' dpi; ');
  405.         writeln('vertical: ',vertdpi:4,' dpi');
  406.         write  ('Bits per pixel: ',bitsperpixel:4,'; ');
  407.         writeln('number of colour planes: ',ncolplanes:4);
  408.         write  ('Bytes per line: ',bytesperline:4,'; ');
  409.         If greyscale = 2 Then writeln('display as grey scales')
  410.                          Else writeln('display as colour rsp. b/w');
  411.       End;
  412.       write('Hit space bar to continue... ');
  413.       answer  := ReadKey;
  414.       zfinish := answer In FinishSet;
  415.       If Not zfinish Then answer := #0;
  416.       SetGraphMode(grmode);
  417.     End;                                                        { showheader }
  418.  
  419.     Function getnextbyte : byte;
  420.     { reads next byte from input file, handling compression                  }
  421.  
  422.       Procedure getnextchunk;
  423.       { get next chunk from input file                                       }
  424.       Begin                                                   { getnextchunk }
  425.         If EoF(picf) Then iread := 0
  426.         Else
  427.         Begin
  428.           BlockRead(picf,picbuf,SizeOf(picbuf),iread);
  429.           If IOResult <> 0 Then iread := 0;
  430.         End;
  431.         thisbyte := 0;
  432.       End;                                                    { getnextchunk }
  433.  
  434.     Begin                                                      { getnextbyte }
  435.       If Not zdecomp Then
  436.       Begin
  437.         If thisbyte >= iread Then getnextchunk;
  438.         If thisbyte < iread Then
  439.         Begin
  440.           Inc(thisbyte);
  441.           If zcompr And (picbuf[thisbyte] >= 192) Then
  442.           Begin
  443.             repeatct := picbuf[thisbyte] And $3F;
  444.             zdecomp := repeatct > 0;
  445.             If thisbyte >= iread Then getnextchunk;
  446.             Inc(thisbyte);
  447.           End;
  448.         End;
  449.       End;
  450.       If zdecomp Then
  451.       Begin
  452.         getnextbyte := picbuf[thisbyte];
  453.         Dec(repeatct);
  454.         zdecomp := repeatct > 0;
  455.       End
  456.       Else
  457.       Begin
  458.         If iread > 0 Then
  459.         Begin
  460.           getnextbyte := picbuf[thisbyte];
  461.         End
  462.           Else getnextbyte := 0;
  463.       End;
  464.     End;                                                       { getnextbyte }
  465.  
  466.     Procedure VGASetAllPalette(var P);
  467.     { set all colour registers of the VGA quickly; values are RGB, 0..63     }
  468.       Var regs : Registers;
  469.     Begin                                                 { VGASetAllPalette }
  470.       With regs Do
  471.       Begin
  472.         ax := $1012;
  473.         bx := 0;
  474.         cx := 256;
  475.         es := Seg(P);
  476.         dx := Ofs(P);
  477.       End;
  478.       Intr($10, regs);
  479.     End;                                                  { VGASetAllPalette }
  480.  
  481.   Begin                                                           { showfile }
  482.     ClearDevice;
  483.     Assign(picf,nam);
  484.     Reset(picf,1);
  485.     answer := #0;
  486.     If IOResult = 0 Then
  487.     Begin
  488.       BlockRead(picf,header,SizeOf(header),iread);
  489.       If iread <> SizeOf(header) Then abort('PCX file too short',3);
  490.     End;
  491.     If IOResult = 0 Then
  492.     Begin
  493.       If zverbose Then showheader;
  494.       With header Do
  495.       Begin
  496.         If id <> $0A Then abort('Illegal PCX header',3);
  497.         If Not (version In [0,2,3,5]) Then abort('Illegal PCX header',3);
  498.         If Not (compr In [0,1]) Then abort('Illegal PCX header',3);
  499.         If Not (ncolplanes In [0..4]) Then abort('Illegal PCX header',3);
  500.         If Odd(bytesperline) Then abort('Illegal PCX header',3);
  501.         If Not (greyscale In [1..2]) Then greyscale := 1;
  502.       End;
  503.     End;
  504.     With header Do
  505.     Begin
  506.       If ncolplanes = 0 Then ncolplanes := 1;
  507.       bitsperplane := bitsperpixel*ncolplanes;
  508.       i := grmode;
  509.       x := xmax - xmin + 1;
  510.       y := ymax - ymin + 1;
  511.       Case grdriver Of
  512.         CGA  : Begin
  513.                  If x <= 320 Then i := CGAC0
  514.                              Else i := CGAHi;
  515.                End;
  516.         MCGA, ATT400 : Begin
  517.                  If (x <= 320) And (y <= 200) Then i := MCGAC0
  518.                  Else
  519.                  Begin
  520.                    If y <= 200 Then i := MCGAMed
  521.                                Else i := MCGAHi;
  522.                  End;
  523.                End;
  524.         EGA, EGA64, EGAMono : Begin
  525.                  If y <= 200 Then i := EGALo
  526.                  Else
  527.                  Begin
  528.                    If grdriver = EGAMono Then i := EGAMonoHi
  529.                                          Else i := EGAHi;
  530.                  End;
  531.                End;
  532.         VGA  : Begin
  533.                  If y <= 200 Then i := VGALo
  534.                  Else
  535.                  Begin
  536.                    If y <= 350 Then i := VGAMed
  537.                                Else i := VGAHi;
  538.                  End;
  539.                End;
  540.       End;
  541.       If i <> grmode Then
  542.       Begin
  543.         SetGraphMode(i);
  544.         grmode    := GetGraphMode;
  545.         maxx      := GetMaxX;
  546.         maxy      := GetMaxY;
  547.         maxcolour := GetMaxColor;
  548.       End;
  549.       If (Not zmono) And (version In [2,5]) And
  550.          ((grdriver In [EGA,EGA64,VGA]) Or (videomode <> 255)) Then
  551.       Begin
  552.         Case bitsperplane Of
  553.           4 : Begin
  554.                 For i := 0 To 15 Do
  555.                   SetRGBPalette(i,colormap[i,0],colormap[i,1],colormap[i,2]);
  556.               End;
  557.           8 : Begin
  558.                 ltemp := FilePos(picf);
  559.                 Seek(picf,FileSize(picf)-768);
  560.                 BlockRead(picf,picbuf,768,x);
  561.                 Seek(picf,ltemp);
  562.                 If x = 768 Then
  563.                 Begin
  564.                   For y := 1 To 768 Do picbuf[y] := picbuf[y] ShR 2;
  565.                   VGASetAllPalette(picbuf);
  566.                 End;
  567.               End;
  568.         End;
  569.       End;
  570.       horisub := xscale;
  571.       If xscale = 255 Then horisub := 1;
  572.       If xscale = 0 Then
  573.       Begin
  574.         horisub := 1;
  575.         While ((xmax-xmin+horisub-1) Div horisub) > maxx+5 Do Inc(horisub);
  576.       End;
  577.       vertsub := yscale;
  578.       If yscale = 255 Then vertsub := 1;
  579.       If yscale = 0 Then
  580.       Begin
  581.         vertsub := 1;
  582.         While ((ymax-ymin+vertsub-1) Div vertsub) > maxy+5 Do Inc(vertsub);
  583.       End;
  584.       If zprop Then
  585.       Begin
  586.         If (horisub < vertsub) And (xscale = 0) Then horisub := vertsub;
  587.         If (vertsub < horisub) And (yscale = 0) Then vertsub := horisub;
  588.       End;
  589.       If zxcentre Then
  590.       Begin
  591.         x := (xmax-xmin+horisub-1) Div horisub;
  592.         If x < maxx Then
  593.         Begin
  594.           xmax := xmax - xmin + (maxx - x) Div 2;
  595.           xmin := (maxx - x) Div 2;
  596.         End;
  597.       End;
  598.       If zycentre Then
  599.       Begin
  600.         y := (ymax-ymin+vertsub-1) Div vertsub;
  601.         If y < maxy Then
  602.         Begin
  603.           ymax := ymax - ymin + (maxy - y) Div 2;
  604.           ymin := (maxy - y) Div 2;
  605.         End;
  606.       End;
  607.       zcompr := compr = 1;
  608.       thisbyte := Succ(iread);
  609.       zdecomp := False;
  610.       y  := ymin;
  611.       y2 := ymin;
  612.       vertct := 0;
  613.       While (y <= ymax) And (y2 <= maxy) And (Not KeyPressed) And
  614.                                              (Not zfinish) Do
  615.       Begin
  616.         If y2 < maxy Then
  617.         Begin
  618.           If y2-ymin <= maxx Then PutPixel(y2-ymin,maxy,maxcolour);
  619.         End
  620.         Else
  621.         Begin
  622.           SetColor(Black);
  623.           Line(0,maxy,maxx,maxy);
  624.         End;
  625.         Case bitsperplane Of
  626.           1 : Begin
  627.             x  := xmin;
  628.             x2 := xmin;
  629.             horict := 0;
  630.             If zconj Then b2 := $FF
  631.                      Else b2 := 0;
  632.             For j := 1 To bytesperline Do
  633.             Begin
  634.               b := getnextbyte;
  635.               If vertct = 0 Then
  636.               Begin
  637.                 For i := 1 To 8 Do
  638.                 Begin
  639.                   If (x <= xmax) And (x2 <= maxx) Then
  640.                   Begin
  641.                     If zconj Then b2 := b2 And b
  642.                              Else b2 := b2 Or  b;
  643.                     Inc(horict);
  644.                     If horict = horisub Then
  645.                     Begin
  646.                       If (b2 And $80) <> 0 Then PutPixel(x2,y2,maxcolour);
  647.                       If zconj Then b2 := $FF
  648.                                Else b2 := 0;
  649.                       Inc(x2);
  650.                       horict := 0;
  651.                     End;
  652.                     {$R- }
  653.                     b := b ShL 1;
  654. {$IFDEF DEBUG }
  655.                     {$R+ }
  656. {$ENDIF }
  657.                     Inc(x);
  658.                   End;
  659.                 End;
  660.               End;
  661.             End;
  662.           End;
  663.           2..7 : Begin
  664.             FillChar(linbuf,Succ(maxx),#0);
  665.             For c := 1 To ncolplanes Do
  666.             Begin
  667.               x  := xmin;
  668.               x2 := 0;
  669.               horict := 0;
  670.               If zconj Then b2 := $FF
  671.                        Else b2 := 0;
  672.               For j := 1 To bytesperline Do
  673.               Begin
  674.                 b := getnextbyte;
  675.                 If vertct = 0 Then
  676.                 Begin
  677.                   For i := 1 To 8 Do
  678.                   Begin
  679.                     If (x <= xmax) And (x2 <= maxx) Then
  680.                     Begin
  681.                       If zconj Then b2 := b2 And b
  682.                                Else b2 := b2 Or  b;
  683.                       Inc(horict);
  684.                       If horict = horisub Then
  685.                       Begin
  686.                         linbuf[x2] := linbuf[x2] ShL 1;
  687.                         If (b2 And $80) <> 0 Then Inc(linbuf[x2]);
  688.                         If zconj Then b2 := $FF
  689.                                  Else b2 := 0;
  690.                         Inc(x2);
  691.                         horict := 0;
  692.                       End;
  693.                       {$R- }
  694.                       b := b ShL 1;
  695. {$IFDEF DEBUG }
  696.                       {$R+ }
  697. {$ENDIF }
  698.                       Inc(x);
  699.                     End;
  700.                   End;
  701.                 End;
  702.               End;
  703.             End;
  704.             If vertct = 0 Then
  705.             Begin
  706.               x  := xmin;
  707.               x2 := 0;
  708.               While x <= xmax Do
  709.               Begin
  710.                 If linbuf[x2] <> 0 Then
  711.                 Begin
  712.                   If zmono Then
  713.                   Begin
  714.                     If zebra Then
  715.                     Begin
  716.                       If Odd(linbuf[x2]) Then PutPixel(x,y2,maxcolour);
  717.                     End
  718.                     Else PutPixel(x,y2,maxcolour);
  719.                   End
  720.                     Else PutPixel(x,y2,linbuf[x2] Mod Succ(maxcolour));
  721.                 End;
  722.                 Inc(x2);
  723.                 Inc(x,horisub);
  724.               End;
  725.             End;
  726.           End;
  727.           8 : Begin
  728.              If vertct = 0 Then
  729.              Begin
  730.                x := xmin;
  731.                j := 1;
  732.                While (j <= bytesperline) Do
  733.                Begin
  734.                  If zconj Then b2 := $FF
  735.                           Else b2 := 0;
  736.                  For i := 1 To horisub Do
  737.                  Begin
  738.                    If j <= bytesperline Then
  739.                    Begin
  740.                      b := getnextbyte;
  741.                      If zconj Then
  742.                      Begin
  743.                        If b < b2 Then b2 := b;
  744.                      End
  745.                      Else
  746.                      Begin
  747.                        If b > b2 Then b2 := b;
  748.                      End;
  749.                      Inc(j);
  750.                    End;
  751.                  End;
  752.                  If (b2 <> 0) And (x <= xmax) Then
  753.                  Begin
  754.                    If zmono Then
  755.                    Begin
  756.                      If zebra Then
  757.                      Begin
  758.                        If Odd(b2) Then PutPixel(x,y2,maxcolour);
  759.                      End
  760.                        Else PutPixel(x,y2,maxcolour);
  761.                    End
  762.                      Else PutPixel(x,y2,b2 Mod Succ(maxcolour));
  763.                    If (x > 20) And (y2 > 20) And (x < 750) And (y < 300) And
  764.                       (b2 = 0) Then
  765.                    Begin
  766.                      b2 := b2;
  767.                    End;
  768.                  End;
  769.                  Inc(x);
  770.                End;
  771.              End
  772.              Else
  773.              Begin
  774.                For j := 1 To bytesperline Do b := getnextbyte;
  775.              End;
  776.           End;
  777.         End;
  778.         Inc(y);
  779.         If vertct = 0 Then Inc(y2);
  780.         vertct := Succ(vertct) Mod vertsub;
  781.       End;
  782.       If y2 <= maxy Then
  783.       Begin
  784.         SetColor(Black);
  785.         Line(0,maxy,maxx,maxy);
  786.       End;
  787.     End;
  788.     Close(picf);
  789.     If IOResult <> 0 Then;
  790.     beep;
  791.     x := 0;
  792.     If KeyPressed Then answer := ReadKey;
  793.     While (x < deltime) And (answer = #0) Do
  794.     Begin
  795.       Delay(100);
  796.       If deltime < 65535 Then x := x + 100;
  797.       If KeyPressed Then answer := ReadKey;
  798.     End;
  799.     zfinish := answer in FinishSet;
  800.     SetGraphMode(grmode);
  801.   End;                                                            { showfile }
  802.  
  803. Begin                                                                 { main }
  804.   init;
  805.   Repeat
  806.     picname := getnextname;
  807.     If picname <> '' Then showfile(picname);
  808.   Until (picname = '') Or zfinish;
  809. End.
  810.