unit LoadImageFromURL;

interface

uses
  RyuGraphics, HandleComponent, SimpleThread,
  IdHTTP, IdURI, IdSSLOpenSSL, JPeg,
  Windows, Messages, Classes, SysUtils, Types, Graphics;

type
  TCallBack = reference to procedure(AJPG:TJPEGImage);

procedure LoadJpegFromUrl(AURL:string; ACallBack:TCallBack);

function LoadJpegFromUrlToBitmap(AURL:string; ABitmap:TBitmap):boolean; overload;
function LoadJpegFromUrlToBitmap(AURL:string; ABitmap:TBitmap; AWidth,AHeight:integer):boolean; overload;

procedure AsyncLoadJpegFromUrlToBitmap(AURL:string; ABitmap:TBitmap); overload;
procedure AsyncLoadJpegFromUrlToBitmap(AURL:string; ABitmap:TBitmap; AWidth,AHeight:integer); overload;

implementation

const
  WM_Downloaded = WM_USER + 1;
  WM_Error = WM_USER + 2;

type
  TDownloader = class (THandleComponent)
  private
    FURL : string;
    FCallBack : TCallBack;
    procedure do_WM_Downloaded(var AMsg:TMessage); message WM_Downloaded;
    procedure do_WM_Error(var AMsg:TMessage); message WM_Error;
  private
    FSimpleThread : TSimpleThread;
    procedure on_Execute(Sender:TObject);
  public
    constructor Create(AURL:string; ACallBack:TCallBack); reintroduce;
  end;

{ TDownloader }

constructor TDownloader.Create(AURL:string; ACallBack:TCallBack);
begin
  inherited Create(nil);

  FURL := Trim(AURL);
  FCallBack := ACallBack;

  FSimpleThread := TSimpleThread.Create(on_Execute);
end;

procedure TDownloader.do_WM_Downloaded(var AMsg: TMessage);
var
  JPG : TJPEGImage;
begin
  JPG := Pointer(AMsg.WParam);
  try
    FCallBack(JPG);
  finally
    JPG.Free;
  end;
  FreeAndNil(Self);
end;

procedure TDownloader.do_WM_Error(var AMsg: TMessage);
begin
  FCallBack(nil);
  FreeAndNil(Self);
end;

procedure TDownloader.on_Execute(Sender:TObject);
var
  IdHTTP : TIdHTTP;
  JPG : TJPEGImage;
  msData : TMemoryStream;
begin
  IdHTTP := TIdHTTP.Create(nil);
  msData := TMemoryStream.Create;
  try
    try
      with TIdURI.Create(FURL) do
      try
        if LowerCase(Protocol) = 'https' then
          IdHTTP.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP);
      finally
        Free;
      end;

      IdHTTP.Request.UserAgent:= 'Mozilla/3.0 (compatible; " followed by HiMyTV, followed by HiMyTV ")';
      IdHTTP.Get(FURL, msData);
      if msData.Size = 0 then raise Exception.Create('Download failed.');

      JPG := TJPEGImage.Create;
      msData.Position := 0;
      JPG.LoadFromStream(msData);
      PostMessage(Handle, WM_Downloaded, Integer(JPG), 0);
    except
      PostMessage(Handle, WM_Error, 0, 0);
    end;
  finally
    IdHTTP.Free;
    msData.Free;
  end;
end;

procedure LoadJpegFromUrl(AURL:string; ACallBack:TCallBack);
begin
  TDownloader.Create(AURL, ACallBack);
end;

function LoadJpegFromUrlToBitmap(AURL:string; ABitmap:TBitmap):boolean;
var
  IdHTTP : TIdHTTP;
  JPG : TJPEGImage;
  msData : TMemoryStream;
begin
  Result := false;

  AURL := Trim(AURL);
  if AURL = '' then Exit;

  IdHTTP := TIdHTTP.Create(nil);
  JPG := TJPEGImage.Create;
  msData := TMemoryStream.Create;
  try
    try
      with TIdURI.Create(AURL) do
      try
        if LowerCase(Protocol) = 'https' then
          IdHTTP.IOHandler := TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP);
      finally
        Free;
      end;

      IdHTTP.Get(AURL, msData);
      if msData.Size = 0 then Exit;

      msData.Position := 0;
      JPG.LoadFromStream(msData);
      ABitmap.Assign(JPG);
    except
      Exit;
    end;

    Result := true;
  finally
    IdHTTP.Free;
    JPG.Free;
    msData.Free;
  end;
end;

function LoadJpegFromUrlToBitmap(AURL:string; ABitmap:TBitmap; AWidth,AHeight:integer):boolean;
var
  Src, Dst : TBitmap;
  TargetSize : TPoint;
begin
  Result := false;

  AURL := Trim(AURL);
  if AURL = '' then Exit;

  if AWidth * AHeight <> 0 then begin
    Src := TBitmap.Create;
    Dst := TBitmap.Create;
    try
      Result := LoadJpegFromUrlToBitmap(AURL, Src);

      if Result then begin
        Src.PixelFormat := pf32bit;
        Dst.PixelFormat := pf32bit;

        TargetSize := RatioSize(Point(Src.Width, Src.Height), Point(AWidth, AHeight));

        Dst.Width := TargetSize.X;
        Dst.Height := TargetSize.Y;

        try
          SmoothResize(Src, Dst);
          ABitmap.Assign(Dst);
        except
          Result := false;
        end;
      end;
    finally
      Src.Free;
      Dst.Free;
    end;
  end else begin
    Result := LoadJpegFromUrlToBitmap(AURL, ABitmap);
  end;
end;

procedure AsyncLoadJpegFromUrlToBitmap(AURL:string; ABitmap:TBitmap);
begin
  AURL := Trim(AURL);
  if AURL = '' then Exit;

  LoadJpegFromUrl(AURL,
    procedure (AJPG:TJPEGImage) begin
      if AJPG <> nil then ABitmap.Assign(AJPG);
    end
  );
end;

procedure AsyncLoadJpegFromUrlToBitmap(AURL:string; ABitmap:TBitmap; AWidth,AHeight:integer); overload;
var
  Src, Dst : TBitmap;
  TargetSize : TPoint;
begin
  AURL := Trim(AURL);
  if AURL = '' then Exit;

  LoadJpegFromUrl(AURL,
    procedure (AJPG:TJPEGImage) begin
      if AJPG = nil then Exit;

      if AWidth * AHeight <> 0 then begin
        Src := TBitmap.Create;
        Dst := TBitmap.Create;
        try
          Src.Assign(AJPG);

          Src.PixelFormat := pf32bit;
          Dst.PixelFormat := pf32bit;

          TargetSize := RatioSize(Point(Src.Width, Src.Height), Point(AWidth, AHeight));

          Dst.Width := TargetSize.X;
          Dst.Height := TargetSize.Y;

          try
            SmoothResize(Src, Dst);
            ABitmap.Assign(Dst);
          except
          end;
        finally
          Src.Free;
          Dst.Free;
        end;
      end else begin
        ABitmap.Assign(AJPG);
      end;
    end
  );
end;

end.
