Код Pascal
Код: Выделить всё
program
PCX_Viewer;
uses Dos, graph, Crt;
const
MaxBufLen = 65520;
type
RGB = record
Red,
Green,
Blue : Byte;
end;
PCXHeader = record
Maker : Byte;
Version : Byte; { Версия pcxLib }
Code : Byte;
BitsPerPixel : Byte;
XLow : Word;
YLow : Word;
XHigh : Word;
YHigh : Word;
Hres : Word; { Гориз.разрешение дисплея }
Vres : Word; { Вертик.разрешение дисплея }
Palette : array [0..15] of RGB;
VMode : Byte; { (игнорируется) }
PlaneCount : Byte;
BytesPerLine : Word;
Reserved : array [0..59] of byte;
end;
BufType = array [1..MaxBufLen] of Byte;
PtrToByte = ^Byte;
Pallette = array [0..255] of RGB;
var
PCXFile : File;
FileName : PathStr; { Имя файла изображения }
Header : PCXHeader; { Заголовок библиотеки изображений }
VGAPtr : PtrToByte;
Count : Byte;
Data : Byte;
i : Byte;
Regs : Registers;
PlaneNum : Byte;
Bytes : Word;
Lines : Word;
Buf : ^BufType;
BufPtr : Word;
BufLen : Word;
Pal : Pallette;
VGAFile : Boolean;
Function RGBColor(ColorNum : Byte) : Byte;
begin
RGBColor := (((Header.Palette[ColorNum].Red div 85) and 1) shl 5) +
(((Header.Palette[ColorNum].Red div 85) and 2) shl 1) +
(((Header.Palette[ColorNum].Green div 85) and 1) shl 4) +
(((Header.Palette[ColorNum].Green div 85) and 2) shl 0)+
(((Header.Palette[ColorNum].Blue div 85) and 1) shl 3)+
(((Header.Palette[ColorNum].Blue div 85) and 2) shr 1);
end;
BEGIN
FileName := ParamStr(1);
Write('File name : ');
if FileName = '' then
ReadLn(FileName)
else
WriteLn(FileName);
Assign(PCXFile, ParamStr(1));
Reset(PCXFile, 1);
BlockRead(PCXFile, Header, SizeOf(PCXHeader));
VGAFile := Header.BitsPerPixel = 8; { Если 8 бит, то 256 цветов. }
{ Не аксиома, но pаботает. }
if VGAFile then
begin
Seek(PCXFile, FileSize(PCXFile)-SizeOf(Pal)); { В 256-цветном файле }
BlockRead(PCXFile, Pal, SizeOf(pal)); { палитpа в самом конце. }
Seek(PCXFile, SizeOf(header));
end;
New(Buf);
BufLen := 0;
BufPtr := 1;
Lines := 0;
if VGAFile then
asm { Достаточно мутоpная для }
lea si, pal { паскаля пpоцедуpа загpузки }
mov cx, 768 { VGAшной палитpы. }
@1:
shr byte ptr [si], 1
shr byte ptr [si], 1
inc si
loop @1
mov ax, 0013h { 320x200x256colors }
int 10h
mov ax, 1012h
xor bx, bx
mov cx, 256
mov dx, seg pal
mov es, dx
mov dx, offset pal
int 10h { всю палитpу - гуpтом. }
end
else
begin { А с EGой так не сделать. }
Regs.AX:=$0010;
Intr($10, Regs);
for i := 0 to 15 do
begin
Regs.AH := $10;
Regs.AL := 0;
Regs.BL := i;
Regs.BH := RGBColor(i);
Intr($10, Regs);
end;
{ Write mode }
Port[$3CE] := 5; { Инит поpтов для записи. }
Port[$3CF] := 0;
Bytes := 1;
PlaneNum := 1;
Port[$3C4] := 2; { План #1. }
Port[$3C5] := 0;
end;
VGAPtr := Ptr($A000, $0000);
repeat
if BufPtr > BufLen then
begin
BlockRead(PCXFile, Buf^, MaxBufLen, BufLen);
BufPtr := 1;
end;
Data := Buf^[BufPtr];
Inc(BufPtr);
if Data and $C0 = $C0 then { Распаковка RLE-компpессии. }
begin
Count := Data and $3F;
if BufPtr > BufLen then
BlockRead(PCXFile, Data, 1)
else
begin
Data := Buf^[BufPtr];
Inc(BufPtr);
end;
end
else
Count := 1;
for i := 1 to Count do
begin
PtrToByte(Longint(VGAPtr) + Bytes - 1)^ := Data;
Inc(Bytes);
if Bytes > Header.BytesPerLine then
begin
Bytes := 1;
if VGAFile then
begin
Inc(Longint(VGAPtr), Header.BytesPerLine); { VGA => пpосто увели- }
Inc(Lines); { чить счетчик. }
end
else
begin { EGA => пеpеключать }
if PlaneNum > 3 then { планы от 0 до 3, а }
begin { потом - счетчик. }
PlaneNum := 0;
Inc(Longint(VGAPtr), Header.BytesPerLine);
Inc(Lines);
end;
Inc(PlaneNum);
Port[$3C4] := 2; { Собственно выбоp }
Port[$3C5] := 1 shl (PlaneNum-1); { плана. }
end;
end;
end;
until Lines > Header.YHigh;
ReadKey;
Dispose(Buf);
Close(PCXFile);
TextMode(3);
END.
