Bitmap "auf die harte Tour" schreiben

[alcaeus]

Hallo ihr,

ich habe ein Programm erstellt, in dem ich Monochrom-Bitmaps schreiben muss. Um nicht das Ganze erstmal auf einem Canvas oder Image zeichnen zu muessen, um es dann auf die Platte schreiben zu koennen, will ich die BMP-Datei selbst schreiben. Ich habe mir bereits Informationen ueber das BMP-Dateiformat geholt, mir fehlt es aber an der Zeit, das Ganze in Code umzuwandeln.
Kennt jemand eine Funktion, die mir genau das erledigt, also anhand von Daten in einem Array oder meinetwegen auch in einem TImage eine Bitmap-Datei schreibt? Mir geht es dabei nur um die Schreibfunktion, anpassen wuerde ich sie auch selbst. Natuerlich sollte das Ganze schon auf Monochrom sein, da ich nicht mehr als 2 Farben brauche.

Schonmal Danke :)

Greetz
alcaeus

[turboPASCAL]

Du willst in einem Array die Nullen und Einzen für's Bitmap selber setzen, so in der Art ? :gruebel:

[alcaeus]

Ja, genau. In einem Array, einem String, whatever. Das muesste ich sowieso machen, da die Funktion die ich bastle nicht auf ein Image angewiesen sein soll, sondern eben ein Array oder einen String zurueckgibt. Deshalb will ich auch nicht den Umweg ueber das Image gehn sondern direkt schreiben.

Greetz
alcaeus

[markusj]

Ich hab sowas for kurzem im Rahmen eines Projektes gemacht ... Bitmaps laden und speichern und mit einm Array of Array of Array[1..3] of Array[0..7] of Boolean arbeitet ..Bitweiser zugrif für jeden Pixel+Farbwert.

Soll ichs mal ausgraben??

mfG

Markus

[alcaeus]

Ja bitte, das waere super :)

Greetz
alcaeus

[alcaeus]

Super, danke, ich werde mir das mal morgen vorknoepfen :)

Greetz
alcaeus

[markusj]

Ach ja, ich möcht dich bitte, den Code nachdem du ihn nicht mehr brauchst, zu entfernen/auszublenden und ihn auch (vorerst) nicht in die Code-Libary zu stellen,
da ich an dieser Facharbeit noch arbeite, und das teilweise auszüge aus meinem Code sind ^^
Später werde ich das Projekt vorstellen, dann dürft ihr euch frei daran bedienen :wink:

mfG

Markus

EDIT: Merci, ich schätze, dass er spätestens zum 1.6 wieder freigegeben werden kann *g* Wenn ich meine Facharbeit bewertet hab, geb ich alles hier in einen extra Fred ... ich verrate nur soviel: es hat etwas mit Verschlüsselungen zu tun ... ciao, Markus

[alcaeus]

Ich habe den Beitrag soeben ausgeblendet. Danke dass du ihn mir doch zur Verfuegung gestellt hast :)

Greetz
alcaeus

[dizzy]

Auf www.wotsit.org finden sich zudem massenhaft Definitionen zu diversen Dateitypen. BMPs sollten da gut vertreten sein, so dass man mit Hilfe dieser, sich eine eigene binäre Schreibfunktion basteln könnte.

[alcaeus]

Moin dizzy,

ja, die Definition habe ich bereits studiert, jedoch fehlt mir die Zeit, eine eigene Schreibroutine fuer das Format zu schreiben, d.h. Header usw. korrekt zu schreiben ;)

Greetz
alcaeus

