AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi Direct2D.Canvas in einer Bitmap speichern
Thema durchsuchen
Ansicht
Themen-Optionen

Direct2D.Canvas in einer Bitmap speichern

Ein Thema von cocsy · begonnen am 15. Mär 2023 · letzter Beitrag vom 19. Apr 2023
Antwort Antwort
Seite 3 von 3     123   
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.063 Beiträge
 
Delphi 12 Athens
 
#21

AW: Direct2D.Canvas in einer Bitmap speichern

  Alt 3. Apr 2023, 11:04
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.
Neuste Erkenntnis:
Seit Pos einen dritten Parameter hat,
wird PoSex im Delphi viel seltener praktiziert.
  Mit Zitat antworten Zitat
TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
3.070 Beiträge
 
Delphi 10.4 Sydney
 
#22

AW: Direct2D.Canvas in einer Bitmap speichern

  Alt 3. Apr 2023, 14:27
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;
  Mit Zitat antworten Zitat
cocsy

Registriert seit: 12. Jul 2011
30 Beiträge
 
Delphi 11 Alexandria
 
#23

AW: Direct2D.Canvas in einer Bitmap speichern

  Alt 3. Apr 2023, 18:24
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

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
Jan

Geändert von cocsy ( 3. Apr 2023 um 18:34 Uhr) Grund: weitere Infos hinzugefügt
  Mit Zitat antworten Zitat
cocsy

Registriert seit: 12. Jul 2011
30 Beiträge
 
Delphi 11 Alexandria
 
#24

AW: Direct2D.Canvas in einer Bitmap speichern

  Alt 3. Apr 2023, 18:40
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
Jan
  Mit Zitat antworten Zitat
TiGü

Registriert seit: 6. Apr 2011
Ort: Berlin
3.070 Beiträge
 
Delphi 10.4 Sydney
 
#25

AW: Direct2D.Canvas in einer Bitmap speichern

  Alt 4. Apr 2023, 10:53
Guter Fund auf Stack Overflow.
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.
  Mit Zitat antworten Zitat
cocsy

Registriert seit: 12. Jul 2011
30 Beiträge
 
Delphi 11 Alexandria
 
#26

AW: Direct2D.Canvas in einer Bitmap speichern

  Alt 19. Apr 2023, 15:37
kleiner Nachtrag:
- Achtet auf den Compiler der Schalter für die "Record-Felder ausrichten" muss "Quad Word" sein...
Jan
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 3 von 3     123   

 

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 23:52 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