Hmm, Eine Idee was die Gelb markierten Stellen vom BMP Header bedeuten?
Die Farbtiefe steht eigentlich in 1C, aber wenn ich die Gelb markierten Stellen nicht auf diese Werte ändere ist das Bild angeblich 32/24 bittig, wird aber dennoch geometrisch richtig, aber eben mit Falschfarben dargestellt.
Die Bilddaten beginnen an Offset $46 und ich habe jetzt auf Anhieb keinen Header gefunden der in dieses Schema passt
PS. Die 32/16 Konvertierung sieht so aus:
Pic.P_arr[i2]^[i3]:=
=((bmp32^[i3][2] and $F8)shl 8 ) (Rot)
+((bmp32^[i3][1] and $FC)shl 3) (Grün)
+ (bmp32^[i3][0] shr 3); (Blau)
Program BMPPrep2;
Uses crt;
type BMP_Header=record
BM :word; {should be 'BM'} {00,01}
Size :longint; {02,03,04,05}
undef0 :longint; {should be 0} {06,07,08,09}
OFSOfData :longint; {0A,0B,0C,0D}
SizeofDibHead :longint; {0E,0F,10,11}
width :longint; {12,13,14,15}
height :longint; {16,17,18,19}
undef1 :word; {should be 1} {1A,1B}
Colordepth :word; {1C,1D}
undef02 :longint; {should be 0} {1E,1F,20,21}
imagesize :longint; {wdthxheight} {22,23,24,25}
undef03 :longint; {should be 0} {26,27,28,29}
undef04 :longint; {should be 0} {2a,2B,2C,2D}
NumberOfColors :longint; {2E,2F,30,31}
undefarr :array[0..87]of byte;
end;
type Pic_array=array[$0000..$3FFF]of word;
Pic_struc=record
P_arr:array[0..18]of ^Pic_array;
Size_x,Size_y:word;
Size:longint;
end;
type wordcountarray=array[$0000..$3FFF]of word;
Count_struc=record
color:^wordcountarray;
count:^wordcountarray;
end;
var Pic1,Pic2:Pic_struc;
var Pic1Count,Pic2Cound:array[0..3]of Count_struc;
function Loadpic(fname:String;var Pic:Pic_struc):boolean;
type BMP32harr=array[0..3]of byte;
type BMP32arr=array[$0000..$1FFF]of BMP32harr;
var head:BMP_Header;
f:file;
result:word;
i:longint;
i2,i3:word;
bmp32:^BMP32arr;
begin
assign(f,fname);
reset(f,1); {RecSize=1Byte, wichtig für Blockread}
if IoResult=0 then
begin;
blockread(f,head,SizeOf(head),result);
if result=SizeOf(head)then
begin
Writeln(head.width);
writeln(head.height);
writeln(head.colordepth);
If (head.width<65536) and (head.height<65536) then
begin;
seek(f,head.OFSOfData);
Pic.Size_X:=head.width;
Pic.Size_Y:=head.height;
Pic.Size:=head.width*head.height*2;
i:=Pic.Size;
i2:=0;
if head.colordepth=16 then
repeat
if Pic.P_arr[i2]=nil then new(Pic.P_arr[i2]);
Blockread(f,Pic.P_arr[i2]^,SizeOf(Pic.P_arr[i2]^),result);
inc(i2);
i:=i-result;
until EOF(f)or(i=0)or(i=19)
else if head.colordepth=32 then
begin
new(bmp32);
repeat
if Pic.P_arr[i2]=nil then new(Pic.P_arr[i2]);
Blockread(f,bmp32^,SizeOf(bmp32^),result);
i:=i-(result shr 1);
for i3:=0 to $1FFF do Pic.P_arr[i2]^[i3]:=((bmp32^[i3][2] and $F8)shl 8)
+((bmp32^[i3][1] and $FC)shl 3)
+ (bmp32^[i3][0] shr 3);
if (i<>0) and (result=SizeOf(bmp32^))then
begin
Blockread(f,bmp32^,SizeOf(bmp32^),result);
for i3:=0 to $1FFF do Pic.P_arr[i2]^[i3+$2000]:=((bmp32^[i3][2] and $F8)shl 8)
+((bmp32^[i3][1] and $FC)shl 3)
+ (bmp32^[i3][0] shr 3);
end;
inc(i2);
i:=i-(result shr 1);
until EOF(f)or(i=0)or(i=19);
dispose(bmp32);
end;
if i=0 then Loadpic:=true else LoadPic:=false;
{debug}
close(f);
assign(f,'debug.bmp');
rewrite(f,1);
head.OFSOfData:=$46;
head.colordepth:=16;
head.size:=$46+Pic.size;
head.SizeOfDibHead:=$38;
head.imagesize:=Pic.size;
blockwrite(f,head,$46,result);
for i2:=0 to 18 do if Pic.P_arr[i2]<>nil then blockwrite(f,Pic.P_arr[i2]^,SizeOf(Pic.P_arr[i2]^),result);
seek(f,head.size);
truncate(f);
end else Loadpic:=false;
end else Loadpic:=false;
close(f);
end else Loadpic:=false;
end;
var i:longint;
begin
for i:=0 to 18 do Pic1.P_arr[i]:=nil;
Pic2:=Pic1;
writeln(Loadpic('Test.bmp',Pic1));
readkey;
for i:=0 to 18 do
begin;
if Pic1.P_arr[i]<>nil then dispose(Pic1.P_arr[i]);
if Pic2.P_arr[i]<>nil then dispose(Pic2.P_arr[i]);
end;
end.
Alles anzeigen
