Funktion: Graphic anhand des Namens aus Res erstellen

[whiteF]

Hallo,
ich wollte aus meiner Resource eine Grafik in ein TImage laden.

Gif, Png, bmp, jpg, klappt alles in einer seperaten procedure.

nun wollte ich mir eine funktion basteln, die mit einem befehl automatisch ein bildtyp in der ressource erkennt und das daraus resultierende ergebnis per graphic dem TImage übergeben.

Leider klappt dies nicht wirklich.
Ich poste euch mal mein Code.
Vlt. hat jemand zeit und findet mein Fehler.

Vielen Dank schonmal im voraus!

Res-Datei:

Delphi-Quellcode:

bild_bmp BITMAP "bmp.bmp"
bild_jpg RCDATA "jpg.jpg"
bild_png RCDATA "png.png"
bild_gif RCDATA "gif.gif"

Form1 auszugsweise:

Delphi-Quellcode:

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls, JPEG, PNGImage, GIFImg;

...

function GetGraphicFromResource(Name: String): TGraphic;
var
  RS: TResourceStream;
  ImageBMP : TBitmap;
  ImageJPG : TJPEGImage;
  ImagePNG : TPNGImage;
  ImageGif : TGIFImage;
  FileExtension : String;
  Graphic : TGraphic;
begin
  FileExtension := LowerCase(Copy(Name, Length(Name)-2, 3));

  Graphic := TGraphic.Create;
  Graphic := nil;

  RS := TResourceStream.Create(hInstance, Name, RT_RCDATA);
  try

    if FileExtension = LowerCase('bmp') then
    begin
      ImageBMP := TBitmap.Create;
      try
        ImageBMP.LoadFromStream(RS);
        Graphic := ImageBMP;
      finally
        ImageBMP.Free;
      end;
    end;

    if FileExtension = LowerCase('jpg') then
    begin
      ImageJPG := TJPEGImage.Create;
      try
        ImageJPG.LoadFromStream(RS);
        Graphic := ImageJPG;
      finally
        ImageJPG.Free;
      end;
    end;

    if FileExtension = LowerCase('jpeg') then
    begin
      ImageJPG := TJPEGImage.Create;
      try
        ImageJPG.LoadFromStream(RS);
        Graphic := ImageJPG;
      finally
        ImageJPG.Free;
      end;
    end;

    if FileExtension = LowerCase('png') then
    begin
      ImagePNG := TPNGImage.Create;
      try
        ImagePNG.LoadFromStream(RS);
        Graphic := ImagePNG;
      finally
        ImagePNG.Free;
      end;
    end;

    if FileExtension = LowerCase('gif') then
    begin
      ImageGif := TGIFImage.Create;
      try
        ImageGif.LoadFromStream(RS);
        Graphic := ImageGif;
      finally
        ImageGif.Free;
      end;
    end;
  finally
    RS.Free;
  end;

  if Graphic <> nil then
  begin
    showmessage('gr vorhanden');
    //Form1.image1.Picture.Graphic := graphic;

    //showmessage('gr vorhanden');
    Result := Graphic;
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  image1.Picture.Graphic := nil;
  image1.Picture.Graphic := (GetGraphicFromResource('bild_jpg'));
  //image1.Picture.Graphic.Assign(GetGraphicFromResource('bild_jpg'));
end;

[Uwe Raabe]

Du solltest die gerade erzeugte TGraphic-Instanz nicht gleich wieder freigeben. Schließlich brauchst du die ja noch als Funktionsrückgabe.

Das ganze mal etwas kompakter geschrieben:

Delphi-Quellcode:

function GetGraphicFromResource(Name: String): TGraphic;
var
  RS: TResourceStream;
  FileExtension: String;
begin
  FileExtension := LowerCase(Copy(Name, Length(Name) - 2, 3));

  result := nil;
  if FileExtension = 'bmp' then begin
    result := TBitmap.Create;
  end
  else if (FileExtension = 'jpg') or (FileExtension = 'jpeg') then begin
    result := TJPEGImage.Create;
  end
  else if FileExtension = 'png' then begin
    result := TPNGImage.Create;
  end
  else if FileExtension = 'gif' then begin
    result := TGIFImage.Create;
  end;

  if result <> nil then begin
    RS := TResourceStream.Create(hInstance, Name, RT_RCDATA);
    try
      result.LoadFromStream(RS);
    finally
      RS.Free;
    end;
    showmessage('gr vorhanden');
  end;
