Thema: Delphi Lese PByte in TBitmap

Einzelnen Beitrag anzeigen

itblumi

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

Lese PByte in TBitmap

  Alt 21. Okt 2022, 15: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 15:24 Uhr)
  Mit Zitat antworten Zitat