home *** CD-ROM | disk | FTP | other *** search
- {-----------------------------------------------------------------------------}
- { TEGL Windows ToolKit II }
- { Copyright (C) 1990, 1991 TEGL Systems Corporation }
- { All Rights Reserved. }
- {-----------------------------------------------------------------------------}
-
- {$I switches.inc}
- {$IFDEF TEGLOVR}
- {$O+}
- {$F+}
- {$ENDIF}
-
-
- unit PCXGraph;
-
- INTERFACE
-
- uses dos,
- errorlog,
- fastgrph, {for ActiveTEGLMode}
- tgraph, {for palette type}
- virtmem;
-
- TYPE
- pcxheader = record
- manufacturer : byte;
- version : byte;
- encoding : byte;
- bitsperpixel : byte;
- xmin,ymin : integer;
- xmax,ymax : integer;
- HDPI,VDPI : integer;
- colormap : array[0..47] of byte;
- reserved : byte;
- NPlanes : byte;
- bytesperline : integer;
- paletteinfo : integer;
- HscreenSize : word;
- VscreenSize : word;
- filler : array[0..53] of byte;
- end;
-
- function FileExists(filename:pathstr) : boolean;
-
- procedure SetPCXBWMap(r,g,b,i : byte);
-
- procedure QuickShowPCXFile(pcxfilename:pathstr; palettechange:boolean; baseoffset,maxlines,maxwidth:word);
- procedure DisplayPCXFile(pcxbuff:pointer; palettechange:boolean; baseoffset,maxlines,maxwidth:word);
-
- function LoadPCXFiletoVirtual(pcxfilename:pathstr) : virtualptr;
- procedure DisplayVirtualPCXFile(pcxbuff:virtualptr; palettechange:boolean; baseoffset,maxlines,maxwidth:word);
-
- procedure listPCXHeaderInfo(pcxhead:pcxheader);
- procedure GetPcxHeader(pcxfilename:pathstr; var pcxhead:pcxheader);
-
- IMPLEMENTATION
-
- const
- rgbpcxmap : array[0..3] of byte = ($ff,$ff,$ff,$ff);
-
- {$F+}
- procedure egapcx4plane(pcxbuff:pointer; baseoffset,maxlines,maxwidth:word); external;
- procedure egapcx1plane(pcxbuff:pointer; baseoffset,maxlines,maxwidth:word); external;
- {$L pcxega.obj}
- {$F-}
- {$I-}
-
- function FileExists(filename:pathstr) : boolean;
- var tstfile : file;
- retcode : word;
- begin
- assign(tstfile,filename);
- reset(tstfile,1);
- Retcode := IOresult;
- close(tstfile);
-
- FileExists := retcode=0;
- end;
-
- function LoadPCXFiletoVirtual(pcxfilename:pathstr) : virtualptr;
- var pcxfile : file;
- pcxbuff : virtualptr;
- retcode : integer;
- pcxsize : longint;
- blkbuff : pointer;
- bytesread : word;
- p : pathstr;
- d : dirstr;
- n : namestr;
- e : extstr;
- begin
- { fsplit(pcxfilename,d,n,e); }
- { pcxfilename := n+e;
- pcxfilename := fsearch(pcxfilename,getenv('PATH')); }
-
- Retcode := IOresult;
- assign(pcxfile,pcxfilename);
- reset(pcxfile,1);
-
- Retcode := IOresult;
- if retcode<>0 then
- aborterror('Unable to find and load PCX File: '+pcxfilename,retcode);
-
- pcxsize := filesize(pcxfile);
- vpgetmem(pcxbuff,pcxsize);
-
- vpaccess(pcxbuff,blkbuff);
-
- repeat
- blockread(pcxfile,blkbuff^,$8000,bytesread);
- blkbuff := lineartopointer(linear(blkbuff)+bytesread);
- until bytesread=0;
- close(pcxfile);
-
- vpunuse(pcxbuff);
- LoadPCXFiletoVirtual := pcxbuff;
- end;
-
- procedure DisplayPCXFile(pcxbuff:pointer; palettechange:boolean; baseoffset,maxlines,maxwidth:word);
- var pal : palettetype;
- i,j : word;
- color : byte;
- mask : byte;
- pcxcode : byte;
- begin
- if pcxheader(pcxbuff^).bitsperpixel<>1 then
- exit;
-
- case pcxheader(pcxbuff^).NPlanes of
- 1 : egapcx1plane(pcxbuff,baseoffset,maxlines,maxwidth);
- 4 : begin
- { if palettechange and
- (pcxheader(pcxbuff^).version <> 3) then }
- if palettechange then
- begin
- for i:= 0 to 15 do
- begin
- color:= 0;
- for j:= 0 to 2 do
- begin
- { Get primary color value }
- pcxcode:= pcxheader(pcxbuff^).colormap[i*3+j];
- case (pcxcode div $40) of
- 0: mask:= $00; { 000000 }
- 1: mask:= $20; { 100000 }
- 2: mask:= $04; { 000100 }
- 3: mask:= $24; { 100100 }
- end;
- color:= color or (mask shr j); { Define two bits }
- end;
- pal.colors[i]:= color;
- end;
- pal.size:= 16;
-
- setallpalette(pal);
- end;
-
- egapcx4plane(pcxbuff,baseoffset,maxlines,maxwidth);
- end;
- end;
- end;
-
- procedure DisplayVirtualPCXFile(pcxbuff:virtualptr; palettechange:boolean; baseoffset,maxlines,maxwidth:word);
- begin
- vpuse(pcxbuff);
- DisplayPCXFile(pcxbuff^.memoryptr,palettechange,baseoffset,maxlines,maxwidth);
- vpunuse(pcxbuff);
- end;
-
- procedure QuickShowPCXFile(pcxfilename:pathstr; palettechange:boolean; baseoffset,maxlines,maxwidth:word);
- var pcxbuff : virtualptr;
- begin
- pcxbuff := loadPCXFiletoVirtual(pcxfilename);
- displayVirtualPCXFile(pcxbuff,palettechange,baseoffset,maxlines,maxwidth);
- vpfreemem(pcxbuff);
- end;
-
- procedure SetPCXBWMap(r,g,b,i : byte);
- begin
- rgbpcxmap[0] := b;
- rgbpcxmap[1] := g;
- rgbpcxmap[2] := r;
- rgbpcxmap[3] := i;
- end;
-
- procedure GetPcxHeader(pcxfilename:pathstr; var pcxhead:pcxheader);
- var pcxfile : file;
- retcode : integer;
- begin
- assign(pcxfile,pcxfilename);
- reset(pcxfile,1);
-
- Retcode := IOresult;
- if retcode<>0 then
- aborterror('Unable to find and load PCX Header: '+pcxfilename,retcode);
-
- blockread(pcxfile,pcxhead,sizeof(pcxheader));
- close(pcxfile);
- end;
-
- procedure listPCXHeaderInfo(pcxhead:pcxheader);
- var i : integer;
- begin
- writeln('manufacturer : ',hexbyte(pcxhead.manufacturer));
- writeln('version : ',hexbyte(pcxhead.version));
- writeln('encoding : ',hexbyte(pcxhead.encoding));
- writeln('bitsperpixel : ',hexbyte(pcxhead.bitsperpixel));
- writeln('xmin,ymin : ',pcxhead.xmin,',',pcxhead.ymin);
- writeln('xmax,ymax : ',pcxhead.xmax,',',pcxhead.ymax);
- writeln('HDPI,VDPI : ',pcxhead.HDPI,',',pcxhead.VDPI);
-
- write('colormap : ');
- for i:=0 to 16 do
- write(pcxhead.colormap[i],' ');
- writeln;
-
- writeln('reserved : ',hexbyte(pcxhead.reserved));
- writeln('NPlanes : ',hexbyte(pcxhead.NPlanes));
- writeln('bytesperline : ',hex(pcxhead.bytesperline));
- writeln('paletteinfo : ',hex(pcxhead.paletteinfo));
- writeln('HscreenSize : ',hex(pcxhead.HscreenSize));
- writeln('VscreenSize : ',hex(pcxhead.VscreenSize));
- end;
-
-
- end.