end;

[Sir Rufo]

Oder man macht es sich etwas gemütlicher:

Die Resourcen als

Delphi-Quellcode:

class property

hinterlegen

Delphi-Quellcode:

unit AppResources;

interface

uses
  Resources.Types,
  Resources.Vcl.Types;

type
  Resources = class abstract
  private
    class var FBildA: TGraphicResource;
    class var FBildB: TGraphicResource;
    class var FBildC: TGraphicResource;
    class var FBildD: TGraphicResource;
  protected
    class constructor Create;
    class destructor Destroy;
  public
    class property BildA: TGraphicResource read FBildA;
    class property BildB: TGraphicResource read FBildB;
    class property BildC: TGraphicResource read FBildC;
    class property BildD: TGraphicResource read FBildD;
  end;

implementation

{$R AppResources.res AppResources.rc}

{ Resources }

class constructor Resources.Create;
begin
  FBildA := TBitmapResource.Create( 'bild_bmp' );
  FBildB := TJpegResource.Create( 'bild_jpg' );
  FBildC := TPngResource.Create( 'bild_png' );
  FBildD := TGifResource.Create( 'bild_gif' );
end;

class destructor Resources.Destroy;
begin
  FBildA.Free;
  FBildB.Free;
  FBildC.Free;
  FBildD.Free;
end;

end.

und dann einfach verwenden

Delphi-Quellcode:

  Image1.Picture.Assign( Resources.BildA );
  // oder
  Image1.Picture.Assign( Resources.BildB );
  // oder
  Image1.Picture.Assign( Resources.BildC );
  // oder
  Image1.Picture.Assign( Resources.BildD );

Ermöglicht wird das dann durch

Delphi-Quellcode:

unit Resources.Types;

interface

uses
  System.Classes,
  System.SysUtils,
  System.Types;

type
  TResource = class abstract( TInterfacedPersistent, IStreamPersist )
  protected
    function GetDataStream: TStream; virtual; abstract;
  protected
    procedure AssignTo( Dest: TPersistent ); override;
  public
    procedure LoadFromStream( Stream: TStream );
    procedure SaveToStream( Stream: TStream );
  end;

  TEmbeddedResource = class( TResource )
  private
    FResName: string;
  protected
    function GetDataStream: TStream; override;
  public
    constructor Create( const ResName: string );
    property ResName: string read FResName;
  end;

implementation

{ TResource }

procedure TResource.AssignTo( Dest: TPersistent );
var
  other : IStreamPersist;
  source: TStream;
begin
  if Supports( Dest, IStreamPersist, other )
  then
    begin
      source := GetDataStream( );
      try
        other.LoadFromStream( source );
      finally
        source.Free;
      end;
    end
  else
    inherited;
end;

procedure TResource.LoadFromStream( Stream: TStream );
begin
  raise EInvalidOperation.Create( 'Resources are read only' );
end;

procedure TResource.SaveToStream( Stream: TStream );
var
  source: TStream;
begin
  source := GetDataStream( );
  try
    Stream.CopyFrom( source, -1 );
  finally
    source.Free;
  end;
end;

{ TEmbeddedResource }

constructor TEmbeddedResource.Create( const ResName: string );
begin
  inherited Create;
  FResName := ResName;
end;

function TEmbeddedResource.GetDataStream: TStream;
begin
  Result := TResourceStream.Create( HInstance, FResName, RT_RCDATA );
end;

end.

und

Delphi-Quellcode:

unit Resources.Vcl.Types;

interface

uses
  System.Classes,
  Vcl.Graphics,
  Resources.Types;

type
  TGraphicResource = class abstract( TEmbeddedResource )
  private
    function GetGraphic: TGraphic;
  protected
    function GetGraphicClass: TGraphicClass; virtual; abstract;
    procedure AssignTo( Dest: TPersistent ); override;
  end;

  TBitmapResource = class( TGraphicResource )
  protected
    function GetGraphicClass: TGraphicClass; override;
  end;

  TGifResource = class( TGraphicResource )
  protected
    function GetGraphicClass: TGraphicClass; override;
  end;

  TJpegResource = class( TGraphicResource )
  protected
    function GetGraphicClass: TGraphicClass; override;
  end;

  TPngResource = class( TGraphicResource )
  protected
    function GetGraphicClass: TGraphicClass; override;
  end;

