{ struktura uvodnej hlavicky standartneho PCX formatu }
const BUFF=2048; { pre buffrov‚ ‡¡tanie }
type PCXHeader = record
creator : byte; { Inform cia o tom, ‘e ide o s£bor }
{ vo form te PCX 10(0A) pre ZSoft }
version : byte; { ozna‡uje ‡¡slo verzie PCX form tu (1 byte)}
{ M“‘e nadob£daŸ hodnoty: }
{ 0 - verzia 2.5 }
{ 2 - verzia 2.8 s farebnou paletou }
{ 3 - verzia 2.8 bez palety }
{ 5 - verzia 3.0 s paletou 256*3 }
{ funkcie na ovladanie registrov EGA/VGA karty }
procedure SetVgaWritePlane(number:byte);
begin
Port[$3C4]:=2;
Port[$3C5]:=1 shl number;
end;
procedure SetVgaReg(a:byte; b:byte);
begin
Port[$3CE]:=a;
Port[$3CF]:=b;
end;
{ nacitanie a dekodovanie obrazovych dat metodou Run-Lenght }
function GetPCXByte:byte;
var error:word;
tmp:byte;
begin
if (count > 0) then
begin
dec(count);
GetPCXByte:=value;
exit;
end;
if (LokCount>BUFF) then begin
BlockRead(fPCXdata,Buffer^,BUFF,error);
LokCount:=1;
end;
tmp:=Buffer^[LokCount];
Inc(LokCount);
if ((tmp and $C0) = $C0) then
begin
count := (tmp and $3F) -1;
if (LokCount>BUFF) then begin
BlockRead(fPCXdata,Buffer^,BUFF,error);
LokCount:=1;
end;
value:=Buffer^[LokCount];
Inc(LokCount);
end
else
begin
count := 0;
value := tmp;
end;
GetPCXByte:=value;
end;
function set_pcx(name:string):byte;
var
f:file of PCXHeader; { pre na‡¡tanie hlavi‡ky }
po:byte;
begin
VgaBase:=Ptr($A000,$0);
Assign(f,name);
{$I-}
reset(f);
{$I+}
if (IOResult<>0) then
begin
set_pcx:=1; { nemoze otvorit subor }
exit;
end;
read(f,PCX);
close(f);
{ zmena palety }
for i:=0 to 15 do begin
po:=0;
if (PCX.palette[i,0]>63) then
if (PCX.palette[i,0]<128) then po:= po or 32
else if (PCX.palette[i,0]<192) then po:= po or 4
else po:= po or 36;
if (PCX.palette[i,1]>63) then
if (PCX.palette[i,1]<128) then po:= po or 16
else if (PCX.palette[i,1]<192) then po:= po or 2
else po:= po or 18;
if (PCX.palette[i,2]>63) then
if (PCX.palette[i,2]<128) then po:= po or 8
else if(PCX.palette[i,2]<192) then po:= po or 1
else po:= po or 9;
setpalette(i,po);
end;
end;
function show(name:string ; xova,yova : integer ) : byte;
type BufPerLine=array[0..128] of byte;
var p,b,i:integer;
ptr_:pointer; { ukazuje do obrazovkovej pam„te }
CopyBytes:integer; { pocet bytov na riadok }
MaxScanLines:integer; { pocet riadkov na obrazok }
pl:array[0..3] of ^BufPerLine; { bufer pre jednotlive skanovacie riadky }
begin
xova:=round(xova/8);
{ priprava udajov }
for i:=0 to PCX.planes-1 do begin
if PCX.BytesPerLine > MaxAvail then
begin
show:=2;
exit;
end;
GetMem(pl[i],PCX.BytesPerLine);
end;
for p:=0 to 3 do
for i:=0 to 128 do pl[p]^[i]:=0;
if BUFF > MaxAvail then
begin
show:=2;
exit;
end;
GetMem(buffer,SizeOf(textbuf));
CopyBytes := Trunc(getmaxx / 8);
if (CopyBytes > PCX.BytesPerLine) then
CopyBytes := PCX.BytesPerLine;
MaxScanLines := PCX.ymax - PCX.ymin;
if (MaxScanLines > (getmaxy+1)) then
MaxScanLines := getmaxy;
SetVgaReg(5,0);
SetVgaReg(1,0);
LokCount:=BUFF+1;
Assign(fPCXdata,name);
reset(fPCXdata,1);
seek(fPCXdata,128); { posun na zaciatok dat }
{ nacitavanie obrazku }
for i:=yova to MaxScanLines-1+yova do begin
for p:=0 to PCX.planes-1 do
for b:=0 to PCX.BytesPerLine-1 do
pl[p]^[b] := GetPCXByte;
ptr_:=PTR(SEG(VgaBase^),i*80+xova);
{ vykreslenie obr zku, presuvom do obr. pam„te }
for p:=0 to PCX.planes-1 do begin
SetVgaWritePlane(p);
move(pl[p]^,ptr_^,CopyBytes);
end;
end;
{ Niekedy to padalo
SetVgaWritePlane($F);}
{ uvolnenie naalokovanej pamate }
for i:=PCX.planes-1 downto 0 do
FreeMem(pl[i],PCX.BytesPerLine);
close(fPCXdata);
show:=0;
end;
begin
Writeln('Prehliadac 16farebnych PCX Software by TrSek');
if(ParamCount<1) then begin
WriteLn('Ako parameter zadaj meno PCX suboru.');
halt(1);
end;
detectgraph(gm,gd);
initgraph(gm,gd,'');
cleardevice;
count:=0;
set_pcx(paramstr(1));
err:=show(paramstr(1),20,20);
repeat until keypressed;
closegraph;
end.