home *** CD-ROM | disk | FTP | other *** search
- {$I-}
- uses Crt,Dos;
-
- type
- TPCXHeader = record
- Manuf : byte;
- Version : byte;
- Encode : byte;
- BitsPerPixel : byte;
- X1,Y1,X2,Y2 : integer;
- Xres,Yres : integer;
- Palette : Array [0..47] of byte;
- VideoMode : byte;
- Planes : byte;
- BytesPerLine : integer;
- Reserved : Array [0..59] of byte;
- end;
-
- PPCXPic = ^TPCXPic;
- TPCXPic = record
- Header : TPCXHeader;
- Palette : Array [0..767] of byte;
- Pixels : Pointer;
- end;
-
- procedure LoadPCX(FileName: string; var PCX: TPCXPic);
- var
- F: File;
- Buf: Array [0..1024] of byte;
- BufPtr,Off,Size: word;
- Code,Count: byte;
- begin
- Assign(F,FileName);
- Reset(F,1);
- BlockRead(F,PCX.Header,SizeOf(PCX.Header));
- with PCX.Header do
- if (Manuf <> 10) or (Version <> 5) or (Encode <> 1) or
- (BitsPerPixel <> 8) or (Planes <> 1) or
- (BytesPerLine > 320) or (Y2 - Y1 > 199) then begin
- PCX.Pixels := nil;
- Exit;
- end;
- Size := PCX.Header.BytesPerLine * Succ(PCX.Header.Y2 - PCX.Header.Y1);
- GetMem(PCX.Pixels,Size);
- if PCX.Pixels = nil then Exit;
-
- BufPtr := SizeOf(Buf);
- Off := 0;
- while Off < Size do begin
- if BufPtr >= SizeOf(Buf) then begin
- BlockRead(F,Buf,SizeOf(Buf));
- BufPtr := 0;
- end;
- Code := Buf[BufPtr]; Inc(BufPtr);
- if Code shr 6 = 3 then begin
- Count := Code and 63;
- if BufPtr >= SizeOf(Buf) then begin
- BlockRead(F,Buf,SizeOf(Buf));
- BufPtr := 0;
- end;
- Code := Buf[BufPtr]; Inc(BufPtr);
- FillChar(Mem[Seg(PCX.Pixels^):Ofs(PCX.Pixels^)+Off],Count,Code);
- Inc(Off,Count);
- end
- else begin
- Mem[Seg(PCX.Pixels^):Ofs(PCX.Pixels^)+Off] := Code;
- Inc(Off);
- end;
- end;
- if BufPtr >= SizeOf(Buf) then begin
- BlockRead(F,Buf,SizeOf(Buf));
- BufPtr := 0;
- end;
- Code := Buf[BufPtr]; Inc(BufPtr);
- if Code = 12 then begin
- for Off := 0 to 767 do begin
- if BufPtr >= SizeOf(Buf) then begin
- BlockRead(F,Buf,767-Off);
- BufPtr := 0;
- end;
- PCX.Palette[Off] := Buf[BufPtr]; Inc(BufPtr);
- end;
- end;
- Close(F);
- end;
-
- procedure FreePCX(var PCX: TPCXPic);
- begin
- if PCX.Pixels <> nil then
- FreeMem(PCX.Pixels,PCX.Header.BytesPerLine*Succ(PCX.Header.Y2-PCX.Header.Y1));
- end;
-
- procedure WriteInfo(var PCX: TPCXPic);
- begin
- Writeln('PCX Header Info: (debug)');
- with PCX.Header do begin
- Write(' Manuf: ',manuf);
- if Manuf <> 10 then WriteLn(' **10 expected') else Writeln;
- Write('Version: ',version);
- if Version <> 5 then WriteLn(' **5 expected') else Writeln;
- Write(' Encode: ',encode);
- if EnCode <> 1 then WriteLn(' **1 expected') else Writeln;
- Write(' BPP: ',bitsperpixel);
- if BitsPerPixel <> 8 then WriteLn(' **8 expected') else Writeln;
- Writeln(' X1,Y1: ',X1,',',Y1);
- Writeln(' X2,Y2: ',X2,',',Y2);
- Writeln(' Xres: ',Xres);
- Writeln(' Yres: ',Yres);
- Writeln(' VMode: ',VideoMode);
- Write(' Planes: ',Planes);
- if Planes <> 1 then Writeln(' **1 expected') else Writeln;
- Write(' BPL: ',bytesperline);
- if BytesPerLine > 320 then Writeln(' **max 320 pixels') else Writeln;
- end;
- Writeln;
- end;
-
- var
- PCX: TPCXPic;
- I: integer;
- F: file;
- Path: PathStr;
- Dir: DirStr;
- Name: NameStr;
- Ext: ExtStr;
-
- begin
- Writeln('PCX to RAW Version 0.1ß Copyright (c) 1993 Carlos Hasan.');
- if ParamCount <> 1 then begin
- Writeln('Uso: RAW <filename>');
- Halt;
- end;
-
- FSplit(ParamStr(1),Dir,Name,Ext);
- if Ext = '' then Path := Dir + Name + '.PCX' else Path := Dir + Name + Ext;
-
- {***Load PCX file}
- LoadPCX(Path,PCX);
-
- {***if error exit}
- if PCX.Pixels = nil then begin
- Writeln('Error reading PCX file: ',Path);
- Writeln;
- WriteInfo(PCX);
- Halt;
- end;
-
- {***set 320x200x256 mode}
- asm
- mov ax,13h
- int 10h
- end;
-
- {***set palette}
- Port[$3c8] := 0;
- for I := 0 to 767 do begin
- PCX.Palette[I] := PCX.Palette[I] shr 2;
- Port[$3c9] := PCX.Palette[I];
- end;
-
- {***putimage}
- with PCX do
- for I := Header.Y1 to Header.Y2 do
- Move(Mem[Seg(PCX.Pixels^):Ofs(PCX.Pixels^) + I*Header.BytesPerLine],
- Mem[$A000:320*I], Header.X2 - Header.X1 + 1);
-
- {**Write raw data}
- Assign(F, Name + '.RAW');
- Rewrite(F,1);
- with PCX do
- for I := Header.Y1 to Header.Y2 do
- BlockWrite(F,Mem[$A000:320*I],Header.X2 - Header.X1 + 1);
- Close(F);
-
- {**Write palette}
- Assign(F,Name + '.PAL');
- Rewrite(F,1);
- BlockWrite(F,PCX.Palette,768);
- Close(F);
-
- {***wait key}
- {ReadKey;}
-
- {***set 80x25x16 mode}
- asm
- mov ax,03h
- int 10h
- end;
-
- WriteInfo(PCX);
- end.
-