procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
src: string;
ms: TMemoryStream;
si :TCustomsourceItem;
img : Timage;
xList: TList<string>;
scale:integer;
d : TCustomDestinationItem;
Layer :TLayer;
w,h:Single;
begin
xList := TList<string>.Create;
ms := TMemoryStream.Create;
GetDirect('路徑' + '*.*', False, xList, '.png', True);
try
i:=0;
repeat
ms.LoadFromFile(xList.Items[i]);
ms.Position := 0;
// Source
si:=ImageList1.Source.Add;
si.Name:= 'Source'+inttostr(i);
ms.Seek(0, soFromBeginning);
scale:=1;
si.MultiResBitmap.LoadItemFromStream(ms, scale);
W:=si.MultiResBitmap.Bitmaps[scale].Width; //Get width from scale
H:=si.MultiResBitmap.Bitmaps[scale].Height; //Get height from scale
d:=imageList1.Destination.Add;
Layer := d.Layers.Add;
Layer.SourceRect.Rect := TRectF.Create(0, 0, W , H); // Create rect W x H
Layer.Name := si.name;
Inc(i)
until
xList.Count -1 = i
finally
xList.Free;
end;
end;
procedure TForm1.GetDirect(mask: String; isRecursiveSearch_: Boolean;
var xList: TList<string>; xFilter: string; xGetFullName: Boolean);
var
sr :TSearchRec;
tExt :String;
tDir :String;
mStr:string;
begin
try
tExt := ExtractFileName(mask);
tDir := ExtractFilePath(mask);
if tDir[Length(tDir)] <> '\' then tDir := tDir+'\';
if FindFirst(mask, faAnyFile, sr) = 0 then
begin
repeat
if not (sr.Name = '.') and not (sr.Name ='..') then
begin
//mStr := Format('%s%s', [tDir, sr.Name]);
//mStr := StringReplace(sr.Name,'Cart_','',[]);
if Pos(xFilter,sr.Name) > 0 then
begin
if xGetFullName then
begin
mStr := Format('%s%s', [tDir, sr.Name]);
xList.Add(mStr);
end
else
xList.Add(sr.Name);
end;
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
finally
end;
end;