AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi Lese PByte in TBitmap

Lese PByte in TBitmap

Ein Thema von itblumi · begonnen am 21. Okt 2022 · letzter Beitrag vom 22. Okt 2022
Antwort Antwort
itblumi

Registriert seit: 28. Mär 2009
73 Beiträge
 
Delphi XE6 Professional
 
#1

Lese PByte in TBitmap

  Alt 21. Okt 2022, 14:18
Hallo Liebe Community,

wie der Titel schon beschreibt versuche einen Pointer auf ein ByteArray(dieser wird von einer externen Komponente(dll) erzeugt) in ein Bitmap einzulesen.
Dazu benutze ich die Windows API Funktion SetDIBits und fülle zuvor den BmpInfoHeader. Das Ganze funktioniert unter 32-Bit wunderbar und das Bitmap wird in der TImage Komponente dargestellt.
Sobald ich das Programm unter 64-Bit kompiliere und die Daten anzeigen möchte sieht das Bitmap etwas schief aus. An der externen Komponente kann es nicht liegen, da diese das Bild richtig darstellen kann.

Ermitteln des DisplayFormat's vom Desktop
Code:
var
  DC: HDC;
  Depth: Integer;
begin
  FDisplayFormat := DISPLAY_COLORS_NATIVE or DISPLAY_ALPHA_NONE or
              DISPLAY_DEPTH_1 or DISPLAY_LITTLEENDIAN or DISPLAY_BOTTOMFIRST;
  DC := GetDC(0);   //* get hdc for desktop */
  try
    depth := GetDeviceCaps(DC, PLANES) * GetDeviceCaps(DC, BITSPIXEL);
    if (FDDpi = 0) then
      FDDpi := GetDeviceCaps(DC, LOGPIXELSY);
    if (depth = 32) then
    begin
      FDisplayFormat := DISPLAY_COLORS_RGB or DISPLAY_UNUSED_LAST or
                DISPLAY_DEPTH_8 or DISPLAY_LITTLEENDIAN or DISPLAY_BOTTOMFIRST;
    end else
    if (depth = 16) then
    begin
      FDisplayFormat := DISPLAY_COLORS_NATIVE or DISPLAY_ALPHA_NONE or
                DISPLAY_DEPTH_16 or DISPLAY_LITTLEENDIAN or DISPLAY_BOTTOMFIRST or
                DISPLAY_NATIVE_555;
    end else
    if (depth > 8) then
    begin
      FDisplayFormat := DISPLAY_COLORS_RGB or DISPLAY_ALPHA_NONE or
                DISPLAY_DEPTH_8 or DISPLAY_LITTLEENDIAN or DISPLAY_BOTTOMFIRST;
    end else
    if (depth >= 8) then
    begin
      FDisplayFormat := DISPLAY_COLORS_NATIVE or DISPLAY_ALPHA_NONE or
                DISPLAY_DEPTH_8 or DISPLAY_LITTLEENDIAN or DISPLAY_BOTTOMFIRST;
    end else
    if (depth >= 4) then
      FDisplayFormat := DISPLAY_COLORS_NATIVE or DISPLAY_ALPHA_NONE or
                DISPLAY_DEPTH_4 or DISPLAY_LITTLEENDIAN or DISPLAY_BOTTOMFIRST;
  finally
    DeleteDC(DC);
  end;
