Bitmap "auf die harte Tour" schreiben

[SirThornberry]

ich versteh irgendwie den aufwand nicht. Was spricht dagegen TBitmap zu verwenden dann mit "Scanline" die Adresse zu holen wo die Daten liegen und dann eben dort rein zu schreiben?

[turboPASCAL]

Ja ebend, so in der Art hätte ich dies realisiert.

Habe mal angefangen:

Delphi-Quellcode:

type
  TDigits = 0..1;

function CreateMonoBitmap(W, H: Integer): TBitmap;
begin
  Result := TBitmap.Create;
  with Result do
  begin
    Width := W;
    Height := H;
    PixelFormat := pf1Bit;
  end;
end;

var
  b: Byte;

procedure WritePixelToMonoBitmap(bmp: TBitmap; x,y: Integer; Value: TDigits);
var
  p: pByteArray;

begin
  p := pByteArray(bmp.Scanline[y]);
  // hier fehlt noch die umrechnung auf ein BIT
  p[x div 8] := Value zu BIT umrechnen;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  bitmap: TBitmap;
  x,y: byte;
begin
  // MonoBitmap erzeugen 
  bitmap := CreateMonoBitmap(100,100);

  // Diagonale auf's Test Bitmap zeichnen
  for y:=0 to 99 do
  begin
    WritePixelToMonoBitmap(bitmap, x, y, 0);
    inc(x);
  end;

  // Testanzeige
  Image1.Picture.Bitmap.Assign(bitmap);

  // Bitmap freigeben
  bitmap.Free;
end;

Leider Stelle ich mich bei der Umrechnung auf das einzelne Bit nicht geschickt genug an, so daa ich noch keinen rechten Erfolg hatte. Schleifen wollte ich nicht verwenden. Das muss auch mit Bit-Verschiebung gehen.
Wenn einer eine Idee hat kann er die mir mitteilen

[Muetze1]

Delphi-Quellcode:

procedure WritePixelToMonoBitmap(bmp: TBitmap; x,y: Integer; Value: TDigits);
var
  p: PByte;
  lIndex, lsBit: Integer;
begin
  p := pByteArray(bmp.Scanline[y]);
  // hier fehlt noch die umrechnung auf ein BIT

  lIndex := x Div 8;
  lBit := x Mod 8;

  Inc(p, lIndex); 

  If ( PixelSetzen ) Then
    p^ := p^ Or ( 1 Shl lBit )
  Else
    p^ := p^ And ( Not ( 1 Shl lBit ) );
end;

Ohne zu testen einfach mal so schnell getippt, sollte theoretisch genau das gesuchte machen...

Du musst natürlich noch dein Value vom Typ TDigits auf die If Abfragebedingung "PixelSetzen" ummünzen...

[turboPASCAL]

Danke, aber ich habe da immer noch einen Denkfehler. Das Bild wird noch nicht korr. gezeichnet...

// Edit:

Behoben, dank Hilfe von Muetze1.

Delphi-Quellcode:

procedure WritePixelToMonoBitmap(bmp: TBitmap; x,y: Integer; Value: TDigits);
var
  p: pByte;
  lIndex, lBit: Integer;
begin
  p := bmp.Scanline[y];

  lIndex := x Div 8;
  lBit := x Mod 8;

  Inc(p, lIndex);

    If Value = 1 Then
    p^ := p^ Or ( 1 Shl (7-lBit) )
  Else
    p^ := p^ And ( Not ( 1 Shl (7-lBit) ) );
end;

[turboPASCAL]

Tja nun kann ich meinen letzten Beitrag nicht mehr editieren. Wollte noch eine Demo anhängen.

[alcaeus]

Hallo Matti,

ich habe mir soeben mal deine Loesung (=Demoprojekt) angesehn. Gehe ich Recht in der Annahme, dass ich das Bild anschliessend normal mit TBitmap.SaveToFile speichern kann? Inwiefern ist die Operation zeitkritisch, also funktioniert sie schnell oder gibts da noch Optimierungsbedarf?

Greetz
alcaeus

PS: du schreibst 1000001 Pixel, nicht nur 1000000

[turboPASCAL]

Sehr schnell, die Pixel werden ja direkt in/aufs Bitmap geschrieben ohne ein Array oder sonst irgendetwas dazwischen. Ob es nun noch schneller währe ein Bitmap mit CreateBitmapIndirect zu erstellen und dem Bitmap ein Array of Bytes zuzuweisen glaube ich nicht.
Ich hatte es eigentlich so vor aber die Doku / Delphi zu CreateBitmapIndirect ist sehr dünn. Zudem habe ich auch noch keinen richtigen Erfolg vorweisen können. Du kannst getrost diese Version verwenden.

Bei dieser Version wird ein Bitmap (1Bit also Zweifarbig) normal mit TBitmap.Create erstellt, das ist für eine VCL- Anwendung iO. Bei dem lesen oder Schreiben einzelner Bits wird mit dem Scanline die entsprechende Y-Zeile gelesen und danach das passende Bit in dem entsprechende Byte gesetzt.

Da das Bitmap ist ein "VCL"-Bitmap ist kannst du das auch mit MyBitmap.SaveToFile speichern oder mit dem Gegenstück laden.

Bei dem erstellen des Bitmaps wird dies von der VCL vorinitialisiert, also von der Palette usw. so das du ein Bitmap er hältst was Weiß ist. Wenn ich Zeit finde schaue ich mir das mal genauer an um noch eine Option einzubauen die auch das Erstellen mit einem Schw. Hintergrund ermöglicht.

Ich habe festgestellt das die Funktion GetPixel... nicht korr. funktioniert, das muss ich noch mal ausbessern.

Was möchtest du denn gern machen eine Animation ?

Zitat von alcaeus:

PS: du schreibst 1000001 Pixel, nicht nur 1000000

Och der eine, der ist Zugabe gewesen.

[Muetze1]

Ich habe an dem Beispiel auch nochmal dran rumgespielt.

U.a. weiss ich nicht, warum die Palette bei ScanLine[] Zugriffen zurück gesetzt wird. Auch IgnorePalette bewirkt dabei nix. kA - fragt mich was anderes.

[turboPASCAL]

Vor dem "Zeichnen" der Bits stimmte die Palette noch, danach wurde diese "zurückgesetzt". Ich habe schon angefangen an mir zu zweifeln. Ich hatte dazu CreatePalette verwendet.

Wenn es aber alcaeus so reicht istes ja auch ok.

[Muetze1]

Jo, zur Not die Palette setzen vor dem abspeichern...