implementation

uses
  Vcl.Imaging.GIFImg,
  Vcl.Imaging.pngimage,
  Vcl.Imaging.jpeg;

{ TGraphicResource }

procedure TGraphicResource.AssignTo( Dest: TPersistent );
var
  source: TGraphic;
begin
  if ( Dest is TGraphic ) or ( Dest is TPicture )
  then
    begin
      source := GetGraphic;
      try
        Dest.Assign( source );
      finally
        source.Free;
      end;
    end
  else
    inherited;
end;

function TGraphicResource.GetGraphic: TGraphic;
var
  source: TStream;
begin
  Result := GetGraphicClass( ).Create;
  source := GetDataStream;
  try
    Result.LoadFromStream( source );
  finally
    source.Free;
  end;
end;

{ TBitmapResource }

function TBitmapResource.GetGraphicClass: TGraphicClass;
begin
  Result := TBitmap;
end;

{ TGifResource }

function TGifResource.GetGraphicClass: TGraphicClass;
begin
  Result := TGIFImage;
end;

{ TJpegResource }

function TJpegResource.GetGraphicClass: TGraphicClass;
begin
  Result := TJPEGImage;
end;

{ TPngResource }

function TPngResource.GetGraphicClass: TGraphicClass;
begin
  Result := TPngImage;
end;

end.

[HolgerX]

Hmm...

Bei Bildern verwende ich eine andere Herangehensweise, gerade, wenn der Dateiname/Dateiende nicht vorhanden ist:

Ich werte die 'Magic Bytes' des FileStreams aus.
Somit kann ich auch zwischen verschiedenen Bildformaten unterscheiden ohne deren Namen zu erkennen.

Funktioniert auch mit ResourceStreams

Mal kurz aus einer meiner Units heraus kopiert:

Delphi-Quellcode:

const
  C_Magic_BM  : array[0..1] of Byte = (Ord('B'),Ord('M'));
  C_Magic_BMP : array[0..2] of Byte = (Ord('B'),Ord('M'),Ord('P'));
  C_Magic_XBM : array[0..6] of Byte = (Ord('#'),Ord('d'),Ord('e'),Ord('f'),Ord('i'),Ord('n'),Ord('e'));
  C_Magic_JPG : array[0..1] of Byte = ($FF,$D8);
  C_Magic_GIF : array[0..2] of Byte = (Ord('G'),Ord('I'),Ord('F'));
  C_Magic_WMF : array[0..3] of Byte = ($D7,$CD,$C6,$9A);
  C_Magic_PNG : array[0..7] of Byte = (137,80,78,71,13,10,26,10);
  C_Magic_JPF : array[0..3] of Byte = ($00,$00,$00,$0C);
  C_Magic_JP2 : array[0..7] of Byte = ($00,$00,$00,$0C,$6A,$50,$20,$20);
  C_Magic_JPK : array[0..3] of Byte = ($FF,$4F,$FF,$51);

  C_Magic_TIF1 : array[0..3] of Byte = ($49,$49,$2A,$00);
  C_Magic_TIF2 : array[0..3] of Byte = ($4D,$4D,$00,$2A);


function CheckMagicNo(AFileData : array of Byte; aMagicBytes : array of Byte):boolean;
var
  i : integer;
begin
  result := length(AFileData) >= length(aMagicBytes);
  if result then begin
    for i := 0 to length(aMagicBytes) -1 do begin
      if AFileData[i] <> aMagicBytes[i] then begin
        result := false;
        break;
      end;
    end;
  end;
end;

function IsPicture(const AFileName : WideString):boolean;
var
  ByteArr : array[0..7] of Byte;
  tmpStream : TFileStream;