end;
Erstellen des BmpInfoHeader
Code:
begin
  FBmpInfoHeader.biSize := SizeOf(BmpInfoHeader);
  FBmpInfoHeader.biHeight := AHeight;
  FBmpInfoHeader.biWidth := AWidth;

  FBmpInfoHeader.biPlanes := 1;
  case (FGS_Format and DISPLAY_COLORS_MASK) of
    DISPLAY_COLORS_NATIVE:
      case (FGS_Format and DISPLAY_DEPTH_MASK) of
        DISPLAY_DEPTH_1:
        begin
          FBmpInfoHeader.biBitCount := 1;
          FBmpInfoHeader.biClrUsed := 2;
          FBmpInfoHeader.biClrImportant := 2;
        end;
        DISPLAY_DEPTH_4:
        begin
          FBmpInfoHeader.biBitCount := 4;
          FBmpInfoHeader.biClrUsed := 16;
          FBmpInfoHeader.biClrImportant := 16;
        end;
        DISPLAY_DEPTH_8:
        begin
          FBmpInfoHeader.biBitCount := 8;
          FBmpInfoHeader.biClrUsed := 96;
          FBmpInfoHeader.biClrImportant := 96;
        end;
        DISPLAY_DEPTH_16:
        begin
          if (FGS_Format and DISPLAY_ENDIAN_MASK) = DISPLAY_BIGENDIAN then
          begin
            FBmpInfoHeader.biBitCount := 24;
            FBmpInfoHeader.biClrUsed := 0;
            FBmpInfoHeader.biClrImportant := 0;
          end else
          begin
            FBmpInfoHeader.biBitCount := 16;
            FBmpInfoHeader.biClrUsed := 0;
            FBmpInfoHeader.biClrImportant := 0;
          end;
        end;
        else exit;
    end;
    DISPLAY_COLORS_GRAY:
      case (FGS_Format and DISPLAY_DEPTH_MASK) of
        DISPLAY_DEPTH_1:
        begin
          FBmpInfoHeader.biBitCount := 1;
          FBmpInfoHeader.biClrUsed := 2;
          FBmpInfoHeader.biClrImportant := 2;
        end;
        DISPLAY_DEPTH_4:
        begin
          FBmpInfoHeader.biBitCount := 4;
          FBmpInfoHeader.biClrUsed := 16;
          FBmpInfoHeader.biClrImportant := 16;
        end;
        DISPLAY_DEPTH_8:
        begin
          FBmpInfoHeader.biBitCount := 8;
          FBmpInfoHeader.biClrUsed := 256;
          FBmpInfoHeader.biClrImportant := 256;
        end;
        else exit; //TODO: raise an error
    end;
    DISPLAY_COLORS_RGB:
    begin
      if (FGS_Format and DISPLAY_DEPTH_MASK) <> DISPLAY_DEPTH_8 then
        exit;
      if (((FGS_Format and DISPLAY_ALPHA_MASK) = DISPLAY_UNUSED_LAST)and
          ((FGS_Format and DISPLAY_ENDIAN_MASK) = DISPLAY_LITTLEENDIAN)) then
      begin
        FBmpInfoHeader.biBitCount := 32;
        FBmpInfoHeader.biClrUsed := 0;
        FBmpInfoHeader.biClrImportant := 0;
      end else
      begin
        FBmpInfoHeader.biBitCount := 24;
        FBmpInfoHeader.biClrUsed := 0;
        FBmpInfoHeader.biClrImportant := 0;
      end;
    end;
    DISPLAY_COLORS_CMYK:
    begin
      FBmpInfoHeader.biBitCount := 24;
      FBmpInfoHeader.biClrUsed := 0;
      FBmpInfoHeader.biClrImportant := 0;
      //TODO: covert it ->dwing.c
    end;
    DISPLAY_COLORS_SEPARATION:
    begin
      FBmpInfoHeader.biBitCount := 24;
      FBmpInfoHeader.biClrUsed := 0;
      FBmpInfoHeader.biClrImportant := 0;
    end;
  end;
  FBmpInfoHeader.biCompression := 0;
  FBmpInfoHeader.biSizeImage := 0;
  FBmpInfoHeader.biXPelsPerMeter := 0;
  FBmpInfoHeader.biYPelsPerMeter := 0;
Lese den Pointer in ein Bitmap ein
Code:
var
  ABmpInfo: BITMAPINFO;
  AImg: TBitmap;
begin
  if (Assigned(PImage)) then
  begin
    Self.Width := FBmpInfoHeader.biWidth;
    Self.Height := FBmpInfoHeader.biHeight;
    ABmpInfo.bmiHeader := FBmpInfoHeader;
    FGS_ImageDataLoaded := (SetDIBits(0, Self.Handle, 0,
                                      Abs(FBmpInfoHeader.biHeight),
                                      PImage, ABmpInfo, DIB_RGB_COLORS)) > 0;
  end;
