unit iViewBMP;
interface
uses dos,crt,graph,iVGA,ifBMP;
procedure LoadPackBMPFile(x,y:LongInt;NameCode:PathStr);
procedure SavePackBMPFile(x1,y1,x2,y2:LongInt;NameCode:PathStr);
procedure LoadUnPackBMPFile(x,y:LongInt;NameCode:PathStr);
procedure _LoadUnPackBMPFile(x,y:LongInt;NameCode:PathStr);
procedure SaveUnPackBMPFile(x1,y1,x2,y2:LongInt;NameCode:PathStr);
implementation
var
testH:BitMapFileHeader;
testI:BitMapInfo;
cRed,cGreen,cBlue:byte;
cRGB:RGBQuad;
cReg:byte;
fBMP:file;
iBMP,jBMP:LongInt;
memBMP:byte;
readByte:byte;
LineBuff:array[0..639] of byte;
procedure LoadPackBMPFile(x,y:LongInt;NameCode:PathStr);
begin
Assign(fBMP,NameCode);
Reset(fBMP,1);
BlockRead(fBMP,testH.Types[1],1);
BlockRead(fBMP,testH.Types[2],1);
BlockRead(fBMP,testH.Size,4);
BlockRead(fBMP,testH.Reserved1,2);
BlockRead(fBMP,testH.Reserved2,2);
BlockRead(fBMP,testH.OffBits,4);
BlockRead(fBMP,testI.H.Size,4);
BlockRead(fBMP,testI.H.Width,4);
BlockRead(fBMP,testI.H.Height,4);
BlockRead(fBMP,testI.H.Planes,2);
BlockRead(fBMP,testI.H.BitCount,2);
if testI.H.BitCount < 4 then
begin
SetVideoMode(3);
writeln;
writeln('Mod video neidentificat');
Halt(1);
end;
BlockRead(fBMP,testI.H.Compression,4);
BlockRead(fBMP,testI.H.SizeImage,4);
BlockRead(fBMP,testI.H.XPelsPerMeter,4);
BlockRead(fBMP,testI.H.YPelsPerMeter,4);
BlockRead(fBMP,testI.H.ClrUsed,4);
BlockRead(fBMP,testI.H.ClrImportant,4);
if (testI.H.BitCount = 4) and (testI.H.ClrImportant >= 0) then
begin
for iBMP:=0 to 15 do
begin
BlockRead(fBMP,testI.C[iBMP].Blue,1);
testI.C[iBMP].Blue:=testI.C[iBMP].Blue div 4;
BlockRead(fBMP,testI.C[iBMP].Green,1);
testI.C[iBMP].Green:=testI.C[iBMP].Green div 4;
BlockRead(fBMP,testI.C[iBMP].Red,1);
testI.C[iBMP].Red:=testI.C[iBMP].Red div 4;
BlockRead(fBMP,testI.C[iBMP].Reserved,1);
end;
end;
for iBMP:=0 to 5 do
SetColorRegister(iBMP,testI.C[iBMP].Red,testI.C[iBMP].Green,testI.C[iBMP].Blue);
SetColorRegister(20,testI.C[6].Red,testI.C[6].Green,testI.C[6].Blue);
SetColorRegister(7,testI.C[7].Red,testI.C[7].Green,testI.C[7].Blue);
for iBMP:=56 to 63 do
SetColorRegister(iBMP,testI.C[iBMP-48].Red,testI.C[iBMP-48].Green,testI.C[iBMP-48].Blue);
for iBMP:=0 to testI.H.Height-1 do
begin
jBMP:=0;
repeat
BlockRead(fBMP,readByte,1);
memBMP:=readByte;
readByte:=memBMP shr 4;
PutPixel(x+jBMP,y+testI.H.Height-iBMP-1,readByte);
Inc(jBMP);
asm
and memBMP,15
end;
PutPixel(x+jBMP,y+testI.H.Height-iBMP-1,memBMP);
Inc(jBMP);
until jBMP = testI.H.Width;
end;
Close(fBMP);
end;
procedure SavePackBMPFile(x1,y1,x2,y2:LongInt;NameCode:PathStr);
begin
Assign(fBMP,NameCode);
Rewrite(fBMP,1);
testH.Types[1]:='B';
testH.Types[2]:='M';
testH.Size:=Round((x2-x1+1)*(y2-y1+1)/2)+118;
testH.Reserved1:=0;
testH.Reserved2:=0;
testH.OffBits:=118;
testI.H.Size:=40;
testI.H.Width:=x2-x1+1;
testI.H.Height:=y2-y1+1;
testI.H.Planes:=1;
testI.H.BitCount:=4;
testI.H.Compression:=0;
testI.H.SizeImage:=0;
testI.H.XPelsPerMeter:=0;
testI.H.YPelsPerMeter:=0;
testI.H.ClrUsed:=0;
testI.H.ClrImportant:=0;
BlockWrite(fBMP,testH.Types[1],1);
BlockWrite(fBMP,testH.Types[2],1);
BlockWrite(fBMP,testH.Size,4);
BlockWrite(fBMP,testH.Reserved1,2);
BlockWrite(fBMP,testH.Reserved2,2);
BlockWrite(fBMP,testH.OffBits,4);
BlockWrite(fBMP,testI.H.Size,4);
BlockWrite(fBMP,testI.H.Width,4);
BlockWrite(fBMP,testI.H.Height,4);
BlockWrite(fBMP,testI.H.Planes,2);
BlockWrite(fBMP,testI.H.BitCount,2);
BlockWrite(fBMP,testI.H.Compression,4);
BlockWrite(fBMP,testI.H.SizeImage,4);
BlockWrite(fBMP,testI.H.XPelsPerMeter,4);
BlockWrite(fBMP,testI.H.YPelsPerMeter,4);
BlockWrite(fBMP,testI.H.ClrUsed,4);
BlockWrite(fBMP,testI.H.ClrImportant,4);
for iBMP:=0 to 5 do
begin
ReadColorRegister(iBMP,cRed,cGreen,cBlue);
testI.C[iBMP].Blue:=cBlue*4;
testI.C[iBMP].Green:=cGreen*4;
testI.C[iBMP].Red:=cRed*4;
testI.C[iBMP].Reserved:=0;
BlockWrite(fBMP,testI.C[iBMP].Blue,1);
BlockWrite(fBMP,testI.C[iBMP].Green,1);
BlockWrite(fBMP,testI.C[iBMP].Red,1);
BlockWrite(fBMP,testI.C[iBMP].Reserved,1);
end;
ReadColorRegister(20,cRed,cGreen,cBlue);
testI.C[6].Blue:=cBlue*4;
testI.C[6].Green:=cGreen*4;
testI.C[6].Red:=cRed*4;
testI.C[6].Reserved:=0;
BlockWrite(fBMP,testI.C[6].Blue,1);
BlockWrite(fBMP,testI.C[6].Green,1);
BlockWrite(fBMP,testI.C[6].Red,1);
BlockWrite(fBMP,testI.C[6].Reserved,1);
ReadColorRegister(7,cRed,cGreen,cBlue);
testI.C[7].Blue:=cBlue*4;
testI.C[7].Green:=cGreen*4;
testI.C[7].Red:=cRed*4;
testI.C[7].Reserved:=0;
BlockWrite(fBMP,testI.C[7].Blue,1);
BlockWrite(fBMP,testI.C[7].Green,1);
BlockWrite(fBMP,testI.C[7].Red,1);
BlockWrite(fBMP,testI.C[7].Reserved,1);
for iBMP:=56 to 63 do
begin
ReadColorRegister(iBMP,cRed,cGreen,cBlue);
testI.C[iBMP-48].Blue:=cBlue*4;
testI.C[iBMP-48].Green:=cGreen*4;
testI.C[iBMP-48].Red:=cRed*4;
testI.C[iBMP-48].Reserved:=0;
BlockWrite(fBMP,testI.C[iBMP-48].Blue,1);
BlockWrite(fBMP,testI.C[iBMP-48].Green,1);
BlockWrite(fBMP,testI.C[iBMP-48].Red,1);
BlockWrite(fBMP,testI.C[iBMP-48].Reserved,1);
end;
jBMP:=y2;
repeat
iBMP:=x1;
repeat
readByte:=GetPixel(iBMP,jBMP) shl 4;
Inc(iBMP);
readByte:=readByte+GetPixel(iBMP,jBMP);
BlockWrite(fBMP,readByte,1);
Inc(iBMP);
until iBMP > x2;
jBMP:=jBMP-1;
until jBMP < y1;
Close(fBMP);
end;
procedure LoadUnPackBMPFile(x,y:LongInt;NameCode:PathStr);
begin
Assign(fBMP,NameCode);
Reset(fBMP,1);
BlockRead(fBMP,testH.Types[1],1);
BlockRead(fBMP,testH.Types[2],1);
BlockRead(fBMP,testH.Size,4);
BlockRead(fBMP,testH.Reserved1,2);
BlockRead(fBMP,testH.Reserved2,2);
BlockRead(fBMP,testH.OffBits,4);
BlockRead(fBMP,testI.H.Size,4);
BlockRead(fBMP,testI.H.Width,4);
BlockRead(fBMP,testI.H.Height,4);
BlockRead(fBMP,testI.H.Planes,2);
BlockRead(fBMP,testI.H.BitCount,2);
if testI.H.BitCount < 4 then
begin
SetVideoMode(3);
writeln;
writeln('Mod video neidentificat');
Halt(1);
end;
BlockRead(fBMP,testI.H.Compression,4);
BlockRead(fBMP,testI.H.SizeImage,4);
BlockRead(fBMP,testI.H.XPelsPerMeter,4);
BlockRead(fBMP,testI.H.YPelsPerMeter,4);
BlockRead(fBMP,testI.H.ClrUsed,4);
BlockRead(fBMP,testI.H.ClrImportant,4);
if (testI.H.BitCount = 8) and (testI.H.ClrImportant >= 0) then
begin
for iBMP:=0 to 255 do
begin
BlockRead(fBMP,testI.C[iBMP].Blue,1);
testI.C[iBMP].Blue:=testI.C[iBMP].Blue div 4;
BlockRead(fBMP,testI.C[iBMP].Green,1);
testI.C[iBMP].Green:=testI.C[iBMP].Green div 4;
BlockRead(fBMP,testI.C[iBMP].Red,1);
testI.C[iBMP].Red:=testI.C[iBMP].Red div 4;
BlockRead(fBMP,testI.C[iBMP].Reserved,1);
end;
end;
for iBMP:=0 to 255 do
SetColorRegister(iBMP,testI.C[iBMP].Red,testI.C[iBMP].Green,testI.C[iBMP].Blue);
for iBMP:=0 to testI.H.Height-1 do
begin
BlockRead(fBMP,LineBuff,testI.H.Width);
for jBMP:=0 to testI.H.Width-1 do
Mem[$A000:jBMP+x+320*y+320*(testI.H.Height-iBMP-1)]:=LineBuff[jBMP];
end;
Close(fBMP);
end;
procedure SaveUnPackBMPFile(x1,y1,x2,y2:LongInt;NameCode:PathStr);
begin
Assign(fBMP,NameCode);
Rewrite(fBMP,1);
testH.Types[1]:='B';
testH.Types[2]:='M';
testH.Size:=(x2-x1+1)*(y2-y1+1)+1078;
testH.Reserved1:=0;
testH.Reserved2:=0;
testH.OffBits:=1078;
testI.H.Size:=40;
testI.H.Width:=x2-x1+1;
testI.H.Height:=y2-y1+1;
testI.H.Planes:=1;
testI.H.BitCount:=8;
testI.H.Compression:=0;
testI.H.SizeImage:=0;
testI.H.XPelsPerMeter:=0;
testI.H.YPelsPerMeter:=0;
testI.H.ClrUsed:=256;
testI.H.ClrImportant:=256;
BlockWrite(fBMP,testH.Types[1],1);
BlockWrite(fBMP,testH.Types[2],1);
BlockWrite(fBMP,testH.Size,4);
BlockWrite(fBMP,testH.Reserved1,2);
BlockWrite(fBMP,testH.Reserved2,2);
BlockWrite(fBMP,testH.OffBits,4);
BlockWrite(fBMP,testI.H.Size,4);
BlockWrite(fBMP,testI.H.Width,4);
BlockWrite(fBMP,testI.H.Height,4);
BlockWrite(fBMP,testI.H.Planes,2);
BlockWrite(fBMP,testI.H.BitCount,2);
BlockWrite(fBMP,testI.H.Compression,4);
BlockWrite(fBMP,testI.H.SizeImage,4);
BlockWrite(fBMP,testI.H.XPelsPerMeter,4);
BlockWrite(fBMP,testI.H.YPelsPerMeter,4);
BlockWrite(fBMP,testI.H.ClrUsed,4);
BlockWrite(fBMP,testI.H.ClrImportant,4);
for iBMP:=0 to 255 do
begin
ReadColorRegister(iBMP,cRed,cGreen,cBlue);
testI.C[iBMP].Blue:=cBlue*4;
testI.C[iBMP].Green:=cGreen*4;
testI.C[iBMP].Red:=cRed*4;
testI.C[iBMP].Reserved:=0;
BlockWrite(fBMP,testI.C[iBMP].Blue,1);
BlockWrite(fBMP,testI.C[iBMP].Green,1);
BlockWrite(fBMP,testI.C[iBMP].Red,1);
BlockWrite(fBMP,testI.C[iBMP].Reserved,1);
end;
for iBMP:=0 to testI.H.Height-1 do
begin
for jBMP:=0 to testI.H.Width-1 do
LineBuff[jBMP]:=Mem[$A000:jBMP+x1+320*y1+320*(testI.H.Height-iBMP-1)];
BlockWrite(fBMP,LineBuff,testI.H.Width);
end;
Close(fBMP);
end;
procedure _LoadUnPackBMPFile(x,y:LongInt;NameCode:PathStr);
begin
Assign(fBMP,NameCode);
Reset(fBMP,1);
BlockRead(fBMP,testH.Types[1],1);
BlockRead(fBMP,testH.Types[2],1);
BlockRead(fBMP,testH.Size,4);
BlockRead(fBMP,testH.Reserved1,2);
BlockRead(fBMP,testH.Reserved2,2);
BlockRead(fBMP,testH.OffBits,4);
BlockRead(fBMP,testI.H.Size,4);
BlockRead(fBMP,testI.H.Width,4);
BlockRead(fBMP,testI.H.Height,4);
BlockRead(fBMP,testI.H.Planes,2);
BlockRead(fBMP,testI.H.BitCount,2);
if testI.H.BitCount < 4 then
begin
SetVideoMode(3);
writeln;
writeln('Mod video neidentificat');
Halt(1);
end;
BlockRead(fBMP,testI.H.Compression,4);
BlockRead(fBMP,testI.H.SizeImage,4);
BlockRead(fBMP,testI.H.XPelsPerMeter,4);
BlockRead(fBMP,testI.H.YPelsPerMeter,4);
BlockRead(fBMP,testI.H.ClrUsed,4);
BlockRead(fBMP,testI.H.ClrImportant,4);
if (testI.H.BitCount = 8) and (testI.H.ClrImportant >= 0) then
begin
for iBMP:=0 to 255 do
begin
BlockRead(fBMP,testI.C[iBMP].Blue,1);
testI.C[iBMP].Blue:=testI.C[iBMP].Blue div 4;
BlockRead(fBMP,testI.C[iBMP].Green,1);
testI.C[iBMP].Green:=testI.C[iBMP].Green div 4;
BlockRead(fBMP,testI.C[iBMP].Red,1);
testI.C[iBMP].Red:=testI.C[iBMP].Red div 4;
BlockRead(fBMP,testI.C[iBMP].Reserved,1);
end;
end;
for iBMP:=0 to 255 do
SetColorRegister(iBMP,testI.C[iBMP].Red,testI.C[iBMP].Green,testI.C[iBMP].Blue);
{ testI.H.Height:=400; { ! }
for iBMP:=0 to testI.H.Height-1 do
begin
BlockRead(fBMP,LineBuff,testI.H.Width);
for jBMP:=0 to testI.H.Width-1 do begin
if odd(jBMP) then
Mem[$A000:(jBMP div 2)+x+320*y+
320*(testI.H.Height-(round(iBMP /2.4))-1)]:=
LineBuff[jBMP];
end
end;
Close(fBMP);
end;
Begin
End.
Stan Florin stanflorin