unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls,
ExtCtrls,JPEG,ClipBrd;
type
PSkinDateien=^TStringList;
TForm1 =
class(TForm)
//Die werden benötigt !!!!
{ OpenDialog1: TOpenDialog;
Button1: TButton;
Button2: TButton;
Image1: TImage;
}
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
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;
Abort:Boolean;
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;
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
while Abort
do
exit;
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;
Abort:=False;
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;
while Abort
do
exit;
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: '+inttostr(imgcnt)+'
Bilder');
//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;
//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;
procedure TForm1.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
Abort:=True;
Canclose:=True;
end;
end.