Программа для просмотра PCX файлов
Добавлено: 10 окт 2009, 10:28
У меня такая проблема, не могу изменить рзрешение с 320х200 на болешее ну скажем 540х480. Из за этого открываются не все графические файлы PCX. При открытии многие из них искажаются. Помогите исправить пожалуйста.Вот текст программы
Код Pascal
Код 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.