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.