Direct2D.Canvas in einer Bitmap speichern

[cocsy]

Hallo Leute,

ich möchte eine mittels Direct2D gezeichneten Fläche in einer Bitmap (oder anderen Graphik) speichern.

Meine Bemühungen sind bisher ins leere gelaufen und bin daher für Ideen offen.

Delphi-Quellcode:

TDirect2DCanvas.CreateBitmap // liefert zwar ein Interface "ID2D1Bitmap" ich kann damit aber nicht viel anfangen

vielen Dank für eure Hilfe ;)

[Union]

Die von Dir angegebene Methode ist auch für das Schreiben einer Bitmap in den 2d Canvas.

[Olli73]

Das neue Bing sagt u.a. das hier:

Delphi-Quellcode:

procedure SaveDirect2DCanvasAsPNG(const FileName: string; const Canvas: TDirect2DCanvas);
var
  png: TPngImage;
begin
  png := TPngImage.CreateBlank(COLOR_RGBALPHA, 8,
    Canvas.RenderTarget.Size.Width,. 
    Canvas.RenderTarget.Size.Height);
  try
    Canvas.RenderTarget.GetPixelData(PixelFormat32bppPBGRA,
      png.Scanline[0], png.Height * png.BytesPerScanline);
    png.SaveToFile(FileName);
  finally
    png.Free;
  end;
end;

[cocsy]

Zitat:

Zitat von Olli73 (Beitrag 1519965)

Das neue Bing sagt u.a. das hier:

Delphi-Quellcode:

procedure SaveDirect2DCanvasAsPNG(const FileName: string; const Canvas: TDirect2DCanvas);
var
  png: TPngImage;
begin
  png := TPngImage.CreateBlank(COLOR_RGBALPHA, 8,
    Canvas.RenderTarget.Size.Width,. 
    Canvas.RenderTarget.Size.Height);
  try
    Canvas.RenderTarget.GetPixelData(PixelFormat32bppPBGRA,
      png.Scanline[0], png.Height * png.BytesPerScanline);
    png.SaveToFile(FileName);
  finally
    png.Free;
  end;
end;

das Funktioniert leider nicht

ich verwende die

Delphi-Quellcode:

Vcl.Direct2D;

, welche beim RenderTarget nur ein Interface zurückgibt

Delphi-Quellcode:

property RenderTarget: ID2D1RenderTarget read GetRenderTarget;

dadurch fehlen mir einige Funktionen wie

Delphi-Quellcode:

GetPixelData

Grundsätzlich geht der Ansatz in die richtige Richtung, daher danke für die Hilfe

[Olli73]

Auf Nachfrage hat Bing gemeint es müsste Canvas.GetPixelData heißen, aber auch der d2dcanvas scheint die Funktion nicht zu haben. Bing war aber auf Nachfrage fest der Meinung, es hat das in der Delphi unit gefunden...

[cocsy]

Zitat:

Zitat von Olli73 (Beitrag 1520013)

Auf Nachfrage hat Bing gemeint es müsste Canvas.GetPixelData heißen, aber auch der d2dcanvas scheint die Funktion nicht zu haben. Bing war aber auf Nachfrage fest der Meinung, es hat das in der Delphi unit gefunden...

korrekt, kann ich auch nicht in der

Delphi-Quellcode:

Vcl.Direct2D;

finden, vielleicht verwendet Bing eine zukünftige Version :?

mir ist leider noch nicht geholfen

[Olli73]

Vielleicht hilft dir das hier weiter?

https://stackoverflow.com/questions/...s-to-clipboard

[TiGü]

Da der interne Übersetzungsstand in Delphi von Direct2D auf der Version 1.0 festgefroren ist, muss man sich ein bisschen behelfen, um per Direct2D 1.1 "einfach" an die rohen Bitmapdaten zu kommen.
Der Quelltext unten baut auf diesem DowWiki-Beispiel auf: https://docwiki.embarcadero.com/RADS...as_exclusively
Nach dem Zeichen in der Paint-Routine kann man per Strg + Rechtsklick das aktuelle Bitmap abspeichern. Default-Dateipfad ist 'C:\Temp\BeispielBitmapFuerDelphiPraxis.bmp'.
Die im folgenden Quelltext verwendeten Definitionen stammen vom MfPack (https://github.com/FactoryXCode/MfPa...ctX.D2d1_1.pas).

Delphi-Quellcode:

unit SaveD2DBitmap;

interface

uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
    Vcl.Controls, Vcl.Forms, Vcl.Direct2D, Winapi.D2D1, Winapi.DXGI;

type
    TForm2 = class(TForm)
        procedure FormPaint(Sender: TObject);
        procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    private
        FCanvas: TDirect2DCanvas;
    protected
        procedure CreateWnd; override;

        procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
        procedure WMSize(var Message: TWMSize); message WM_SIZE;
    public
        property Canvas: TDirect2DCanvas read FCanvas;
    end;

var
    Form2: TForm2;

implementation

{$R *.dfm}
{ TForm2 }

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;

procedure DoSaveAsBitmap(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;
    VCLBitmap: TBitmap;
    NumberOfScanLinesCopied: UINT32;
begin
    if Supports(ARenderTarget, ID2D1DeviceContext, DeviceContext) then
    begin
        DeviceContext.GetPixelFormat(BitmapProps._pixelFormat);
        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
            srcRect.left := 0;
            srcRect.top := 0;
            srcRect.right := SizeU.Width;
            srcRect.bottom := SizeU.Height;

            destPoint.X := 0;
            destPoint.Y := 0;
            HR := CopyBitmap.CopyFromRenderTarget(destPoint, DeviceContext, srcRect);
            if Succeeded(HR) then
            begin
                MapOptions := D2D1_MAP_OPTIONS_READ;
                HR := CopyBitmap.Map(MapOptions, MappedRect);
                if Succeeded(HR) then
                begin
                    FillChar(BitmapInfo, SizeOf(BitmapInfo), 0);

                    SizeU.Width := MappedRect.pitch div 4;

                    BitmapInfo.bmiHeader.biSize := SizeOf(BitmapInfo.bmiHeader);
                    BitmapInfo.bmiHeader.biHeight := -SizeU.Height;
                    BitmapInfo.bmiHeader.biWidth := SizeU.Width;
                    BitmapInfo.bmiHeader.biPlanes := 1;
                    BitmapInfo.bmiHeader.biBitCount := 32;

                    VCLBitmap := TBitmap.Create(SizeU.Width, SizeU.Height);
                    try
                        VCLBitmap.PixelFormat := TPixelFormat.pf32bit;
                        NumberOfScanLinesCopied := SetDIBits(VCLBitmap.Canvas.Handle, VCLBitmap.Handle, 0, VCLBitmap.Height, MappedRect.bits,
                          BitmapInfo, DIB_RGB_COLORS);

                        if NumberOfScanLinesCopied > 0 then
                        begin
                            if ABitmapFileName = '' then
                            begin
                                ABitmapFilename := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + 'Test.bmp';
                            end;
                            VCLBitmap.SaveToFile(ABitmapFilename);
                        end
                        else
                            RaiseLastOSError;
                    finally
                        VCLBitmap.Free;
                    end;
                    CopyBitmap.Unmap;
                end;
            end;
        end;
    end;
end;

procedure TForm2.CreateWnd;
begin
    inherited;
    FCanvas := TDirect2DCanvas.Create(Handle);
end;

procedure TForm2.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    if (ssCtrl in Shift) and (Button = TMouseButton.mbRight) then
    begin
        DoSaveAsBitmap(FCanvas.RenderTarget, 'C:\Temp\BeispielBitmapFuerDelphiPraxis.bmp');
    end;
end;

procedure TForm2.FormPaint(Sender: TObject);
var
    LRect: TRect;
begin
    LRect := Self.ClientRect;
    { Drawing goes here }
    Canvas.Brush.Color := clRed;
    Canvas.Pen.Color := clBlue;
    Canvas.Rectangle(10, 10, LRect.Width div 2, LRect.Height div 2);

    Canvas.Pen.Color := clYellow;
    Canvas.DrawLine(D2D1PointF(0, 0), D2D1PointF(LRect.Width, LRect.Height));
end;

procedure TForm2.WMPaint(var Message: TWMPaint);
var
    PaintStruct: TPaintStruct;
begin
    BeginPaint(Handle, PaintStruct);
    try
        FCanvas.BeginDraw;
        try
            Paint;
        finally
            FCanvas.EndDraw;
        end;
    finally
        EndPaint(Handle, PaintStruct);
    end;
end;

procedure TForm2.WMSize(var Message: TWMSize);
var
    ClientSize: TD2D1SizeU;
begin
    if Assigned(FCanvas) then
    begin
        ClientSize := D2D1SizeU(ClientWidth, ClientHeight);
        ID2D1HwndRenderTarget(FCanvas.RenderTarget).Resize(ClientSize);
    end;

    inherited;
end;

end.

[cocsy]

der Ansatz von TiGü ist richtig gut,
leider liefert

Delphi-Quellcode:

NumberOfScanLinesCopied := SetDIBits(VCLBitmap.Canvas.Handle, VCLBitmap.Handle, 0, VCLBitmap.Height, MappedRect.bits; BitmapInfo, DIB_RGB_COLORS);

0 zurück...

[TiGü]

Ja nun, dann muss ja irgendwas im Argen sein.
Was ist denn die Exception, die im Else-Zweig bei RaiseLastOSError geworfen wird?

[cocsy]

Zitat:

Zitat von TiGü (Beitrag 1520477)

Ja nun, dann muss ja irgendwas im Argen sein.
Was ist denn die Exception, die im Else-Zweig bei RaiseLastOSError geworfen wird?

Das Handle ist ungültig, "code: 6"

[TiGü]

Hast du mein Beispiel denn irgendwie verändert? Funktioniert es denn so wie es ist bei dir in einer VCL-Form?
Du hast bspw. hier ein Semikolon nach MappedRect.bits drin

Zitat:

Zitat von cocsy (Beitrag 1520453)

Delphi-Quellcode:

NumberOfScanLinesCopied := SetDIBits(VCLBitmap.Canvas.Handle, VCLBitmap.Handle, 0, VCLBitmap.Height, MappedRect.bits; BitmapInfo, DIB_RGB_COLORS);

0 zurück...

, daher scheint mir die Zeile für den Forumseditor schonmal einfach abgeschrieben, anstatt kopiert worden zu sein.

Die Exception-Meldung ist zu generisch, das kann von VCLBitmap.Handle, über VCLBitmap.Height bis zu ungültigen Zeiger in MappedRect.bits oder leeres unausgefülltes BitmapInfo alles sein.
Siehst du denn einen schwarzen Hintergrund mit roten Rechteck und blauen Rand und einer gelben Linie von links oben nach rechts unten auf den D2DCanvas/Rendertarget im Formular?

[cocsy]

Ja, der Canvas zeichnet alles.
Und ja ich habe per Copy-paste alles in die IDE geholt,
Der Kern ist zu 100% identisch, inkl. dem Aufruf von

Delphi-Quellcode:

SetDIBits

.
Der Rückgabewert ist 0! Daher geht dort irgendwas schief.
Meine Vermutung liegt auch bei den MappedRect.bits,

Klappt es bei dir?

Und vielen Dank für deine Mithilfe

[TiGü]

Ja sicher klappt das bei mir?!
Sonst hätte ich den Quelltext ja nicht gepostet.
Arbeitest du denn an einen richtigen Rechner mit dedizierter GPU (Intel, AMD, Nvidia) oder müssen wir erstmal irgendwelche Probleme wegen Remote Desktop, Terminalsession oder virtueller Maschine mit ungenügender GPU-Unterstützung ausschließen???

CopyBitmap.Map muss ja funktionieren, weil es mit Succeeded(HR) abgesichert.
Was sagt denn der Debugger? Sind alle Werte sinnvoll belegt?

Ergänze bitte mal den Quelltext wie folgt:

Delphi-Quellcode:

                    VCLBitmap := TBitmap.Create(SizeU.Width, SizeU.Height);
                    try
                        VCLBitmap.PixelFormat := TPixelFormat.pf32bit;
                        OutputDebugString(PChar('VCLBitmap.Canvas.Handle: ' + THandle(VCLBitmap.Canvas.Handle).ToHexString));
                        OutputDebugString(PChar('VCLBitmap.Handle: ' + THandle(VCLBitmap.Handle).ToHexString));
                        OutputDebugString(PChar('VCLBitmap.Height: ' + VCLBitmap.Height.ToString));
                        OutputDebugString(PChar('MappedRect.bits: ' + THandle(MappedRect.bits).ToHexString));
                        OutputDebugString(PChar('    BitmapInfo.bmiHeader.biSize: ' + BitmapInfo.bmiHeader.biSize.ToString));
                        OutputDebugString(PChar('    BitmapInfo.bmiHeader.biHeight: ' + BitmapInfo.bmiHeader.biHeight.ToString));
                        OutputDebugString(PChar('    BitmapInfo.bmiHeader.biWidth: ' + BitmapInfo.bmiHeader.biWidth.ToString));
                        OutputDebugString(PChar('    BitmapInfo.bmiHeader.biPlanes: ' + BitmapInfo.bmiHeader.biPlanes.ToString));
                        OutputDebugString(PChar('    BitmapInfo.bmiHeader.biBitCount: ' + BitmapInfo.bmiHeader.biBitCount.ToString));

                        NumberOfScanLinesCopied := SetDIBits(VCLBitmap.Canvas.Handle, VCLBitmap.Handle, 0, VCLBitmap.Height, MappedRect.bits,
                          BitmapInfo, DIB_RGB_COLORS);

                        if NumberOfScanLinesCopied > 0 then
                        begin
                            if ABitmapFileName = '' then
                            begin
                                ABitmapFilename := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + 'Test.bmp';
                            end;
                            VCLBitmap.SaveToFile(ABitmapFilename);
                        end
                        else
                            RaiseLastOSError;
                    finally
                        VCLBitmap.Free;
                    end;

Da müsste dann was rauskommen, was ungefähr so aussieht und Win32:

Code:

Debug Output: VCLBitmap.Canvas.Handle: C101322F Process Direct2DSave.exe (2140)
Debug Output: VCLBitmap.Handle: B905326C Process Direct2DSave.exe (2140)
Debug Output: VCLBitmap.Height: 442 Process Direct2DSave.exe (2140)
Debug Output: MappedRect.bits: 03A30000 Process Direct2DSave.exe (2140)
Debug Output:     BitmapInfo.bmiHeader.biSize: 40 Process Direct2DSave.exe (2140)
Debug Output:     BitmapInfo.bmiHeader.biHeight: -442 Process Direct2DSave.exe (2140)
Debug Output:     BitmapInfo.bmiHeader.biWidth: 640 Process Direct2DSave.exe (2140)
Debug Output:     BitmapInfo.bmiHeader.biPlanes: 1 Process Direct2DSave.exe (2140)
Debug Output:     BitmapInfo.biBitCount.biSize: 32 Process Direct2DSave.exe (2140)

[cocsy]

ich arbeite auf einem richtigen Rechner,
- Prozessor Intel(R) Core(TM) i7-8550U CPU @ 1.80GHz, 1992 MHz, 4 Kern(e), 8 logische(r) Prozessor(en)
- System-SKU LENOVO_MT_20L7_BU_Think_FM_ThinkPad T480s

Delphi-Quellcode:

Debug-Ausgabe: VCLBitmap.Canvas.Handle: 0000000022010EB5 Prozess _Test.exe (16108)
Debug-Ausgabe: VCLBitmap.Handle: 0000000001053574 Prozess _Test.exe (16108)
Debug-Ausgabe: VCLBitmap.Height: 424 Prozess _Test.exe (16108)
Debug-Ausgabe: MappedRect.bits: 000002422D6E0000 Prozess _Test.exe (16108)
Debug-Ausgabe:  BitmapInfo.bmiHeader.biSize: 40 Prozess _Test.exe (16108)
Debug-Ausgabe:  BitmapInfo.bmiHeader.biHeight: -424 Prozess _Test.exe (16108)
Debug-Ausgabe:  BitmapInfo.bmiHeader.biWidth: 624 Prozess _Test.exe (16108)
Debug-Ausgabe:  BitmapInfo.bmiHeader.biPlanes: 1 Prozess _Test.exe (16108)
Debug-Ausgabe:  BitmapInfo.biBitCount.biSize: 32 Prozess _Test.exe (16108)

[cocsy]

ich habe meinen Unterschied erkannt, ich arbeite mit Win64...
mit Win32 klappt es

[TiGü]

Wild, in Win64 geht's bei mir auch nicht.
Ich kann aber auch nur die ersten 3307 Bytes von MappedRect.bits auslesen, danach ist Zugriffsverletzung.

Delphi-Quellcode:

...
                HR := CopyBitmap.Map(MapOptions, MappedRect);
                if Succeeded(HR) then
                begin
                    SetLength(NewPtr, MappedRect.pitch * SizeU.Height);
                    Stream := TBytesStream.Create(NewPtr);
                    Stream.Write(MappedRect.bits, (3 * 1024) + 235);
...

[TiGü]

Kann auch gut sein, dass die Intel-Treiber da einen Hau weg haben.
Wenn es in 32-Bit geht und 64-Bit nicht ist schon komisch.
Auf Arbeit hatten wir mit alten Intel-Treibern auch irre Probleme mit OpenGL.
Das haben die auch erst kürzlich gelöst.
Vielleicht kannst du das Programm woanders mit dedizierter Grafikkarte von AMD oder Nvidia laufen lassen.

[himitsu]

Es gibt bei Bitmaps auch noch ein paar andere Punkte, auf die man mal achten könnte.

* Wenn es nicht 32 Bit pro Pixel sind, dann gibt es eventuell ein Alignment der einzelnen Lines (zumindestens beim Delphi/GDI-Bitmap)

* und wie rum liegen die Lines im Speicher
* * von unten links nach oben rechts oder von oben links nach unten rechts (also Line 0 gefolgt von den Anderen oder die anderen Lins vor der Line 0 ... wenn man alles zusammen kopiert und nicht jede Line einzeln abfragt)
* * oder liegen die Lines garnicht zusammenhängend im Speicher?
* * das wäre z.B. eine Erklärung für "Ich kann aber auch nur die ersten 3307 Bytes von MappedRect.bits auslesen, danach ist Zugriffsverletzung"

[cocsy]

Zitat:

Zitat von TiGü (Beitrag 1520530)

Kann auch gut sein, dass die Intel-Treiber da einen Hau weg haben.
Wenn es in 32-Bit geht und 64-Bit nicht ist schon komisch.
Auf Arbeit hatten wir mit alten Intel-Treibern auch irre Probleme mit OpenGL.
Das haben die auch erst kürzlich gelöst.
Vielleicht kannst du das Programm woanders mit dedizierter Grafikkarte von AMD oder Nvidia laufen lassen.

Ich habe es getestet auf einem AMD-System, das verhalten ist gleich.
____


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

[himitsu]

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.

[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;

[cocsy]

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

[cocsy]

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:

[TiGü]

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.

[cocsy]

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