begin
  result := true;
  try
    if IsWebPFile2(AFileName) then exit; // TWEBPImage

    tmpStream := TFileStream.Create(AFileName,fmOpenRead);
    try
      tmpStream.Position := 0;
      if tmpStream.Read(ByteArr,8) = 8 then begin
        if CheckMagicNo(ByteArr,C_Magic_BM) then exit; // TBitmap
        if CheckMagicNo(ByteArr,C_Magic_BMP) then exit; // TBitmap
        if CheckMagicNo(ByteArr,C_Magic_XBM) then exit; // TXBMImage
        if CheckMagicNo(ByteArr,C_Magic_JPG) then exit; // TJPEGImage
        if CheckMagicNo(ByteArr,C_Magic_GIF) then exit; // TGIFImage
        if CheckMagicNo(ByteArr,C_Magic_WMF) then exit; // WMF
        if CheckMagicNo(ByteArr,C_Magic_PNG) then exit; // TPNGObject
        if CheckMagicNo(ByteArr,C_Magic_JPF) then exit; // JPF
        if CheckMagicNo(ByteArr,C_Magic_JP2) then exit; // JP2     JPEG2000
        if CheckMagicNo(ByteArr,C_Magic_JPK) then exit; // J2K
        if CheckMagicNo(ByteArr,C_Magic_TIF1) then exit; // Tif    little endian format
        if CheckMagicNo(ByteArr,C_Magic_TIF2) then exit; // Tif    big endian format

        tmpStream.Position := 0;
        if TargaCanLoad(tmpStream) then exit;           // TTarga;
      end;
      result := false;    // Kein lesbares Image oder keine 8 bytes
    finally
      tmpStream.Free;
    end;
  except
    result := false;
    // Datei nicht zu öffnen, also ignorieren
  end;
end;

Statt des Exits kannst Du dann einfach das TGrafic-Objekt mit dem geladenen Bild zurück geben und anstelle des FileStreams/FileName nimmst Du den ResourceStream.

Somit ist es egal, wie das Bild in der Resource deklariert ist, es kann dort alles als BinStream abgelegt werden.

[whiteF]

Danke für die beiträge,
Ich werde sie heute abend mal testen.

@HolgerX
Danke für den hinweis mit den magic bytes. Aber die jeweiligen streams müsste man nach dem check doch erstmal dem entsprechenden bild (TBitmap, TPNGImage, TGIFImage, TJPEGImage) zuweisen bevor man diese dem TGraphic object übergibt.

Ich werde diese variante mit der funktion von Uwe kombinieren und mal schauen ob da wa pasenses rauskommt.

Die Lösung von Sir Rufo ist ja sehr ambitioniert. Ich hoffe nicht das du wg mir soviel aufwand betrieben hast :shock:
Für 2-4 kleine bilder innerhalb der anwendung reicht glaub ich so eine kleine funktion. Für mehr scheint mir deine lösung sehr vereinfachend zu sein.

Viele Grüße

[Sir Rufo]

Zitat:

Zitat von whiteF (Beitrag 1330612)

Die Lösung von Sir Rufo ist ja sehr ambitioniert. Ich hoffe nicht das du wg mir soviel aufwand betrieben hast :shock:
Für 2-4 kleine bilder innerhalb der anwendung reicht glaub ich so eine kleine funktion. Für mehr scheint mir deine lösung sehr vereinfachend zu sein.

Wenn du dir die Lösung genau anschaust, dann sieht man eigentlich keinen wirklichen Aufwand. Ein paar kleine Klassen, die als Ressourcen-Stellvertreter einem die eigentliche Arbeit abnehmen.

Der meiste Teil des Source entstand durch Code-Completion ... :stupid:

Mir ist es egal, ob das Projekt groß oder klein ist. Wichtig ist mir immer den Boilerplate-Code wegzubekommen, sonst sieht man die wirkliche Funktion vor lauter Code nicht mehr.

[HolgerX]

Zitat:

Zitat von whiteF (Beitrag 1330612)

Danke für die beiträge,
@HolgerX
Danke für den hinweis mit den magic bytes. Aber die jeweiligen streams müsste man nach dem check doch erstmal dem entsprechenden bild (TBitmap, TPNGImage, TGIFImage, TJPEGImage) zuweisen bevor man diese dem TGraphic object übergibt.

Ich werde diese variante mit der funktion von Uwe kombinieren und mal schauen ob da wa pasenses rauskommt.

Brauchst nur dort wo z.B.:

Delphi-Quellcode:

  if CheckMagicNo(ByteArr,C_Magic_BM) then exit;

steht ein

Delphi-Quellcode:

if not Assigned(result) and CheckMagicNo(ByteArr,C_Magic_BM) then result := TBitmap.Create;

und unten dann ein

Delphi-Quellcode:

if Assigned(result) then result.LoadFromStream(RS);

(Freihand zusammen geschrieben/kopiert ;) )