WICImage - out of memory

[striderx]

Ich habe die Aufgabenstellung, Bild-Dateien zu laden, in einem tImage mit hoher Qualität skaliert anzuzeigen und des Weiteren in einer Bitmap zu Weiterbearbeitung zu speichern.

Grundsätzlich klappt das auch prima. Bei einer größeren Test-Datei (TIF, ca. 280 MB, 11.000 x 8.700 Pixel) bekomme ich einen eOutOfRessources Fehler, wenn ich die unten markierte Zeile aktiv lasse. Kommentiere ich sie aus, kommt kein Fehler. Hat jemand eine Idee, woran das liegen könnte bzw. was da passiert?

Delphi-Quellcode:

procedure TdlgMain.Button2Click(Sender: TObject);

var
  Factory:       IWICImagingFactory;
  NewHeight:     Integer;
  NewWidth:      Integer;
  Ratio:         Double;
  Scaler:        IWICBitmapScaler;
  SourceHeight:  Integer;
  SourceWidth:   Integer;
  WICImage:      tWICImage;

begin
  WICImage := tWICImage.Create;
  try
    WICImage.LoadFromFile('F:\Test\ResizeTest\DSF1789.TIF');
  except
    on E:Exception do begin
       ShowMsg(E.Message, '', mb_OK, mb_IconError);
       WICImage.Free;
       Exit;
    end;
  end;

  SourceHeight := WICImage.Height;
  SourceWidth  := WICImage.Width;

  if Assigned(BM) then begin        <-- tBitmap, globale Variable
     BM.Width  := SourceWidth;
     BM.Height := SourceHeight;
     BM.Canvas.Draw(0, 0, WICImage);    <-- wenn diese Zeile aktiv ist, knallt es
  end;

  if SourceHeight = SourceWidth then begin
     NewWidth  := iWICTest.Width;
     NewHeight := iWICTest.Height;
  end
  else if SourceWidth > SourceHeight then begin
     Ratio     := SourceHeight / SourceWidth;
     NewWidth  := iWICTest.Width;
     NewHeight := Round(iWICTest.Width * Ratio);
  end
  else begin
     Ratio     := SourceWidth / SourceHeight;
     NewWidth  := Round(iWICTest.Height * Ratio);
     NewHeight := iWICTest.Height;
  end;

  iWICTest.Picture := Nil;
  try
    Factory := TWICImage.ImagingFactory;
    Factory.CreateBitmapScaler(Scaler);
    Scaler.Initialize(WICImage.Handle, NewWidth, NewHeight,
                      WICBitmapInterpolationModeHighQualityCubic);
    WICImage.Handle := IWICBitmap(Scaler);
    iWICTest.Picture.Bitmap.Assign(WICImage);
    iWICTest.Repaint;
    Scaler  := Nil;
    Factory := Nil;
  except
    ShowMsg('Fehler bei der Skalierung', 'Fehler', mb_OK, mb_Iconerror);
  end;

  WICImage.Free;

end;

[TurboMagic]

Schon Mal probiert statt des WIC Bildes einfach eine
Linie auf diesen Bitmap Canvas zu zeichnen um zu testen,
dass so große Bitmaps überhaupt funktionieren?

[striderx]

Zitat von TurboMagic:

Schon Mal probiert statt des WIC Bildes einfach eine
Linie auf diesen Bitmap Canvas zu zeichnen um zu testen,
dass so große Bitmaps überhaupt funktionieren?

Habe ich gerade mit einer 10.000 x 10.000 Bitmap probiert: Kein Problem.

Wenn ich die nachstehende Version mit dem guten alten ScaleImage verwende, klappt es auch ohne Probleme.

Delphi-Quellcode:

procedure TdlgMain.Button4Click(Sender: TObject);

var
  Ratio:     Double;
  WICImage:  tWICImage;

begin
  WICImage := tWICImage.Create;
  try
    WICImage.LoadFromFile('F:\Test\ResizeTest\DSF1789.TIF');
  except
    on E:Exception do begin
       ShowMsg(E.Message, '', mb_OK, mb_IconError);
       WICImage.Free;
       Exit;
    end;
  end;

  if Assigned(BM) then begin
     BM.Assign(WICImage);
  end;
  WICImage.Free;

  iTest2.Picture := Nil;
  if iTest2.Height < iTest2.Width then Ratio := iTest2.Height / BM.Height
  else Ratio := iTest2.Width / BM.Width;
  try
    ScaleImage(BM, iTest2.Picture.Bitmap, Ratio);
  except
    Exit;
  end;
  iTest.Repaint;
end;

[striderx]

Nach laaaaaangem Suchen habe ich wohl die Lösung gefunden: Man muss bei der Bitmap noch mal explizit des Pixelformat setzen:

Delphi-Quellcode:

  
if Assigned(BM) then begin
   BM.Width  := SourceWidth;
   BM.Height := SourceHeight;
   BM.Canvas.Draw(0, 0, WICImage);
   BM.PixelFormat := pf24bit;    <-- mus nach dem Draw erfolgen
end;

"To avoid this try to create DIB instead of TBitmap, or try to change Pixelformat to pf24bit. This will tell system to create Bitmap in user's memory instead of GDI buffer."

https://stackoverflow.com/questions/...tmap-on-delphi