Delphi-PRAXiS - Delphi Direct2D.Canvas in einer Bitmap speichern

Seite 3 von 3

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)

- Multimedia (https://www.delphipraxis.net/16-multimedia/)

- - Delphi Direct2D.Canvas in einer Bitmap speichern (https://www.delphipraxis.net/212686-direct2d-canvas-einer-bitmap-speichern.html)

AW: Direct2D.Canvas in einer Bitmap speichern

Zitat:

Zitat von cocsy (Beitrag 1520610)

Ich vermute eine unterschiedliche Bit-Strucktur zw. Win32 und Win64. Auch wenn ich das als unlogisch empfinde.

Wenn die selbe API, dann zumindestens Speicher-Alignment.

AW: Direct2D.Canvas in einer Bitmap speichern

Kein Plan warum es genau mit SetDIBits scheitert, vielleicht stimmt was mit Pitch und Width nicht.
Aber ich habe den SaveToFile-Pfad von TBitmap nachgebastelt und kopiere jetzt den Buffer von mappedrect.bits zeilenweise in ein Byte-Array, was dann in einen Filestream geschrieben wird.
Den Umweg über das Array kann man sich ggf. sparen und gleich in den Stream schreiben. Es sei dem geneigten Leser als Hausaufgabe überlassen.
Damit klappt es auch unter 64-Bit in den meisten Formaten (Höhe x Breite):

Delphi-Quellcode:

			procedure DoSaveAsBitmapRaw(const ARenderTarget: ID2D1RenderTarget; ABitmapFileName: string = '');

var

    HR: HResult;

    DeviceContext: ID2D1DeviceContext;

    CopyBitmap: ID2D1Bitmap1;

    MapOptions: D2D1_MAP_OPTIONS;

    MappedRect: D2D1_MAPPED_RECT;

    SizeU: D2D1_SIZE_U;

    destPoint: D2D1_POINT_2U;

    srcRect: D2D1_RECT_U;

    BitmapProps: D2D1_BITMAP_PROPERTIES1;

    BitmapInfo: TBitmapInfo;

    MyBuffer: TBytes;

    Stream: TFileStream;

    I: Integer;

    BMF: TBitmapFileHeader;

    Colors: array [Byte] of TRGBQuad;

    ColorCount: Integer;

    HeaderSize: Integer;

    NewLine: Integer;

    Src: Pointer;

    Dst: Pointer;

    BufferSize: Integer;

    BytesPerPixel: Cardinal;

begin

    if Supports(ARenderTarget, ID2D1DeviceContext, DeviceContext) then

    begin

        DeviceContext.GetPixelFormat(BitmapProps._pixelFormat);

        if BitmapProps._pixelFormat.format = Winapi.DxgiFormat.DXGI_FORMAT_B8G8R8A8_UNORM then

        begin

            BytesPerPixel := 4;

        end else

            raise Exception.Create('Kümmere dich, hier stimmt was nicht!');

        DeviceContext.GetDpi(BitmapProps.dpiX, BitmapProps.dpiY);

        DeviceContext.GetPixelSize(SizeU);

        BitmapProps.bitmapOptions := D2D1_BITMAP_OPTIONS_CPU_READ or D2D1_BITMAP_OPTIONS_CANNOT_DRAW;

        HR := DeviceContext.CreateBitmap(SizeU, nil, 0, @BitmapProps, CopyBitmap);

        if Succeeded(HR) then

        begin

            FillChar(srcRect, SizeOf(srcRect), 0);

            srcRect.right := SizeU.Width;

            srcRect.bottom := SizeU.Height;

            FillChar(destPoint, SizeOf(destPoint), 0);

            HR := CopyBitmap.CopyFromRenderTarget(destPoint, DeviceContext, srcRect);

            if Succeeded(HR) then

            begin

                MapOptions := D2D1_MAP_OPTIONS_READ;

                FillChar(MappedRect, SizeOf(MappedRect), 0);

                HR := CopyBitmap.Map(MapOptions, MappedRect);

                if Succeeded(HR) and (MappedRect.bits <> nil) then

                begin

                    BufferSize := MappedRect.pitch * SizeU.Height;

                    Stream := TFileStream.Create(ABitmapFileName, fmCreate);

                    try

                        FillChar(BMF, SizeOf(BMF), 0);

                        HeaderSize := 40;

                        BMF.bfType := $4D42;

                        BMF.bfSize := BufferSize + HeaderSize + SizeOf(BMF);

                        BMF.bfOffBits := SizeOf(BMF) + HeaderSize;

                        Stream.Write(BMF, SizeOf(BMF));

                        FillChar(BitmapInfo, SizeOf(BitmapInfo), 0);

                        BitmapInfo.bmiHeader.biSize := SizeOf(BitmapInfo.bmiHeader);

                        BitmapInfo.bmiHeader.biHeight := -SizeU.Height;

                        BitmapInfo.bmiHeader.biWidth := Longint(MappedRect.pitch div BytesPerPixel);

                        BitmapInfo.bmiHeader.biPlanes := 1;

                        BitmapInfo.bmiHeader.biBitCount := 8 * BytesPerPixel;

                        BitmapInfo.bmiHeader.biCompression := BI_RGB;

                        Stream.WriteBuffer(BitmapInfo, Sizeof(BitmapInfo));

                        ColorCount := 0;

                        Stream.WriteBuffer(Colors, ColorCount * SizeOf(TRGBQuad));

                        SetLength(MyBuffer, BufferSize);

                        for I := 0 to SizeU.Height - 1 do

                        begin

                            NewLine := I * Integer(MappedRect.Pitch);

                            Src := Pointer(NativeInt(MappedRect.bits) + NewLine);

                            Dst := Pointer(NativeInt(@MyBuffer[0]) + NewLine);

                            Move(Src^, Dst^, NativeInt(SizeU.Width * BytesPerPixel));

                        end;

                        Stream.WriteBuffer((@MyBuffer[0])^, Length(MyBuffer));

                    finally

                        Stream.Free;

                    end;

                    CopyBitmap.Unmap;

                end;

            end;

        end;

    end;

end;

AW: Direct2D.Canvas in einer Bitmap speichern

Zitat:

Zitat von TiGü (Beitrag 1520628)

Kein Plan warum es genau mit SetDIBits scheitert, vielleicht stimmt was mit Pitch und Width nicht.

...

Delphi-Quellcode:

			...

                        NumberOfScanLinesCopied := SetDIBits(VCLBitmap.Canvas.Handle, VCLBitmap.Handle, 0, VCLBitmap.Height, MappedRect.bits,

                          BitmapInfo, DIB_RGB_COLORS);

...

Der Fehler von "SetDIBits" ist jetzt gelöst 8-)

Delphi-Quellcode:

			          const _DC = CreateCompatibleDC(0);

          Result := SetDIBits(_DC, ResBmap.Handle, 0, ResBmap.Height, mappedRect.bits, BmpInfo,

            DIB_RGB_COLORS) > 0;

Damit unter Win32 und Win64

___
ein ähnliches Problem gab es hier

https://stackoverflow.com/questions/...-fail-on-win64 mit der gleichen Lösung

AW: Direct2D.Canvas in einer Bitmap speichern

Hier noch einmal die Lösung zusammengefasst

Delphi-Quellcode:

			interface

uses

  Winapi.Windows, Winapi.D2D1, Winapi.DXGI, Winapi.DxgiFormat,

  System.SysUtils, System.Classes,

  Vcl.Graphics, Vcl.Direct2D;

type

  // This describes how the individual mapping operation should be performed.

  PD2D1_MAP_OPTIONS = ^D2D1_MAP_OPTIONS;

  D2D1_MAP_OPTIONS  = DWord;

{$EXTERNALSYM D2D1_MAP_OPTIONS}

const

  // The mapped pointer has undefined behavior.

  D2D1_MAP_OPTIONS_NONE = D2D1_MAP_OPTIONS(0); {$EXTERNALSYM D2D1_MAP_OPTIONS_NONE} // The mapped pointer can be read from.

  D2D1_MAP_OPTIONS_READ = D2D1_MAP_OPTIONS(1); {$EXTERNALSYM D2D1_MAP_OPTIONS_READ} // The mapped pointer can be written to.

  D2D1_MAP_OPTIONS_WRITE = D2D1_MAP_OPTIONS(2); {$EXTERNALSYM D2D1_MAP_OPTIONS_WRITE} // The previous contents of the bitmap are discarded when it is mapped.

  D2D1_MAP_OPTIONS_DISCARD = D2D1_MAP_OPTIONS(4); {$EXTERNALSYM D2D1_MAP_OPTIONS_DISCARD} // D2D1_MAP_OPTIONS_FORCE_DWORD = FORCEDWORD;

type

  // Specifies how the bitmap can be used.

  PD2D1_BITMAP_OPTIONS = ^D2D1_BITMAP_OPTIONS;

  D2D1_BITMAP_OPTIONS  = DWord; {$EXTERNALSYM D2D1_BITMAP_OPTIONS}

const

  // The bitmap is created with default properties.

  D2D1_BITMAP_OPTIONS_NONE = D2D1_BITMAP_OPTIONS($00000000);

  // The bitmap can be specified as a target in ID2D1DeviceContext.SetTarget

  D2D1_BITMAP_OPTIONS_TARGET = D2D1_BITMAP_OPTIONS($00000001);

  // The bitmap cannot be used as an input to DrawBitmap, DrawImage, in a bitmap

  // brush or as an input to an effect.

  D2D1_BITMAP_OPTIONS_CANNOT_DRAW = D2D1_BITMAP_OPTIONS($00000002);

  // The bitmap can be read from the CPU.

  D2D1_BITMAP_OPTIONS_CPU_READ = D2D1_BITMAP_OPTIONS($00000004);

  // The bitmap works with the ID2D1GdiInteropRenderTarget.GetDC API.

  D2D1_BITMAP_OPTIONS_GDI_COMPATIBLE = D2D1_BITMAP_OPTIONS($00000008);

  // D2D1_BITMAP_OPTIONS_FORCE_DWORD = FORCEDWORD;

type

    // Describes mapped memory from the ID2D1Bitmap1.Map API.

  PD2D1_MAPPED_RECT = ^D2D1_MAPPED_RECT;

  D2D1_MAPPED_RECT = record

    pitch : UINT32;

    bits : PByte;

  end;

  ID2D1Bitmap1 = interface(ID2D1Bitmap)

    ['{a898a84c-3873-4588-b08b-ebbf978df041}']

    // Retrieves the color context information associated with the bitmap.

    procedure GetColorContext(out colorContext : IInterface); stdcall;

    // Retrieves the bitmap options used when creating the API.

    function GetOptions() : D2D1_BITMAP_OPTIONS; stdcall;

    // Retrieves the DXGI surface from the corresponding bitmap, if the bitmap was

    // created from a device derived from a D3D device.

    function GetSurface(out dxgiSurface : IDXGISurface) : HResult; stdcall;

    // Maps the given bitmap into memory. The bitmap must have been created with the

    // D2D1_BITMAP_OPTIONS_CPU_READ flag.

    function Map(options : D2D1_MAP_OPTIONS; out mappedRect : D2D1_MAPPED_RECT) : HResult; stdcall;

    // Unmaps the given bitmap from memory.

    function Unmap() : HResult; stdcall;

  end;

  IID_ID2D1Bitmap1 = ID2D1Bitmap1;

  // Extended bitmap properties.

  PD2D1_BITMAP_PROPERTIES1 = ^D2D1_BITMAP_PROPERTIES1;

  D2D1_BITMAP_PROPERTIES1 = record

    _pixelFormat : D2D1_PIXEL_FORMAT;

    dpiX : Single;

    dpiY : Single;

    // Specifies how the bitmap can be used.

    bitmapOptions : D2D1_BITMAP_OPTIONS;

    colorContext : IInterface;

  end;

{$EXTERNALSYM D2D1_BITMAP_PROPERTIES1}

  // Interface ID2D1DeviceContext

  // ============================

  // The device context represents a set of state and a command buffer that is used

  // to render to a target bitmap.

  //

{$HPPEMIT 'DECLARE_DINTERFACE_TYPE(ID2D1DeviceContext);'}

{$EXTERNALSYM ID2D1DeviceContext}

  ID2D1DeviceContext = interface(ID2D1RenderTarget)

    ['{e8f7fe7a-191c-466d-ad95-975678bda998}']

    // Creates a bitmap with extended bitmap properties, potentially from a block of

    // memory.

    function CreateBitmap(size : D2D1_SIZE_U; sourceData : Pointer; pitch : UINT32;

      bitmapProperties : PD2D1_BITMAP_PROPERTIES1;

      out bitmap       : ID2D1Bitmap1) : HResult; stdcall;

  end;

function DoSaveAsBitmap(const ARenderTarget : ID2D1RenderTarget; out ResBmp : TBitmap) : Boolean;

implementation

function DoSaveAsBitmap(const ARenderTarget : ID2D1RenderTarget; out ResBmp : TBitmap) : Boolean;

var

  HR            : HResult;

  DeviceContext : ID2D1DeviceContext;

  CopyBmp       : ID2D1Bitmap1;

  mappedRect    : D2D1_MAPPED_RECT;

  SizeU         : D2D1_SIZE_U;

  destPoint     : D2D1_POINT_2U;

  srcRect       : D2D1_RECT_U;

  BmpProps      : D2D1_BITMAP_PROPERTIES1;

  BmpInfo       : TBitmapInfo;

begin

  Result := false;

  ResBmp := TBitmap.Create; // create vcl.bitmap

  if Supports(ARenderTarget, ID2D1DeviceContext, DeviceContext) then

  begin

    DeviceContext.GetPixelFormat(BmpProps._pixelFormat);

    DeviceContext.GetDpi(BmpProps.dpiX, BmpProps.dpiY);

    DeviceContext.GetPixelSize(SizeU);

    BmpProps.bitmapOptions := D2D1_BITMAP_OPTIONS_CPU_READ or D2D1_BITMAP_OPTIONS_CANNOT_DRAW;

    HR := DeviceContext.CreateBitmap(SizeU, nil, 0, @BmpProps, CopyBmp); // create CopyBmp : ID2D1Bitmap1

    if Succeeded(HR) then

    begin

      srcRect.left   := 0;

      srcRect.top    := 0;

      srcRect.right  := SizeU.Width;

      srcRect.bottom := SizeU.Height;

      destPoint.X := 0;

      destPoint.Y := 0;

      HR          := CopyBmp.CopyFromRenderTarget(destPoint, DeviceContext, srcRect); // copy pixel to  CopyBmp

      if Succeeded(HR) then

      begin

        HR := CopyBmp.Map(D2D1_MAP_OPTIONS_READ, mappedRect);

        if Succeeded(HR) then

        begin

          FillChar(BmpInfo, SizeOf(BmpInfo), 0);

          SizeU.Width                  := mappedRect.pitch div 4;

          BmpInfo.bmiHeader.biSize     := SizeOf(BmpInfo.bmiHeader);

          BmpInfo.bmiHeader.biHeight   := -SizeU.Height;

          BmpInfo.bmiHeader.biWidth    := SizeU.Width;

          BmpInfo.bmiHeader.biPlanes   := 1;

          BmpInfo.bmiHeader.biBitCount := 32;

          ResBmp.SetSize(SizeU.Width, SizeU.Height);

          ResBmp.PixelFormat := TPixelFormat.pf32bit;

          const _DC = CreateCompatibleDC(0);

          Result := SetDIBits(_DC, ResBmp.Handle, 0, ResBmp.Height, mappedRect.bits, BmpInfo, DIB_RGB_COLORS) > 0;

          CopyBmp.Unmap;

        end;

      end;

    end;

  end;

  if not Result then

    FreeAndNil(ResBmp);

end;

end.

einen Großen Dank an TiGü, er hat das gelöst, was die VCL nicht mitgebracht hat :thumb:

AW: Direct2D.Canvas in einer Bitmap speichern

Guter Fund auf Stack Overflow. :thumb:
Auf die Idee nach Problemen mit GetDIBits anstatt SetDIBits zu suchen bin ich nicht gekommen.
Mit der Erklärung von Heffernan, dass die "Parameter evaluation order is undefined and differs between x86 and x64.", erklärt sich dann auch alles.

Für meinen eigenen Coding Style würde ich aber auf erzeugende out-Parameter verzichten, sondern lieber eine Bitmap-Instanz reingeben und die füllen lassen.
Aber das kann ja jeder handhaben wie er möchte.

Man hätte auch eine Lösung mit WIC noch versuchen können, aber da hätte man noch viel mehr neue Definitionen von Direct2D 1.1 und ggf. höher reinziehen müssen.

AW: Direct2D.Canvas in einer Bitmap speichern

kleiner Nachtrag:
- Achtet auf den Compiler der Schalter für die "Record-Felder ausrichten" muss "Quad Word" sein...

Seite 3 von 3