Palette eines monochromen TBitmap ändern / "reparieren"

[Schwedenbitter]

Hallo,

ich verwende in einem Programm monochrome Bitmaps. Diese werden als png-Dateien gespeichert und das wiederum scheint Probleme mit der Palette mit sich zu bringen. Grundsätzlich sind die Farben schwarz und weiß. Manchmal aber wird eine Farbe zu rot (128, 0, 0). Ich habe keine Ahnung warum.

Meine Idee ist nun, die Palette mit den 2 Einträgen zu laden. Ich prüfe, ob Eintrag null schwarz ist, falls ja, wird Eintrag zwei ggf. auf Weiß gesetzt. Falls Eintrag null weiß ist, wird Eintrag zwei ggf. auf Schwarz gesetzt. Soviel zur Theorie und hier mein Code:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
Var
  Colors  : Array [0..1] Of COLORREF;
Begin
  With TBitmap.Create Do
  Try
    LoadFromFile('C:\Seite_0006.bmp');
    GetPaletteEntries(Palette, 0, 2, Colors[0]); // aktuelle Palette laden
    If Colors[0] = rgb(0, 0, 0) Then             // Schwarz an Nr. 1 gefunden
    Begin
      ShowMessage('Schwarz an Nr. 1 gefunden.');
      If Colors[1] <> rgb(255, 255, 255) Then    // kein Weiß an Nr. 2
      Begin
        ShowMessage('Kein Weiß an Nr. 2 gefunden');
        Colors[1] := rgb(255, 255, 255);         // -> Weiß machen
      End;
    End;
    If Colors[0] = rgb(255, 255, 255) Then       // Weiß an Nr. 1 gefunden
    Begin
      ShowMessage('Weiß an Nr. 1 gefunden.');
      If Colors[1] <> rgb(0, 0, 0) Then          // kein Schwarz an Nr. 2
      Begin
        ShowMessage('Kein Schwarz an Nr. 2 gefunden.');
        Colors[1] := rgb(0, 0, 0);               // -> Schwarz machen
      End;
    End;
    SetPaletteEntries(Palette, 0, 2, Colors[0]); // neue Palette setzen
    SaveToFile('C:\Seite_0006_korrigiert.bmp');
  Finally
    Free;
  End;
End;

Leider sieht das Ergebnis genauso Schwarz/rot aus, wie das Ausgangsbild. Was mache ich da falsch?
Ich habe die Ergebnisse von GetPaletteEntries und SetPaletteEntries geprüft und mir wird jeweils eine 2 angezeigt. Laut Online-Hilfe würde im Fehlerfall eine 0 ausgegeben werden. Es kommen auch die Messages wie geplant...

Gruß, Alex

[mkinzler]

Handelt es sich wirklich um schwarz/weiss oder Graustufen?

[Schwedenbitter]

Zitat von mkinzler:

Handelt es sich wirklich um schwarz/weiss oder Graustufen?

Es sind keine Graustufen, sondern wirklich nur 2 Farben aber eben nicht schwarz/weiss, sondern schwarz/rot bzw. weiss/rot.
Mit einer Bildbearbeitungssoftware wird mir eine Palette bestehend aus 2 Einträgen angezeigt. Wenn ich mit dieser Software das Rot durch Weiß ersetze, klappt das auch. Ich möchte/muss aber dasselbe mit meinem Programm hinbekommen. Wenn ich mit GetPaletteEntries(Palette, 0, 256, Colors[0]); operiere, erhalte ich als Ergebnis auch nur eine 2 (das Array von Colors natürlich zuvor vergrößert), was meine Annahme m.E. bestätigt.

Ich habe mal ein Bild angehängt. Es muss leider entpackt werden. Ich wollte es aber gern exakt so zeigen, wie ich es geliefert bekomme.

[Schwedenbitter]

Ich habe mal ein bisschen weiter geforscht und dabei unter anderem das hier gefunden. Danach habe ich folgenden Code probiert, der aber leider nicht funktioniert. Ich bekomme entweder ein komplett schwarzes oder ein komplett weißes Bitmap, während ich maximal ein Negativ (also Schwarz = Weiß und Weiß = Schwarz) erwartet hätte:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
Var
  BWPalette   : TMaxLogPalette;
begin
  BWPalette.palVersion:=$0300;
  BWPalette.palNumEntries:=2;
  With BWPalette.palPalEntry[0] Do   // Schwarz
  Begin
    peRed:=  $00;
    peGreen:=$00;
    peBlue:= $00;
    peFlags:=$00;
  End;
  With BWPalette.palPalEntry[1] Do   // Weiß
  Begin
    peRed:=  $FF;
    peGreen:=$FF;
    peBlue:= $FF;
    peFlags:=$00;
  End;

  With TBitmap.Create Do
  Try
    LoadFromFile('Seite_0006.bmp');
    Palette:=CreatePalette(PLogPalette(@BWPalette)^);
    SaveToFile('Seite_0006_neu.bmp');
  Finally
    Free;
  End;
End;

Was mache ich denn falsch?
Ich dachte, endlich eine einfache und übersichtliche Lösung gefunden zu haben. Warum ist es denn so schwer zum Thema Mainpulation der Farbpalette in Delphi etwas im Netz zu finden?

Gruß, Alex

[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!