Also wenn ich's hier ausprobiere, dann ist der Rotstich zwar nicht mehr so drastisch wie bei dir aber immer noch da.
Delphi-Quellcode:
procedure TForm1.LoadKBM(const Filename: string; Bitmap: TBitmap);
const
kbmWidth = 256;
kbmHeight = 5 * 64;
type
TBitmapInfo8 = packed record
bmiHeader: TBitmapInfoHeader;
bmiColors: array [0 .. 255] of TRgbQuad;
end;
var
bfh: TBitmapFileHeader;
bih: TBitmapInfo8;
strm: TMemoryStream;
fils: TFileStream;
c, r, g, b: integer;
begin
FillChar(bfh, SizeOf(bfh), 0);
with bfh do
begin
bfType := $4D42;
bfSize := SizeOf(bfh) + SizeOf(bih) + kbmWidth * kbmHeight;
bfOffBits := SizeOf(bfh) + SizeOf(bih);
end;
FillChar(bih, SizeOf(bih), 0);
with bih.bmiHeader do
begin
biSize := SizeOf(TBitmapInfoHeader);
biWidth := kbmWidth;
biHeight := -kbmHeight;
biPlanes := 1;
biBitCount := 8;
biCompression := BI_RGB;
biSizeImage := kbmWidth * kbmHeight;
biClrUsed := 256;
end;
for c := 0 to 255 do
begin
b := 1 * ((( c and 7) * 255) div 7);
g := 1 * ((((c shr 3) and 7) * 255) div 7);
r := 1 * (((((c shr 5) and 6) or ((c and 1) and ((c shr 3) and 1))) * 255) div 7);
with bih.bmiColors[c] do
begin
rgbBlue := b;
rgbGreen := g;
rgbRed := r;
end;
end;
strm := TMemoryStream.Create;
try
strm.WriteBuffer(bfh, SizeOf(bfh));
strm.WriteBuffer(bih, SizeOf(bih));
fils := TFileStream.Create(Filename, fmOpenRead or fmShareDenyWrite);
try
fils.Position := 16;
strm.CopyFrom(fils, kbmWidth * kbmHeight);
finally
fils.Free;
end;
strm.Position := 0;
Bitmap.LoadFromStream(strm);
strm.SaveToFile(ChangeFileExt(Filename, '.bmp'));
finally
strm.Free;
end;
end;
Man muss irgendwie das fehlende Bit in ROT so anpassen, dass es zu den anderen Farben passt - intern werden die wahrscheinlich eine dafür angepasste Palette nehmen.
Du kannst in dem Ausdruck
((c and 1) and ((c shr 3) and 1))
ein wenig herumspielen, um das fehlende Rot-Bit aus den anderen beiden zu holen.
Varianten:
Delphi-Quellcode:
((c and 1))
(((c shr 3) and 1))
((c and 1) or ((c shr 3) and 1))