Einzelnen Beitrag anzeigen

Benutzerbild von bytecook
bytecook

Registriert seit: 6. Aug 2010
Ort: Dornbirn
151 Beiträge
 
Delphi 11 Alexandria
 
#9

AW: Bilder [mit/ohne Transparenz] in universelles Format bringen

  Alt 16. Aug 2016, 15:59
Danke für die Beiträge.

Delphi-Quellcode:
uses
  ..., GR32, gr32_png;

var
  bmp32: TBitmap32;
  png32: TPortableNetworkGraphic32;
begin
   bmp32 := TBitmap32.Create;
   bmp32.Width := 2048; // zum testen
   bmp32.Height := 1024;
   bmp32.Canvas.Draw(0, 0, tmpImage.Picture.Graphic); // zum Testen auch keine Skalierung etc.

   png32 := TPortableNetworkGraphic32.Create;
   png32.Assign(bmp32);

   ms := TMemoryStream.Create;
   ms.Position := 0;
   png32.SaveToStream(ms);
// bmp32.SaveToStream(ms); // geht nicht, TglBitmap2D kann das dann nicht wieder einlesen
   ms.Position := 0;
   LoadFromStream(ms);
   FreeAndNil(ms);

   GenTexture(True); // geladene Textur an OpenGL übergeben

   FreeAndNil(png32);
   FreeAndNil(bmp32);

Delphi-Quellcode:

uses
     ...
     Gr32,
     GR32_Png,
     GR32_PortableNetworkGraphic;

...

  (** PNG - Routinen **)
  function SaveAsPng (Const FileName : String; ABmp : TBitmap32) : Boolean;
  function LoadPng (Const FileName : String; ABmp : TBitmap32) : Boolean;


(******************************************************************************)

(** PNG - Routinen - QnD                                                     **)

(******************************************************************************)

function SaveAsPng (Const FileName : String; ABmp : TBitmap32) : Boolean;

  var APng : TPortableNetworkGraphic32;

  begin
    try
      APng := TPortableNetworkGraphic32.Create;
      APng.Assign(ABmp);
      APng.SaveToFile(FileName);
      Result := True;
    except
      Result := False;
    end;
    APng.Free;
  end;
(******************************************************************************)
function LoadPng (Const FileName : String; ABmp : TBitmap32) : Boolean;

  var APng : TPortableNetworkGraphic32;

  begin
    try
      APng := TPortableNetworkGraphic32.Create;
      APng.LoadFromFile(FileName);
      APng.AssignTo(ABmp);
      Result := True;
    except
      Result := False;
    end;
    APng.Free;
  end;
(******************************************************************************)


procedure TForm1.LadePng

  var ABmp : TBitmap32;

  begin
    ABmp := TBitmap.Create();
    LoadPng ('Bart.png', ABmp);

    ... tuwas ...

    FreeAndNil(ABmp);

  end;

So sollte es klappen. TPortableNetworkGraphic32 funktioniert nativ, ohne DirectX ...
Peter
  Mit Zitat antworten Zitat