Skip to content

Instantly share code, notes, and snippets.

@dkstar88
Created July 23, 2013 06:43
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save dkstar88/6060301 to your computer and use it in GitHub Desktop.
Save dkstar88/6060301 to your computer and use it in GitHub Desktop.
A ImageLoader for FireMonkey TImage component. I written this when I found I need to load a few images from the Internet. Obviously delphi isn's browser, if I just call download using Indy it will just block my app's UI. ImageLoader is very simple class with a loading queue, and a timer to trigger the work on the queue. You just need to call the…
unit uImageLoader;
interface
uses SysUtils, Classes, System.Generics.Collections,
FMX.Types, FMX.Objects, FMX.Controls, AsyncTask, AsyncTask.HTTP;
type
TLoadQueueItem = record
ImageURL: String;
Image: TImage;
end;
TLoadQueue = TList<TLoadQueueItem>;
TImageLoader = class(TObject)
private
fQueue: TLoadQueue;
fWorker: TTimer;
fActiveItem: TLoadQueueItem;
fIsWorking: Boolean;
procedure QueueWorkerOnTimer(ASender: TObject);
public
constructor Create;
destructor Destroy; override;
procedure LoadImage(AImage: TImage; AImageURL: string);
property ActiveItem: TLoadQueueItem read fActiveItem;
property IsWorking: Boolean read fIsWorking;
end;
var
DefaultImageLoader: TImageLoader;
implementation
var
FCachedImages: TObjectDictionary<String, TBitmap>;
{ TImageLoader }
constructor TImageLoader.Create;
begin
inherited Create;
fQueue := TLoadQueue.Create;
fIsWorking := False;
fWorker := TTimer.Create(nil);
fWorker.Enabled := False;
fWorker.Interval := 100;
fWorker.OnTimer := QueueWorkerOnTimer;
fWorker.Enabled := True;
end;
destructor TImageLoader.Destroy;
begin
fWorker.Free;
fQueue.Free;
inherited;
end;
procedure TImageLoader.LoadImage(AImage: TImage; AImageURL: string);
var
item: TLoadQueueItem;
begin
item.ImageURL := AImageURL;
item.Image := AImage;
fQueue.Add(item);
end;
procedure TImageLoader.QueueWorkerOnTimer(ASender: TObject);
var
lBitmap: TBitmap;
begin
fWorker.Enabled := False;
if (fQueue.Count > 0) and (not fIsWorking) then
begin
fIsWorking := True;
fActiveItem := fQueue[0];
fQueue.Delete(0);
lBitmap := nil;
if FCachedImages.TryGetValue(fActiveItem.ImageURL, lBitmap) and (lBitmap <> nil) then
begin
fActiveItem.Image.Bitmap.Assign(lBitmap);
fIsWorking := False;
end else
begin
AsyncTask.Run(
THttpAsyncTaskBitmap.Create(fActiveItem.ImageURL),
// Finished
procedure (ATask: IAsyncTask)
var
fBitmap: TBitmap;
begin
lBitmap := TBitmap.Create(0, 0);
fBitmap := (ATask as IHttpBitmapResponse).Bitmap;
if fBitmap <> nil then
begin
lBitmap.Assign(fBitmap);
FCachedImages.AddOrSetValue(fActiveItem.ImageURL, lBitmap);
fActiveItem.Image.Bitmap.Assign(lBitmap);
end;
fIsWorking := False;
end
);
end;
end;
fWorker.Enabled := True;
end;
initialization
FCachedImages := TObjectDictionary<String, TBitmap>.Create([], 10);
DefaultImageLoader := TImageLoader.Create;
finalization
FCachedImages.Free;
DefaultImageLoader.Free;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment