Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi Lese PByte in TBitmap (https://www.delphipraxis.net/211681-lese-pbyte-tbitmap.html)

itblumi 21. Okt 2022 14:18


Lese PByte in TBitmap
 
Liste der Anhänge anzeigen (Anzahl: 2)
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

himitsu 21. Okt 2022 14:43

AW: Lese PByte in TBitmap
 
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.

itblumi 21. Okt 2022 15:57

AW: Lese PByte in TBitmap
 
Zitat:

Zitat von himitsu (Beitrag 1513630)
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.

jziersch 22. Okt 2022 10:00

AW: Lese PByte in TBitmap
 
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.

itblumi 22. Okt 2022 19:26

AW: Lese PByte in TBitmap
 
Zitat:

Zitat von jziersch (Beitrag 1513654)
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;


Alle Zeitangaben in WEZ +1. Es ist jetzt 18:11 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