loadfile aus TMemoryStream

[bluescreen25]

Danke schön :-D , ich werde das gleich morgen mal umsetzen und berichten.
Ich wusste ja, das mein Einlesen nicht so doll umgesetzt war.

Und schon wieder was dazugelernt. :)

Gruß, bluescreen

//Edit: in meinerm Source hatte ich beim Einlesen der Filenames direkt in lowercase gesetzt habe und dann auch aFilename auf lowercase abgefragt, da einige Dateien nicht 100% identisch waren beim Vergleich.

[busybyte]

ok Projekt eingestellt das wird so nix,der Kot von mir ist Müll

:coder2:

[busybyte]

//EDIT

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;
  skPic:TPicture;
  end;


  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Label2: TLabel;
    Image1: TImage;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    procedure Button2Click(Sender: TObject);
    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;
  Function AddSkindatei(Var DList_:TStringList;SkinDatei_:TSkindatei):Boolean;
  procedure LoadMemory;
  procedure FindFiles(Var DList_:TStringList);
//  procedure CreateBackGround(Filename_:String;Skinwidth,Skinheight:integer;Owner_:TWinControl);
  procedure CreateBackGround(Dateiindex_:integer;Skinwidth,Skinheight:integer;Owner_:TWinControl);
  procedure resetDatas(Var DList_: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;
Testi1:integer;
TempJpeg :TBitmap;
Extensions:TStringList;
Imgcnt:integer;
var StrtTick,Tick:Cardinal;
const
   FileFilter = '*.bmp;*.jpg;*.jpeg;*.png;|'+
     '*.bmp;*.jpg;*.jpeg;';


Procedure TForm1.CreateBackGround(Dateiindex_:integer;Skinwidth,Skinheight:integer;Owner_:TWinControl);
Var ex_:String;     TempJpeg:TJpegImage;
L1:integer;
TmpImg:TImage;
begin
    with SkinDateien[Dateiindex_] do
    begin
        skPic:=TPicture.Create;
     try
      skPic.RegisterFileFormat('jpg;*.bmp; *.jpeg;*.bmp','JPEG',TBitmap);
      ex_:=Lowercase(ExtractFileExt(skFilename));
      skPic.Bitmap.Width:=SkinWidth;
      skPic.Bitmap.Height:=SkinHeight;

       if (Ex_ = '.jpg') or (Ex_='jpeg') then
          begin
          TempJpeg := TJPEGImage.Create;
          lfile.Position:=skPosition;
          TempJpeg.LoadFromStream(lFile);
          skPic.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
            begin
            lfile.Position:=skPosition;
            skPic.Bitmap.LoadFromStream(lFile);
            end;
   except showmessage('Dateiindex: '+inttostr(Dateiindex_));end;
  end;
end;



procedure TForm1.LoadMemory;
var DList:TStringList;
    lCount: Integer;
begin
DList := TStringList.Create;      //Hilfsliste
  try
  resetDatas(DList);
  Search := True;
  AnzSkinDateien:=0;
  SetLength(SkinDateien,AnzSkinDateien);
  FindFiles(DList);      //Dateien finden und in Stringlist
  //zu Testzwecken um zu sehen ob bis hier alles klappt:
  Memo1.Lines.Assign(DList);                                          //<---Bremse !!!
  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.FindFiles(Var DList_:TStringList);
Var 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 (Length(SkinDateien)>200) or (lfile.size>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.Button1Click(Sender: TObject);
Var Filename_:String;
cnt1,L1:integer;
begin
with Opendialog1 do
begin
Filter:=FileFilter;
  if execute then
    begin
    Filename_:=Filename;
    SkinPfad:=  extractfilepath(Filename_);
    Label1.Caption:='';
    StrtTick:=Gettickcount;
    LoadMemory;    //Dateien suchen und in Hauptstream laden
    Label1.Caption:=inttostr(Length(SkinDateien))+ ' Bilder';
    Label2.Caption:=inttostr(lfile.Size div 1000000)+' MB' ;
    Label3.Caption:='in ' +inttostr((Tick-StrtTick) div 1000 )+' Sek.' ;
    end;
end;
end;


procedure TForm1.Button2Click(Sender: TObject);
Var L1,cnt1_:integer;
  cnt1: Integer;
begin
L1:=Length(SkinDateien);

StrtTick:=Gettickcount;
imgCnt:=0;
for cnt1 := 0 to L1- 1 do
begin
 //Zeitmessung und Antifreeze;
  if GetTickCount >= Tick then
     begin
     Tick:= GetTickCount +100;
     Application.ProcessMessages;
     end;

//Alle Bilder in skPic
CreateBackGround(cnt1,100,100,Form1);

  //Alle skPic in Image1
 with SkinDateien[cnt1] do
  begin
  Image1.Picture.Bitmap.Assign(skPic.Bitmap);
  inc(imgCnt);
  end;

end;
Label4.Caption:= inttostr(imgcnt)+' Bilder';
showmessage('Erfolgreich: '+Label4.Caption);
Label5.Caption:='in ' +inttostr((Tick-StrtTick) div 1000 )+' Sek.' ;
end;


procedure TForm1.resetDatas(Var DList_:TStringList);
begin
DList_.Clear;
Memo1.Clear;
lFile.Clear;
pFile.Clear;
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.

Man sieht jetzt ganz deutlich 2 Schwachstellen,
1. Wenn viele Unterverzeichnisse dursucht werden müssen
und
2. das Anlegen grosser Bilder
dauert sehr lange.

[marabu]

Moin,

hier ein Strukturansatz für das Ladeproblem:

Delphi-Quellcode:

unit DemoFrm;

interface

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

type
  TDemoForm = class(TForm)
    SkinButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    SkinPath: string;
    SkinList: TStrings;
    SkinStream: TStream;
  end;

var
  DemoForm: TDemoForm;

implementation

{$R *.dfm}

uses
  FileCtrl;

const
  SKIN_EXTENSIONS = '*.jpg;*.bmp';

type
  TSkinItem = class
    FOffset: Int64;
    FSize: Int64;
  public
    constructor Create(offset, size: Int64);
    property Offset: Int64 read FOffSet;
    property Size: Int64 read FSize;
  end;

constructor TSkinItem.Create(offset, size: Int64);
begin
  inherited Create;
  FOffset := offset;
  FSize := size;
end;

function GetFiles(const dir, masks: string; s: TStrings = nil): Integer;
begin
  with TFileListBox.CreateParented(HWND(HWND_MESSAGE)) do
  try
    Mask := masks;
    Directory := dir;
    FileType := [ftArchive];
    Result := Items.Count;
    if Assigned(s) then
      s.Assign(Items);
  finally
    Free;
  end;
end;

procedure LoadSkins(const SkinPath, Extensions: string;
    SkinList: TStrings; SkinStream: TStream);
var
  i: Integer;
  totalSize: Int64;
  s: TStream;
begin
  totalSize := 0;
  with SkinList do
    for i := 0 to Pred(Count) do
      Objects[i].Free;
  GetFiles(SkinPath, Extensions, SkinList);
  with SkinList do
    for i := 0 to Pred(Count) do
    begin
      s := TFileStream.Create(Strings[i], fmOpenRead or fmShareDenyWrite);
      try
        Objects[i] := TSkinItem.Create(totalSize, s.Size);
        SkinStream.CopyFrom(s, 0);
        Inc(totalSize, s.Size);
      finally
        s.Free;
      end;
    end;
end;

procedure TDemoForm.FormCreate(Sender: TObject);
begin
  if (ParamCount = 0) or not FileExists(ParamStr(1))
    then GetDir(0, SkinPath)
    else SkinPath := ParamStr(1);
  SkinPath := IncludeTrailingPathDelimiter(SkinPath);
  SkinList := TStringList.Create;
  SkinStream := TMemoryStream.Create;
  LoadSkins(SkinPath, SKIN_EXTENSIONS, SkinList, SkinStream);
end;

procedure TDemoForm.SkinButtonClick(Sender: TObject);
begin
  if SelectDirectory('Select SkinPath', 'C:\', SkinPath) then
    LoadSkins(SkinPath, SKIN_EXTENSIONS, SkinList, SkinStream);
end;

end.

Ich würde eine Klasse entwerfen, welche die hier gezeigte Funktionalität kapselt.

Freundliche Grüße

[busybyte]

//Edit UpDate V1.31
Mensch bin ich blöd,hab den Wald vor lauter Bäumen nicht gesehen,
Nach einigen Test musste ich feststellen,das es ca. 20% schneller ist, wenn man das Image
direkt mit dem Filename und nicht über loadfromstream lädt,warum auch immer? :wiejetzt:
Versucht es einfach selbst,wenn Ihr es nicht glaubt.
Ich hab die Streams in dieser Version rausgeschmissen.
Einen Stream sollte man aber verwenden,wenn z.B. die Ini-Datei zu groß werden würde.

//Edit Programmabbruch gefixt
Es scheint auch ungültige jpeg-dateien zu geben, die halt einen Fehler verursachen können,
das sollte aber kein Bug meines Codes sein sondern TPicture rafft das irgendwie nicht.

//Edit
Die Umwandlung über ein TJPEGImage dauert aber ebenfalls seine Zeit(ca. 20%) und ist
für JPEGs nicht mehr nötig,
deswegen: weg damit.

//Edit
Die Megabremse (bei grösseren Bildern !) ist aber ein refresh vom Image nach dem laden.
, also habe ich die Application.Prozessmessages begrenzt,und siehe da,Rakete!!!.
Wenn Ihr etwas Zeit habt könnt Ihr das prozessmessages einschalten
und dann zusehen(nur bei grossen) wie geladen wird
Deswegen auch die Unterschiede in der Zeitmessung ,wenn die Form inaktiv ist.

Delphi-Quellcode:

unit Unit1;

interface

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

type

  PSkinDateien=^TStringList;


  TForm1 = class(TForm)
   { Button1: TButton;
    Memo1: TMemo;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Label2: TLabel;
    Image1: TImage;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;}
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
   Procedure Streamini;
   Procedure Streamfree;
   { Private declarations }
  public
  SkinDateien:TStringList;
  SkinDateienP:PSkinDateien;
  SkinListe: TList;
  ErrorCode:integer;
  procedure LoadMemory;
  procedure FindFiles(Var DList_:TStringList);
  procedure resetDatas(Var DList_:TStringList);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
Var
AnzSkinDateien:Longint;
Search :Boolean;
SkinPfad:String;
Extensions:TStringList;
Imgcnt:integer;
SizeofAll:int64;
StrtTick,Tick:Cardinal;

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


procedure TForm1.LoadMemory;
begin
  try
  Search := True;
  AnzSkinDateien:=0;

  if (SkinDateien=nil) then
  SkinDateien:=TStringlist.Create;
  SkinDateien.Clear;
  FindFiles(SkinDateien);
  //zu Testzwecken um zu sehen ob bis hier alles klappt:
  Memo1.Lines.Assign(SkinDateien);                                          //<---Bremse !!!
  except SkinDateien.Free; end;
end;


//Diese super Function und Teile dieses Codes sind von anderen Usern ,
//z.B. bluescreen25, der diesen Thread begonnen hat,
//,bitte meldet Euch,wenn ihr erwähnt werden wollt. 

function MyGetFileSize(const FileName: String):int64;
var FileHandle: Cardinal; var Data: WIN32_FIND_DATA;
begin
  FileHandle := FindFirstFile(PChar(FileName), Data);
  try
    if FileHandle > 0 then
    begin
    Int64Rec(Result).Hi := Data.nFileSizeHigh;
    Int64Rec(Result).Lo := Data.nFileSizeLow;
    end;
  finally Windows.FindClose(FileHandle);
  end;
end;

procedure TForm1.FindFiles(Var DList_:TStringList);
Var
S:String;
FS:int64;
  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 <> '..')
            and (SR.Name <> '')
            then
           DoSearch(Path + SR.Name + '\')

         else
          if Extensions.IndexOf(ExtractFileExt(SR.Name)) >= 0 then  //Bug: nur jpeg-Dateien gefixt
             begin
             S:=Path + SR.Name;
             FS:=MyGetFileSize(S);
             //Provisorisch Speicherüberlauf verhindern
             while (SizeofAll+FS>200000000) do
               begin
               ErrorCode:=1;
               exit;
               end;
             SizeofAll:=SizeofAll+FS;
             //In Liste aufnehmen
             SkinDateienP^.Add(S);
             //DList_.Add(S);
             end;

        until FindNext(SR) <> 0;

     finally
       FindClose(SR);
     end;
    end;

begin
    try
     Tick := GetTickCount + 100;
     DOSearch(SkinPfad);
    except DList_.Free;
    end;
end;


procedure TForm1.Button1Click(Sender: TObject);
Var Filename_:String;
cnt1,L1:integer;
begin with Opendialog1 do
begin
Filter:=FileFilter;
  if execute then
    begin
    Filename_:=Filename;
    SkinPfad:=  extractfilepath(Filename_);
    Label1.Caption:='';
    SizeofAll:=0;
    StrtTick:=Gettickcount;
    LoadMemory;    //Dateien suchen und in Stringliste laden
    Label1.Caption:=inttostr(SkinDateien.Count)+ ' Dateinamen';
    Label2.Caption:=inttostr(SizeofAll div 1000000)+' MB' ;
    Label3.Caption:='in ' +inttostr((Gettickcount-StrtTick) div 1000 )+' Sek.' ;
    end;
end;
end;


procedure TForm1.Button2Click(Sender: TObject);
Var L1,cnt1_:integer;
  cnt1: Integer;
  FN_:String;
begin
L1:=SkinDateienP^.Count;
StrtTick:=Gettickcount;
imgCnt:=0;
for cnt1 := 0 to L1- 1 do
begin
 //Antifreeze;
  if GetTickCount >= Tick then
     begin
     Tick:= GetTickCount +10; //hier kann man rumspielen,wenn's einem zu langsam, oder zu schnell geht
     //MEGABREMSE
     Application.ProcessMessages;
     end;

  //Alle Pics in Image1 oder wahlweise nur bestimmte
   try
   if Fileexists(SkinDateien[cnt1]) then
    Image1.Picture.LoadFromFile(SkinDateien[cnt1]);
   inc(imgCnt);                                          //Update V1.31
except;end;
end;

Label4.Caption:= inttostr(imgcnt)+' Bilder';
showmessage('Erfolgreich: '+Label4.Caption);
Label5.Caption:='in ' +inttostr((Gettickcount-StrtTick) div 1000 )+' Sek.' ;
end;


procedure TForm1.resetDatas(Var DList_:TStringList);
begin
DList_.Clear;
Memo1.Clear;
end;

Procedure TForm1.Streamini;
begin
Image1.Stretch:=True;  //EDIT
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;
  //Pointer
  GetMem(SkinDateienP, SizeOf(TStringlist));
  SkinDateienP^ := TStringList.Create;
  SkinDateien:=TStringList.Create;
  SkinDateienP^:=SkinDateien;
  SkinListe:=TList.Create;
end;

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

Procedure TForm1.Streamfree;
begin
  SkinDateien.Free;
  freeandnil(Extensions);
end;

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

leider ist die Zeitmessung stark davon abhängig,wieviele ungültige Dateien vorhanden sind
und ob das Program aktiv oder im Hintergrund läuft.
Auf meinem gesamten Laufwerk c: (Bild6) waren es 10,die Zeit,bis die Fehler weggeklick werden wird mitgezählt.
(könnte man fast ein Spiel draus machen)

[busybyte]

So habe fertig,hoffe es hat geholfen,ich habe jetzt jedenfalls einiges über Streams und Images gelernt.

thx and bye! :coder2:

[busybyte]

Hehe, da soll noch einer meckern !
Das ist mit der exe,also ohne Compilermeldungen :mrgreen:

[busybyte]

Lol,wenn es mehr als 1000 Dateien sind und gleich nach Button1 ,
bzw. der Auswahl der Datei ,
Button2 gedrückt wird, überholt der loadar sogar
den Button1 (Ich schätze mal das Assign/Refresh von Memo1) :shock:

[busybyte]

Ich hab jetz mal das Image auf Vollbild gezoomt und muss sagen (ohne Eigenlob)
bei geigneten kleinen Vorlagen ist JurrasicPark nicht mehr weit.//Edit