Palette eines monochromen TBitmap ändern / "reparieren"

[Schwedenbitter]

Leider kann ich hier nicht direkt auf den 2. Eintrag verlinken. Aber dieser hat mich auf die Lösung gebracht. Wenn GreyScale geht, dann muss es auch mit black/white gehen und siehe da, dieser Code macht was ich brauche:

Delphi-Quellcode:

Procedure CleanBlackWhite(Bitmap: TBitmap);
Type
  TMinPalette  = Packed Record // statt TMaxLogPalette - wir wollen Speicher sparen
                   palVersion    : Word;
                   palNumEntries : Word;
                   palPalEntry   : Array [0..1] Of TPaletteEntry;
                 End;
Var
  bmpBW        : TBitmap;
  I, J         : Integer;
  RowBW, RowO  : pByteArray;
  PaletteBW    : TMinPalette;
Begin
  If Bitmap.PixelFormat <> pf1bit Then Exit; // keine anderen Bitmaps bearbeiten

  bmpBW:=TBitMap.Create;
  Try
    bmpBW.HandleType:=bmDIB;
    bmpBW.PixelFormat:=pf1bit;
    bmpBW.Width:=Bitmap.Width;
    bmpBW.Height:=Bitmap.Height;
    With PaletteBW Do
    Begin
      palVersion:=$0300;
      palNumEntries:=2;
      palPalEntry[0].peRed:=  $00;
      palPalEntry[0].peGreen:=$00;
      palPalEntry[0].peBlue:= $00;
      palPalEntry[0].peFlags:=PC_RESERVED;
      palPalEntry[1].peRed:=  $FF;
      palPalEntry[1].peGreen:=$FF;
      palPalEntry[1].peBlue:= $FF;
      palPalEntry[1].peFlags:=PC_RESERVED;
    End;
    bmpBW.Palette:=CreatePalette(pLogPalette(@PaletteBW)^);

    For J:=0 To Pred(bmpBW.Height) Do
    Begin
      RowBW:=bmpBW.Scanline[J];
      RowO :=Bitmap.Scanline[J];
      For I:=0 To Pred(bmpBW.Width) Do RowBW[I]:=RowO[I];
    End;
    Bitmap.Assign(bmpBW);
  Finally
    bmpBW.Free;
  End;
End;

Mich ärgert nur, dass ich jeden Pixel einzeln durchgehen muss. Ich gehe davon aus, dass dies trotz Scanline viel Zeit in Anspruch nimmt. Ich bin daher immer noch an einer schnelleren, alternativen Lösung interessiert, die darauf basiert, einfach die Palette zu ändern.

Selbstverständlich kann man schwarz und weiß auch durch rot und grün oder ähnliches ersetzen - wer's braucht!