Direct2D.Canvas in einer Bitmap speichern

[TiGü]

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;