[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 :mrgreen:

[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 :mrgreen:

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

Zitat von alcaeus

PS: du schreibst 1000001 Pixel, nicht nur 1000000 :mrgreen:

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...

[alcaeus]

Moin moin,

also das Erstellen, Schreiben der Bits und Speichern funktioniert schon ganz gut, allerdings stolpere ich ueber den Fehler in GetPixelFromBitmap(). Matti, hast du dafuer schon eine Loesung oder soll ich mich da mal ransetzen?

Greetz
alcaeus

[turboPASCAL]

Jaja, da hab ich nicht richtig nachgedacht. Da steckt ein Fehler drinn.

Nutze die von Muetze1, die passt einfach genial. ;)

Delphi-Quellcode:

function GetPixelFromMonoBitmap(bmp: TBitmap; x, y: Integer): TDigits;
var
  lPixel: pByte;
  lBit: Integer;
begin
  lPixel := bmp.Scanline[y];  // Pixelline holen
  Inc(lPixel, x div 8); // welches Byte

  lBit := x mod 8; // in welchem Byte ist der Bit der das Pixel ist
  
  // ist Pixel (0 oder 1) und Bit im Byte > 1 dann Pixel gesetzt (1)
  If ( lPixel^ and ( 1 shl (7 - lBit))) > 0 Then Result := 1
    // ist Pixel (0 oder 1) und Bit im Byte < 1 dann Pixel nicht gesetzt (0)
    Else Result := 0;
end;

Kommentiert, hoffentlich richtig. :mrgreen:

[SirThornberry]

effektiver ist es einfach mit scanline einen Pointer auf die letzte Zeile einmalig zu holen und dann damit weiter zu arbeiten. Es ist völlig überflissig sich mit scanline jedesmal die Zeile zu holen, denn hinter der letzten zeile folgt die vorletzte etc.

[turboPASCAL]

Mach mal vor ?! ;) (wie ist das gemeint, für Dummis)

Äh, du meinst immer eine Zeile komplett zu bearbeiten, also wo sich Scanline gerade befindet ?

[SirThornberry]

es ist einfach ineffektiv bei jedem aufruf Scanline erneut zu nutzen. Es reicht wenn man ein einziges mal scanline benutzt und sich den Rückgabewert merkt. Anschließend kann man von diesem Wert ausgehend auf die anderen Bytes zugreifen.
Ich meinte nicht immer eine Zeile komplett zu bearbeiten. Ich meinte wirklich nur einmal scanline zu nutzen.

Zur Veranschauligung hier mal meine Unit die ich für schnelle Zugriffe nutze:

Delphi-Quellcode:

interface

uses
  windows, graphics;

type
  TBmpFast = class(TObject)
  private
    fFirstLine: Pointer;
    fHeight  : Cardinal;
    fLineSize: Cardinal;
    fWidth   : Cardinal;
  public
    constructor Create;

    property Height: Cardinal read fHeight;

    function GetByte(X, Y: Word): PByte;
    function GetRGBTriple(X, Y: Word): PRGBTriple;
    function GetRGBQuad(X, Y: Word): PRGBQuad;
    procedure Init(ABmp: TBitmap; ABitsPerPixel: Byte);
  end;


implementation

constructor TBmpFast.Create;
begin
  inherited Create;
  fFirstLine := nil;
  fLineSize  := 0;
end;

function TBmpFast.GetByte(X, Y: Word): PByte;
begin
  result := PByte(Cardinal(fFirstLine) - (fLineSize * Y) + X);
end;

function TBmpFast.GetRGBTriple(X, Y: Word): PRGBTriple;
begin
  result := PRGBTriple(Cardinal(fFirstLine) - (fLineSize * Y) + (X * 3));
end;

function TBmpFast.GetRGBQuad(X, Y: Word): PRGBQuad;
begin
  result := PRGBQuad(Cardinal(fFirstLine) - (fLineSize * Y) + (X * 4));
end;

procedure TBmpFast.Init(ABmp: TBitmap; ABitsPerPixel: Byte);
begin
  fHeight    := ABmp.Height;
  fWidth     := ABmp.Width;
  fFirstLine := ABmp.ScanLine[0];
  fLineSize  := BytesPerScanline(fWidth, ABitsPerPixel, 32);
end;

end.

Ich rufe einfach die Init-methode auf un darin wird ein mal Scanline aufgerufen. Die zugriffe auf das Pixel X,Y erfolgen anschließend mit Berechnungen der Werte die bei Init ermittelt wurden. Also ohne erneutes Aufrufen von Scanline. Und somit mehr performance weil nicht jedes mal das ausgeführt wird was in der Scanlinefunktion eben so von statten geht.