本文整理自网络，侵删。
(* *************************************************
1、里面放多张图片，用文件名作为索引
2、线程在背后从硬盘加载到内存
3、批量加载
4、加载完成后执行回调，回调是线程安全的
5、回调中的参数是新加载了多少张图片
************************************************** *)
unit BitmapList;
interface
uses
ystem.SysUtils, System.Classes, FMX.Graphics, Generics.Collections,
xSuperObject, xSuperJson, UrlMon, IdURI, DateUtils;
type
TBitmapList = class(TDictionary<string, TBitmap>)
private
public
RPath, LPath: string; // url路径，本地路径
function CreateDirPath(url: string): string; // 生成路径
function GetSubDateTime(S1, S2: string): string; // 获取两个时间间隔
procedure LoadFromFiles(s: string; callback: TProc < Integer >= nil); overload; // 加载一个或逗号分隔的多个图片文件名
procedure LoadFromFiles(ss: TStrings; callback: TProc < Integer >= nil);overload; // TStrings 的多个图片文件名
procedure LoadFromFiles(ja: ISuperArray; callback: TProc < Integer >= nil); overload; // jo 的多个图片文件名
procedure LoadFromFiles(ja: ISuperArray; k: string; callback: TProc < Integer >= nil); overload; // ja.O[i].S[K]的多个图片文件名 ja里的某个值
end;
implementation
uses UnitLog;
{ TBitmapList }
procedure TBitmapList.LoadFromFiles(s: string; callback: TProc<Integer>);
var
temp1, temp2: string;
i, j: Integer;
begin
TThread.CreateAnonymousThread(
procedure
var
i, n: Integer;
t, t1: string;
o: TBitmap;
a: TArray<string>;
begin
n := 0;
a := s.Split([',']);
for i := 0 to length(a) - 1 do
begin
t := a[i];
if (t <> '') and (not ContainsKey(t)) then
begin
if (not FileExists(t)) and (RPath <> '') then
begin
t1 := t.Replace(RPath, LPath).Replace('/', '\'); // 本地路径
if (UrlDownloadToFile(nil, PChar(TIdURI.URLEncode(t)), PChar(t1), 0, nil) = 0) then
t := t1
else
t := '';
end;
if (t <> '') and (ContainsKey(t) = False) then
begin
o := TBitmap.Create;
o.LoadFromFile(t);
Add(t, o);
Inc(n);
end;
end;
end;
if (Assigned(callback)) then
TThread.Synchronize(TThread.CurrentThread,
procedure
begin
callback(n);
end);
end).Start;
end;
procedure TBitmapList.LoadFromFiles(ss: TStrings; callback: TProc<Integer>);
var
s: string;
i: Integer;
begin
for i := 0 to ss.Count - 1 do
begin
s := ss[i];
LoadFromFiles(s, callback);
end;
end;
procedure TBitmapList.LoadFromFiles(ja: ISuperArray; k: string;
callback: TProc<Integer>);
var
s: String;
x: IMember;
i: Integer;
begin
s := '';
for x in ja do
s := s + x.AsObject.s[k] + ',';
s := s.TrimRight([',']);
LoadFromFiles(s, callback);
end;
procedure TBitmapList.LoadFromFiles(ja: ISuperArray; callback: TProc<Integer>);
var
s: string;
x: IMember;
begin
s := '';
for x in ja do
s := x.AsString;
LoadFromFiles(s, callback);
end; 相关阅读 >>
Delphi idtcpclient和idtcpserver主要属性
Delphi xe5 android获取手机联系人，并用listview显示
更多相关阅读请进入《Delphi》频道 >>
