loadfile aus TMemoryStream

[busybyte]

So ich hab mal ein bischen rumgebastelt,keine Ahnung ob das so richtig für Dich ist,
aber das Prinzip sollte irgendwann klar werden.

//Jetzt nach dem 21 Edit und einer durchzechten Nacht,
(man gönnt sich ja sonst nichts), muss ich sagen, so wie es jetzt ist,
ist es gut für viele kleine Bildchen z.b. Icons oder Texturen,
aber dadurch, das alles in einem Memorystream gehalten wird, kommt ab und zu ein Speicherüberlauf.
Ich habe das Gefühl das auch irgendwas mit Findfirst( nicht stimmt,mal sehen, vieleicht hat ein
anderer ne Lösung für nen zünftigen Grafikloader.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,
  ExtCtrls,JPEG;

type

  TSkindatei=Record
  skSize,skPosition:integer;
  skFilename:String;
  //skFilenames:TStrings;
  end;


  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
   Procedure Streamini;
   Procedure Streamfree;
   { Private declarations }
  public
  SkinDateien:Array of TSkinDatei;
  ErrorCode:integer;
  function AddSkindatei(Var DList_:TStringList;SkinDatei_:TSkindatei):Boolean;
  function LoadPicture(aFileName:String):Boolean;
  procedure LoadMemory;
  procedure FindFiles(Var DList_:TStringList);
  procedure CreateBackGround(Filename_:String;Skinwidth,Skinheight:integer;Owner_:TWinControl);
  procedure resetDatas(Var DList1_:TStringList);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
Var
lFile :TMemoryStream;     //Gesamtstream aller Files
pFile :TMemoryStream;     //Stream EinzelFile
AnzSkinDateien:Longint;
Search :Boolean;
SkinPfad:String;
TestS:String;
SkinBackGround:TImage;
TempJpeg :TJPEGImage;
Extensions:TStringList;

const
   FileFilter = '*.bmp;*.jpg;*.jpeg;*.png;|'+
     '*.bmp;*.jpg;*.jpeg;';

function TForm1.LoadPicture(aFileName:String):Boolean;
var lCount : Integer;
begin
Result:=false;
  pFile.Clear;
  pFile.Position := 0;
  lFile.Position := 0;
  for lCount:= 0 to Length(Skindateien)-1 do
   with Skindateien[lCount] do
    begin
     TestS:=skFilename;
     if ansisameText(aFileName,skFilename) then
      begin
      lFile.Position := skPosition;
      pFile.CopyFrom(lFile,skSize);
      Result := True;
      pFile.Position := 0;
      Exit;
      end;

   end;
end;

Procedure TForm1.CreateBackGround(Filename_:String;Skinwidth,Skinheight:integer;Owner_:TWinControl);
Var ex_:String;
begin
SkinBackground := TImage.Create(Owner_);
    with SkinBackground do
    begin
      Parent := Owner_;
      Name := 'Background_'+inttostr(Parent.ControlCount);
      SetBounds(0,0, SkinWidth, SkinHeight);
      Picture.RegisterFileFormat('jpg;*.bmp; *.jpeg;*.bmp','JPEG',TBitmap);
      ex_:=Lowercase(ExtractFileExt(Filename_));
      begin
       if (Ex_ = '.jpg') or (Ex_='jpeg') then
          begin
            TempJpeg := TJPEGImage.Create;
            TempJpeg.LoadFromStream(pFile);
            Picture.Bitmap.Assign(TempJpeg);
            TempJpeg.Free;
          end
          else
          if (Ex_ = '.png') then
            begin
             { TempPng := TPNGObject.Create;
              TempPng.LoadFromStream(pFile);
              Picture.Bitmap.Assign(TempJpeg);
              TempPng.Free;
              }
            end
           else
           if (Ex_='.bmp') then
           Picture.Bitmap.LoadFromStream(pFile);

      end;


    end;
end;


procedure TForm1.LoadMemory;
var DList:TStringList;
    lCount: Integer;
begin
DList := TStringList.Create;      //Hilfsliste
  try
  resetDatas(DList);
  Search := True;
  FindFiles(DList);                 //Dateien finden und in Stringlist
                                  //später austauschen
  //zu Testzwecken um zu sehen ob bis hier alles klappt:
  Memo1.Lines.Assign(DList);
  finally DList.Free; end;
end;

Function TForm1.AddSkindatei(Var DList_:TStringList;SkinDatei_:TSkindatei):Boolean;
Var L1:integer;
begin
//Setlength verbraucht viel zeit deswegen gleich ein paar mehr
while AnzSkinDateien>Length(SkinDateien)-1 do
Setlength(SkinDateien,AnzSkinDateien+100);
Skindateien[AnzSkinDateien]:=SkinDatei_;
inc(AnzSkinDateien);
DList_.Add(SkinDatei_.skFilename);
end;


procedure TForm1.Button1Click(Sender: TObject);
Var Filename_:String;
begin
with Opendialog1 do
begin

 Filter:=FileFilter;
  if execute then
    begin
    Filename_:=Filename;
    SkinPfad:=  extractfilepath(Filename_);
    Label1.Caption:='';
    LoadMemory;
    Label1.Caption:=inttostr(Length(SkinDateien));

      if not LoadPicture(Filename_) then
       begin
       case Errorcode of
       1:Showmessage('Überlauf!');
       2:Showmessage('Keine Übereinstimmung oder ungültige Datei!');
       end;
       exit;
       end;
    CreateBackGround(Filename_,150,150,Form1);
    end;
 end;
end;


procedure TForm1.resetDatas(Var DList1_:TStringList);
begin
DList1_.Clear;
Memo1.Clear;
lFile.Clear;
pFile.Clear;
end;


procedure TForm1.FindFiles(Var DList_:TStringList);
var Tick:Cardinal;    TmpSkinDatei:TSkinDatei;
S:String;

  procedure DoSearch(const Path:String);
  var SR : TSearchRec;
  begin

    If Findfirst(Path + '*.*',faAnyFile,SR) = 0 then
     try
       repeat
         if GetTickCount >= Tick then
         begin
           Tick:= GetTickCount +100;
           Application.ProcessMessages;
         end;

         If (SR.Attr and faDirectory <> 0) and (SR.Name <> '.') and (SR.Name <> '..') then
           DoSearch(Path + SR.Name + '\')

         else
          if Extensions.IndexOf(ExtractFileExt(SR.Name)) >= 0 then
            with TmpSkinDatei do
             begin
             S:=Path + SR.Name;
             pFile.Clear;
             pFile.LoadFromFile(S);
             skSize:=pFile.Size;
              while (lFile.Size+skSize>160000000) do
               begin
               ErrorCode:=1;
               exit;
               end;

             skPosition:=lFile.Position;
             skFilename:=S;
             AddSkindatei(DList_,TmpSkinDatei);
             //pFile.Position := 0;
             lFile.CopyFrom(pFile,pFile.Size);
             end;

        until FindNext(SR) <> 0;
     finally
       FindClose(SR);
     end;
    end;

begin
    try
     Tick := GetTickCount + 100;
     AnzSkinDateien:=0;
     lFile.Position:=0;
     pFile.Position:=0;
     resetDatas(DList_);
     DOSearch(SkinPfad);

     Setlength(SkinDateien,AnzSkinDateien); //Tatsächliche Länge setzen
    except Setlength(SkinDateien,0);
    end;
end;


Procedure TForm1.Streamini;
begin
lFile := TMemoryStream.Create();     //Gesamtstream aller Files
pFile := TMemoryStream.Create();     //Stream EinzelFile
SkinPfad:='C:\Windows\';
Extensions:=TStringList.Create;
  with Extensions do
    try
    Add('.bmp');
    Add('.jpg');
    Add('.jpeg');
    Add('.png');
    except   Extensions.Free; end;

    with Memo1 do
    begin
    Clear;
    Align:=alRight;
    ScrollBars:=ssBoth;
    end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
ErrorCode:=0;
Streamini;
end;

Procedure TForm1.Streamfree;
begin
  Setlength(Skindateien,0);
  freeandnil(lFile);
  freeandnil(pFile);
  freeandnil(Extensions);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Streamfree;
end;


end.