end;
Die letzten beiden Funktionen befinden sich dabei in einer abgeleiteten Klasse von TBitmap.

Was mich hier hauptsächlich interessieren würde ist, ob es an den Format Einstellungen liegen kann oder an den Daten?
Ich hatte zuvor schon einen Fehler gefunden in dem ich einen Format Fehler hatte und das Bitmap wurde schwarz/weiß dargestellt.
Dieser Fehler ist auch nur unter 64-Bit aufgetreten!

PS: Ich würde gern diese Umsetzung ohne weitere externe Komponenten durch führen!

Viele Grüße
Jan
Miniaturansicht angehängter Grafiken
screenshot_schief.png   screenshot_normal.png  
Jan
Ein neuer Tag bringt so einiges mit sich. Was auch immer es ist, es bleibt ein kleines Abenteuer.

Geändert von itblumi (21. Okt 2022 um 14:24 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu
Online

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.114 Beiträge
 
Delphi 12 Athens
 
#2

AW: Lese PByte in TBitmap

  Alt 21. Okt 2022, 14:43
Im TBitmap sind Zeilen 4Byte-Aligned,
aber ich glaube im DIBits nicht, bzw. zumindestens nicht in deinen PByte's.

Du müsstest also entweder in die Daten vorher die nötigen Ausrichtngs-Bytes einfügen
oder jede Zeile einzeln kopieren
oder dafür sorgen, dass es automatisch "ohne" Alignment ausgerichtet ist.

z.B. BitCount=32 oder eine Anzahl an Spalten, welche mit (BitCount/8) multipiziert immer Faktor 4 ergibt.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests

Geändert von himitsu (21. Okt 2022 um 16:20 Uhr)
  Mit Zitat antworten Zitat
itblumi

Registriert seit: 28. Mär 2009
73 Beiträge
 
Delphi XE6 Professional
 
#3

AW: Lese PByte in TBitmap

  Alt 21. Okt 2022, 15:57
Im TBitmap sind Zeilen 4Byte-Aligned,
aber ich glaube im DIBits nicht, bzw. zumindestens nicht in deinen PByte's.

Du müsstest also entweder in die Daten vorher die nötigen Ausrichtngs-Bytes einfügen
oder jede Zeile einzeln kopieren
oder dafür sorgen, dass es automatisch "ohne" Alignment ausgerichtet ist.

z.B. BitCount=32 oder eine Anzahl an Spalten, welche mit (BitCount/8) multipiziert immer 4 ergibt.
Hallo himitsu,

danke für deine Antwort. Der BitCount im BmpInfoHeader wird auf 32 gesetzt. In diesem Fall landet er in diesem Bereich
Code:
    DISPLAY_COLORS_RGB:
    begin
      if (FGS_Format and DISPLAY_DEPTH_MASK) <> DISPLAY_DEPTH_8 then
        exit;
      if (((FGS_Format and DISPLAY_ALPHA_MASK) = DISPLAY_UNUSED_LAST)and
          ((FGS_Format and DISPLAY_ENDIAN_MASK) = DISPLAY_LITTLEENDIAN)) then
      begin // Dieser BmpInfoHeader wird verwendet
        FBmpInfoHeader.biBitCount := 32;
        FBmpInfoHeader.biClrUsed := 0;
        FBmpInfoHeader.biClrImportant := 0;
      end else
      begin
        FBmpInfoHeader.biBitCount := 24;
        FBmpInfoHeader.biClrUsed := 0;
        FBmpInfoHeader.biClrImportant := 0;
      end;
    end;
Ich werde mir mal das Ganze genauer anschauen und versuche die Zeilen einzeln zu kopieren.
Jan
Ein neuer Tag bringt so einiges mit sich. Was auch immer es ist, es bleibt ein kleines Abenteuer.
  Mit Zitat antworten Zitat
jziersch

Registriert seit: 9. Okt 2003
Ort: München
240 Beiträge
 
Delphi 10.4 Sydney
 
#4

AW: Lese PByte in TBitmap

  Alt 22. Okt 2022, 10:00
Echt einfach geht das wenn Du Dir eine TBitmap mit 32 oder 24 bit erstellst und über entsprechende pointer alle Scanlines[] abarbeitest. Dabei kannst Du auch eine RGB BGR Umwandlung machen, sofern erforderlich.
WPCubed GmbH
Komponenten für Delphi:
WPTools, wPDF, WPViewPDF
  Mit Zitat antworten Zitat
itblumi

Registriert seit: 28. Mär 2009
73 Beiträge
 
Delphi XE6 Professional
 
#5

AW: Lese PByte in TBitmap

  Alt 22. Okt 2022, 19:26
Echt einfach geht das wenn Du Dir eine TBitmap mit 32 oder 24 bit erstellst und über entsprechende pointer alle Scanlines[] abarbeitest. Dabei kannst Du auch eine RGB BGR Umwandlung machen, sofern erforderlich.
Nach dem jziersch geschrieben hatte das dies "echt einfach geht", hat mich der Eifer gepackt und ich habe das Ganze dann mal "fix" umgesetzt.
Mir ist dann auch noch aufgefallen das ich von der externen Komponente den Raster mit geliefert bekomme und habe diesen dann genutzt um die
Bytes dementsprechend in das Bitmap zu kopieren. Im Endeffekt war der Raster in diesem Fall um 4 Bytes länger als der errechnet Wert von
BytesPerScanline und dieser hat im Bild die Verschiebung verursacht.

Hier ist das Ergebnis:
Code:
var
  ABmpInfo: BITMAPINFO;
  DestBytes: PByte;
  i, AByteWidth, Row: Integer;
begin
  if (Assigned(PImage)) then
  begin
    // initialize the size of the image
    SetSize(FBmpInfoHeader.biWidth, FBmpInfoHeader.biHeight);
    // only use the raster when the calculated ByteWidth is different
    if (FGS_Raster <> FByteWidth) then
    begin
      // get the PixelFormat from the BITMAPINFOHEADER
      PixelFormat := GetPixelFormatFromBMIH;
      // we have to use the raster to get the correct length of a line
      AByteWidth := FGS_Raster;
      for i := 0 to FBmpInfoHeader.biHeight - 1 do
      begin
        // get the pointer to the image data of the bitmap line
        DestBytes := Scanline[i];
        // In Windows we will paint the image bottom first, so we need to start
        // at the last row and end at the first row
        Row := FBmpInfoHeader.biHeight - 1 - i;
        // copy the image memory to the bitmap memory
        CopyMemory(DestBytes, PImage + AByteWidth * Row, AByteWidth);
        // convert if needed
        //TODO: implement convert functions
      end;
    end else
    begin
      ABmpInfo.bmiHeader := FBmpInfoHeader;
      FGS_ImageDataLoaded := (SetDIBits(0, Handle, 0, Abs(FBmpInfoHeader.biHeight),
                                        PImage, ABmpInfo, DIB_RGB_COLORS)) > 0;
    end;
  end;
end;
Für meinen Fall bekomme ich jetzt auch das richtige Ergebnis. Es gibt aber einen Punkt in dem ich mir nicht sicher bin und dies betrifft
das TBitmap.PixelFormat dieses ermittele ich über den biBitCount der zuvor gesetzt wurden ist.

Hier noch die Funktion um das PixelFormat zu ermitteln
Code:
function TGS_Image.GetPixelFormatFromBMIH: TPixelFormat;
begin
  case (FBmpInfoHeader.biBitCount) of
    1: Result := pf1bit;
    4: Result := pf4bit;
    8: Result := pf8bit;
    15: Result := pf15bit;
    16: Result := pf16bit;
    24: Result := pf24bit;
    32: Result := pf32bit;
    else
      Result := pfDevice;
  end;
end;
Jan
Ein neuer Tag bringt so einiges mit sich. Was auch immer es ist, es bleibt ein kleines Abenteuer.

Geändert von itblumi (22. Okt 2022 um 19:32 Uhr)
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 20:12 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz