{*************************************************************************}
{ TAdvCloudImage                                                          }
{ for Delphi & C++Builder                                                 }
{                                                                         }
{ written by                                                              }
{   TMS Software                                                          }
{   copyright © 2012                                                      }
{   Email : info@tmssoftware.com                                          }
{   Web : http://www.tmssoftware.com                                      }
{                                                                         }
{ The source code is given as is. The author is not responsible           }
{ for any possible damage done due to the use of this code.               }
{ The component can be freely used in any application. The complete       }
{ source code remains property of the author and may not be distributed,  }
{ published, given or sold in any form as such. No parts of the source    }
{ code can be included in any other component or application without      }
{ written authorization of the author.                                    }
{*************************************************************************}

unit CloudImage;

{$I TMSDEFS.INC}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  WinInet, ActiveX, CloudGDIP;

const
  MAJ_VER = 1; // Major version nr.
  MIN_VER = 0; // Minor version nr.
  REL_VER = 0; // Release nr.
  BLD_VER = 0; // Build nr.

  // Version history
  // 1.0.0.0 : First release

type
  TPicturePosition = (bpTopLeft,bpTopRight,bpBottomLeft,bpBottomRight,bpCenter,bpTiled,bpStretched,bpStretchedWithAspectRatio, bpShrink, bpShrinkWithAspectRatio);

  TCloudPicture = class;

  PInternetContent = ^TInternetContent;
  TInternetContent = record
    HResource: hinternet;
    Complete: Boolean;
    WebPicture: TCloudPicture;
  end;

  TDownloadErrorEvent = procedure(Sender:TObject;err:string) of object;
  TDownloadCompleteEvent = procedure(Sender:TObject) of object;
  TDownloadCancelEvent = procedure(Sender:TObject;var Cancel:boolean) of object;
  TDownloadProgressEvent = procedure(Sender:TObject;dwSize,dwTotSize:Cardinal) of object;

  TDownLoadThread = class(TThread)
  private
    CloudPicture: TCloudPicture;
  protected
    procedure Execute; override;
  public
    constructor Create(ACloudPicture: TCloudPicture);
  end;

  TCloudPicture = class(TGraphic)
  private
    { Private declarations }
    FWidth: integer;
    FHeight: integer;
    FDatastream: TMemoryStream;
    FIsEmpty: Boolean;
    FStretched: Boolean;
    FLogPixX,FLogPixY: Integer;
    FID: string;
    FURL: string;
    FCheckContentLength: Boolean;
    FAsynch:Boolean;
    FThreadBusy:boolean;
    FOnDownLoadProgress: TDownLoadProgressEvent;
    FOnDownLoadCancel: TDownLoadCancelEvent;
    FOnDownLoadComplete: TDownLoadCompleteEvent;
    FOnDownLoadError: TDownLoadErrorEvent;
    function IsGIFFile: Boolean;
  protected
    { Protected declarations }
    function GetEmpty: Boolean; override;
    function GetHeight: Integer; override;
    function GetWidth: Integer; override;
    procedure SetHeight(Value: Integer); override;
    procedure SetWidth(Value: Integer); override;
    procedure ReadData(Stream: TStream); override;
    procedure WriteData(Stream: TStream); override;
    procedure Draw(ACanvas: TCanvas; const Rect: TRect); override;
    procedure DownLoadError(err:string);
    procedure DownLoadComplete;
    procedure DownLoadCancel(var Cancel:boolean);
    procedure DownLoadProgress(dwSize, dwTotSize:Cardinal);
    procedure DownLoad;
    procedure GetSize;
  public
    { Public declarations }
    constructor Create; override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure LoadFromFile(const FileName: string); override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure LoadFromResourceName(Instance: THandle; const ResName: String);
    procedure LoadFromResourceID(Instance: THandle; ResID: Integer);
    procedure LoadFromURL(url:string);
    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
      APalette: HPALETTE); override;
    procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
      var APalette: HPALETTE); override;
    property ID:string read fID write fID;
    property IsGIF: Boolean read IsGIFFile;
    property Busy: Boolean read FThreadBusy;
    property Asynch: Boolean read FAsynch write FAsynch;
    property CheckContentLength: Boolean read FCheckContentLength write FCheckContentLength;
  published
    { Published declarations }
    property Stretch: Boolean read FStretched write FStretched;
    property OnDownLoadError: TDownLoadErrorEvent read FOnDownLoadError write FOnDownLoadError;
    property OnDownLoadComplete: TDownLoadCompleteEvent read FOnDownLoadComplete write FOnDownLoadComplete;
    property OnDownLoadCancel: TDownLoadCancelEvent read FOnDownLoadCancel write FOnDownLoadCancel;
    property OnDownLoadProgress: TDownLoadProgressEvent read FOnDownLoadProgress write FOnDownLoadProgress;
  end;


  {$IFDEF DELPHIXE2_LVL}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
  {$ENDIF}
  TAdvCloudImage = class(TGraphicControl)
  private
    { Private declarations }
    FAutoSize: Boolean;
    FCloudPicture:TCloudPicture;
    FPicturePosition:TPicturePosition;
    FOnDownLoadCancel: TDownLoadCancelEvent;
    FOnDownLoadComplete: TDownLoadCompleteEvent;
    FOnDownLoadError: TDownLoadErrorEvent;
    FOnDownLoadProgress: TDownLoadProgressEvent;
    FURL: string;
    FAsynch: Boolean;
    FCheckContentLength: Boolean;
    procedure SeTCloudPicture(const Value: TCloudPicture);
    procedure PictureChanged(sender: TObject);
    procedure SetPicturePosition(const Value: TPicturePosition);
    procedure DownLoadError(Sender: TObject;err: string);
    procedure DownLoadComplete(Sender: TObject);
    procedure DownLoadCancel(Sender: TObject;var cancel: Boolean);
    procedure DownLoadProgress(Sender: TObject;dwSize,dwTotSize:Cardinal);
    procedure SetURL(const Value: string);
    function GetVersion: string;
    procedure SetVersion(const Value: string);
    function GetVersionNr: Integer;
  protected
    { Protected declarations }
     procedure Paint; override;
  public
    { Public declarations }
    constructor Create(aOwner:TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure SaveToFile(Filename: string);
  published
    { Published declarations }
    property Async: Boolean read FAsynch write FAsynch;
    property AutoSize: Boolean read FAutoSize write FAutoSize;
    property CheckContentLength: Boolean read FCheckContentLength write FCheckContentLength;
    property WebPicture: TCloudPicture read FCloudPicture write SeTCloudPicture;
    property PicturePosition: TPicturePosition read FPicturePosition write SetPicturePosition;
    { inherited published properties}
    property Align;
    property Anchors;
    property Constraints;
    property DragKind;
    property DragCursor;
    property DragMode;
    property Hint;
    property ParentShowHint;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnStartDock;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnStartDrag;
    property OnDownLoadError: TDownLoadErrorEvent read FOnDownLoadError write FOnDownLoadError;
    property OnDownLoadComplete: TDownLoadCompleteEvent read FOnDownLoadComplete write FOnDownLoadComplete;
    property OnDownLoadCancel: TDownLoadCancelEvent read FOnDownLoadCancel write FOnDownLoadCancel;
    property OnDownLoadProgress: TDownLoadProgressEvent read FOnDownLoadProgress write FOnDownLoadProgress;
    property URL: string read FURL write SetURL;
    property Version: string read GetVersion write SetVersion;
  end;


implementation

const
  HIMETRIC_INCH = 2540;
  TIMER_ID = 500;  

{ TCloudPicture }

procedure TCloudPicture.Assign(Source: TPersistent);
begin
  FIsEmpty := true;
  if (Source = nil) then
  begin
    FDataStream.Clear;
    if Assigned(OnChange) then OnChange(self);
  end
  else
  begin
    if (Source is TCloudPicture) then
    begin
      FDataStream.LoadFromStream(TCloudPicture(Source).FDataStream);
      FIsEmpty := False;
      if Assigned(OnChange) then OnChange(self);
    end;
  end;
end;

constructor TCloudPicture.Create;
begin
  inherited;
  FDataStream := TMemoryStream.Create;
  FIsEmpty := True;
  FLogPixX := 96;
  FLogPixY := 96;
  FThreadBusy := False;
  FAsynch := True;
end;

destructor TCloudPicture.Destroy;
begin
  FDataStream.Free;
  inherited;
end;

procedure TCloudPicture.GetSize;
var
  multi: TGPImage;
  pstm: IStream;
  hGlobal: THandle;
  pcbWrite: Longint;

begin
  FWidth := 0;
  FHeight := 0;

  if FDataStream.Size = 0 then
    Exit;

  hGlobal := GlobalAlloc(GMEM_MOVEABLE, FDataStream.Size);
  if (hGlobal = 0) then
    raise Exception.Create('Could not allocate memory for image');

  try
    pstm := nil;
    // Create IStream* from global memory
    CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
    pstm.Write(FDataStream.Memory, FDataStream.Size,@pcbWrite);

    multi := TGPImage.Create(pstm);
    FWidth := multi.GetWidth;
    FHeight := multi.GetHeight;
    multi.Free;
  finally
    GlobalFree(hGlobal);
  end;
end;

procedure TCloudPicture.Draw(ACanvas: TCanvas; const Rect: TRect);
var
  dc: HDC;
  multi: TGPImage;
  graphic: TGPGraphics;
  pstm: IStream;
  hGlobal: THandle;
  pcbWrite: Longint;
  bmp: TBitmap;

begin
  if Empty then
    Exit;

  if FDataStream.Size = 0 then
    Exit;


  hGlobal := GlobalAlloc(GMEM_MOVEABLE, FDataStream.Size);
  if (hGlobal = 0) then
    raise Exception.Create('Could not allocate memory for image');

  try
    pstm := nil;

    // Create IStream* from global memory
    CreateStreamOnHGlobal(hGlobal, TRUE, pstm);
    pstm.Write(FDataStream.Memory, FDataStream.Size,@pcbWrite);

    dc := ACanvas.Handle;
    graphic:= TGPgraphics.Create(dc);
    multi := TGPImage.Create(pstm);

    if multi.GetFormat = ifBMP then
    begin // use this alternative for easy bitmap auto transparent drawing
      bmp := TBitmap.Create;
      try
        FDataStream.Position := 0;
        bmp.LoadFromStream(FDataStream);
        bmp.TransparentMode := tmAuto;
        bmp.Transparent := true;
        ACanvas.StretchDraw(Rect,bmp);
      finally
        bmp.Free;
      end;
    end
    else
    begin
      graphic.DrawImageRect(multi, Rect.Left, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top);
    end;

    multi.Free;
    graphic.Free;
  finally
    GlobalFree(hGlobal);
  end;
end;

function TCloudPicture.GetEmpty: Boolean;
begin
  Result := FIsEmpty;
end;

function TCloudPicture.GetHeight: Integer;
begin
  Result := FHeight;
end;

function TCloudPicture.GetWidth: Integer;
begin
  Result := FWidth;
end;

procedure TCloudPicture.LoadFromFile(const FileName: string);
begin
  try
    FDataStream.LoadFromFile(Filename);
    FIsEmpty := False;
    if Assigned(OnChange) then
      OnChange(Self);
  except
    FIsEmpty := True;
  end;
end;

procedure TCloudPicture.LoadFromStream(Stream: TStream);
begin
  if Assigned(Stream) then
  begin
    FDataStream.LoadFromStream(Stream);
    GetSize;
    FIsEmpty := False;
    if Assigned(OnChange) then
      OnChange(Self);
  end;
end;

procedure TCloudPicture.ReadData(Stream: TStream);
begin
  if Assigned(Stream) then
  begin
    FDataStream.LoadFromStream(Stream);
    FIsEmpty := False;
  end;
end;

procedure TCloudPicture.SaveToStream(Stream: TStream);
begin
  if Assigned(Stream) then
    FDataStream.SaveToStream(Stream);
end;

procedure TCloudPicture.LoadFromResourceName(Instance: THandle; const ResName: string);
var
  Stream: TCustomMemoryStream;
begin
  if FindResource(Instance,pchar(ResName),RT_BITMAP)<>0 then
  begin
    Stream := TResourceStream.Create(Instance, ResName, RT_RCDATA);
    try
      LoadFromStream(Stream);
    finally
      Stream.Free;
    end;
  end;
end;

procedure TCloudPicture.LoadFromResourceID(Instance: THandle; ResID: Integer);
var
  Stream: TCustomMemoryStream;
begin
  Stream := TResourceStream.CreateFromID(Instance, ResID, RT_RCDATA);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;


procedure TCloudPicture.SetHeight(Value: integer);
begin

end;

procedure TCloudPicture.SetWidth(Value: integer);
begin

end;

procedure TCloudPicture.WriteData(Stream: TStream);
begin
  if Assigned(Stream) then
  begin
    FDataStream.Savetostream(Stream);
  end;
end;

procedure TCloudPicture.LoadFromURL(url: string);
var
  uurl: string;
begin
  uurl := Uppercase(url);
  if Pos('RES://',uurl) = 1 then
  begin
   ID := url;
   Delete(url,1,6);
   if URL <> '' then
     LoadFromResourceName(hinstance,url);
   Exit;
  end;

  if Pos('FILE://',uurl) = 1 then
  begin
    ID := url;
    Delete(url,1,7);
    if url <> '' then
      LoadFromFile(url);
    Exit;
  end;

  if FAsynch then
  begin
    if FThreadBusy then
      Exit;
    FURL := url;
    FThreadBusy := True;
    TDownLoadThread.Create(self);
  end
  else
  begin
    FURL := url;
    ID := url;
    DownLoad;
  end;
end;

procedure TCloudPicture.DownLoad;
var
  RBSIZE:dword;
  httpstatus,httpsize,err:integer;
  dwIdx:dword;
  dwBufSize:dword;
  ms: TMemoryStream;
  len:dword;
  cbuf:array[0..255] of char;
  rb:array[0..4095] of byte;
  fISession:hinternet;
  fIHttp:hinternet;
  cancel:boolean;

begin
  FISession := InternetOpen('WebImage',INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
  if (FISession = nil) then
  begin
    DownLoadError('Cannot open internet session');
    FThreadBusy := False;
    Exit;
  end;

  FIHttp := InternetOpenURL(fISession,pchar(furl),nil,0,
    INTERNET_FLAG_PRAGMA_NOCACHE or INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_RELOAD,0);

  if (FIHttp = nil) then
  begin
    InternetCloseHandle(FISession);
    DownLoadError('Cannot open http connection');
    FThreadBusy := False;
    Exit;
  end;

  dwBufSize := SizeOf(cbuf);
  dwidx:=0;
  HttpQueryInfo(fIHttp,HTTP_QUERY_STATUS_CODE,@cbuf,dwBufSize,dwIdx);

  val(cbuf,httpstatus,err);
  if (httpstatus <> 200) or (err <> 0) then
  begin
    InternetCloseHandle(fISession);
    InternetCloseHandle(fIHttp);
    DownLoadError('Cannot open URL '+furl);
    FThreadBusy := False;
    Exit;
  end;

  dwBufSize:=sizeof(cbuf);
  dwidx:=0;
  HttpQueryInfo(fIHttp,HTTP_QUERY_CONTENT_TYPE,@cbuf,dwBufSize,dwIdx);

  if (pos('IMAGE',uppercase(strpas(cbuf)))=0) then
  begin
    InternetCloseHandle(fISession);
    InternetCloseHandle(fIHttp);
    DownLoadError('Resource is not of image type : '+furl);
    FThreadBusy:=false;
    Exit;
  end;

  dwBufSize := SizeOf(cbuf);
  dwidx := 0;
  HttpQueryInfo(fIHttp,HTTP_QUERY_CONTENT_LENGTH,@cbuf,dwBufSize,dwIdx);

  Val(cbuf,httpsize,err);

  if ((httpsize = 0) or (err <> 0)) and CheckContentLength then
  begin
    InternetCloseHandle(fISession);
    InternetCloseHandle(fIHttp);
    DownLoadError('Image size is 0');
    FThreadBusy := False;
    Exit;
  end;

  DownLoadProgress(0,httpsize);

  len := 4096;
  RBSIZE := 4096;

  ms := TMemoryStream.Create;

  Cancel := False;

  while (len > 0) and not Cancel do
  begin
    InternetReadFile(fIHttp,@rb,RBSIZE,len);
    if len > 0 then
      ms.WriteBuffer(rb,len);
    DownLoadProgress(ms.Size,httpsize);
    DownLoadCancel(cancel);
  end;

  if not cancel then
  begin
    ms.Position := 0;
    LoadFromStream(ms);
    DownLoadComplete;
  end;

  ms.Free;

  InternetCloseHandle(fIHttp);
  InternetCloseHandle(fISession);
  FThreadBusy := false;
end;

procedure TCloudPicture.DownLoadCancel(var cancel: boolean);
begin
  if Assigned(FOnDownLoadCancel) then FOnDownLoadCancel(Self,cancel);
end;

procedure TCloudPicture.DownLoadComplete;
begin
  if Assigned(FOnDownLoadComplete) then FOnDownLoadComplete(Self);
end;

procedure TCloudPicture.DownLoadError(err: string);
begin
  if Assigned(FOnDownloadError) then FOnDownLoadError(Self,err);
end;

procedure TCloudPicture.DownLoadProgress(dwSize, dwTotSize: Cardinal);
begin
  if Assigned(FOnDownLoadProgress) then FOnDownLoadProgress(self,dwSize,dwTotSize);
end;

procedure TCloudPicture.LoadFromClipboardFormat(AFormat: Word;
  AData: THandle; APalette: HPALETTE);
begin
end;

procedure TCloudPicture.SaveToClipboardFormat(var AFormat: Word;
  var AData: THandle; var APalette: HPALETTE);
begin

end;

function TCloudPicture.IsGIFFile: Boolean;
var
  buf: array[0..4] of char;
begin
  Result := False;
  if FDataStream.Size>4 then
  begin
    FDataStream.Position := 0;
    FDataStream.Read(buf,4);
    buf[4] := #0;
    Result := Strpas(buf) = 'GIF8';
    FDataStream.Position := 0;
  end;
end;

{ TAdvCloudImage }

constructor TAdvCloudImage.Create(aOwner: TComponent);
begin
  inherited;
  FCloudPicture := TCloudPicture.Create;
  FCloudPicture.OnChange := PictureChanged;
  Width := 100;
  Height := 100;
  FCloudPicture.OnDownLoadError := DownLoadError;
  FCloudPicture.OnDownLoadCancel := DownLoadCancel;
  FCloudPicture.OnDownLoadProgress := DownLoadProgress;
  FCloudPicture.OnDownLoadComplete := DownLoadComplete;
end;

destructor TAdvCloudImage.Destroy;
begin
  FCloudPicture.Free;
  inherited;
end;

procedure TAdvCloudImage.Loaded;
begin
  inherited;
  FCloudPicture.FLogPixX := GetDeviceCaps(canvas.handle,LOGPIXELSX);
  FCloudPicture.FLogPixY := GetDeviceCaps(canvas.handle,LOGPIXELSY);
end;

procedure TAdvCloudImage.Paint;
var
  xo,yo:integer;
  rx,ry: Double;
  w,h: integer;

  function Max(a,b:Integer): Integer;
  begin
    if (a > b) then Result := a else Result := b;
  end;

begin
  inherited;
  if Assigned(FCloudPicture) then
  begin
    if not FCloudPicture.Empty then
    case FPicturePosition of
    bpTopLeft:Canvas.Draw(0,0,FCloudPicture);
    bpTopRight:Canvas.Draw(Max(0,Width - FCloudPicture.Width),0,FCloudPicture);
    bpBottomLeft:Canvas.Draw(0,Max(0,Height - FCloudPicture.Height),FCloudPicture);
    bpBottomRight:Canvas.Draw(Max(0,Width - FCloudPicture.Width),Max(0,Height - FCloudPicture.Height),FCloudPicture);
    bpCenter:Canvas.Draw(Max(0,Width - FCloudPicture.Width) shr 1,Max(0,Height - FCloudPicture.Height) shr 1,FCloudPicture);
    bpTiled:
      begin
        yo := 0;
        while (yo < Height) do
        begin
          xo := 0;
          while (xo < Width) do
          begin
            Canvas.Draw(xo,yo,FCloudPicture);
            xo := xo + FCloudPicture.Width;
          end;
          yo := yo + FCloudPicture.Height - 1;
        end;
      end;
    bpStretched:Canvas.StretchDraw(Rect(0,0,Width,Height),FCloudPicture);
    bpStretchedWithAspectRatio:
      begin
        rx := FCloudPicture.Width/Width;
        ry := FCloudPicture.Height/Height;
        if rx > ry then
          Canvas.StretchDraw(Rect(0,0,Width,Trunc(FCloudPicture.Height/rx)),FCloudPicture)
        else
         Canvas.StretchDraw(Rect(0,0,Trunc(FCloudPicture.Width/ry),Height),FCloudPicture);
      end;
    bpShrink:
      begin
        w := FCloudPicture.Width;
        if (FCloudPicture.Width > Width) then
          w := Width;

        h := FCloudPicture.Height;
        if (FCloudPicture.Height > Height) then
          h := Height;

        Canvas.StretchDraw(Rect(0,0,w,h),FCloudPicture);
      end;
    bpShrinkWithAspectRatio:
      begin
        if (FCloudPicture.Width > Width) or (FCloudPicture.Height > Height) then
        begin
          rx := FCloudPicture.Width/Width;
          ry := FCloudPicture.Height/Height;
          if rx > ry then
            Canvas.StretchDraw(Rect(0,0,Width,Trunc(FCloudPicture.Height/rx)),FCloudPicture)
          else
           Canvas.StretchDraw(Rect(0,0,Trunc(FCloudPicture.Width/ry),Height),FCloudPicture);
        end
        else
        begin
          Canvas.Draw(0,0,FCloudPicture);
        end;
      end;
    end;
  end;

  if (csDesigning in ComponentState) then
  begin
    Canvas.Brush.Style := bsClear;
    Canvas.Pen.Style := psDashDot;
    Canvas.Pen.Width := 1;
    Canvas.Pen.Color := clBlack;
    Canvas.Rectangle(ClientRect);
  end;

end;

procedure TAdvCloudImage.PictureChanged(sender: TObject);
begin
  if FAutoSize and not FCloudPicture.Empty then
  begin
    self.Width := FCloudPicture.Width;
    self.Height := FCloudPicture.Height;
  end;
  Invalidate;
end;

procedure TAdvCloudImage.SeTCloudPicture(const Value: TCloudPicture);
begin
  FCloudPicture.Assign(Value);
  Invalidate;
end;

procedure TAdvCloudImage.SetPicturePosition(const Value: TPicturePosition);
begin
  if FPicturePosition <> Value then
  begin
    FPicturePosition := Value;
    Invalidate;
  end;
end;

procedure TAdvCloudImage.DownLoadCancel(Sender: TObject; var cancel: boolean);
begin
  if Assigned(FOnDownLoadCancel) then
    FOnDownLoadCancel(self,cancel);
end;

procedure TAdvCloudImage.DownLoadComplete(Sender: TObject);
begin
  if Assigned(FOnDownLoadComplete) then
    FOnDownLoadComplete(self);
end;

procedure TAdvCloudImage.DownLoadError(Sender: TObject; err: string);
begin
  if Assigned(FOnDownloadError) then
    FOnDownLoadError(self,err);
end;

procedure TAdvCloudImage.DownLoadProgress(Sender: TObject; dwSize,
  dwTotSize: Cardinal);
begin
  if Assigned(FOnDownLoadProgress) then
    FOnDownLoadProgress(self,dwSize,dwTotSize);
end;

procedure TAdvCloudImage.SetURL(const Value: string);
begin
  if (FURL <> Value) then
  begin
    FCloudPicture.Asynch := FAsynch;
    FCloudPicture.CheckContentLength := CheckContentLength;
    FURL := Value;
    if FURL <> '' then
      FCloudPicture.LoadFromURL(FURL)
    else
      FCloudPicture.Assign(nil);
  end;
end;

procedure TAdvCloudImage.SaveToFile(Filename: string);
var
  st: TMemoryStream;
begin
  st := TMemoryStream.Create;
  FCloudPicture.SaveToStream(st);
  st.SaveToFile(Filename);
  st.Free;
end;

function TAdvCloudImage.GetVersion: string;
var
  vn: Integer;
begin
  vn := GetVersionNr;
  Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn)));
end;

function TAdvCloudImage.GetVersionNr: Integer;
begin
  Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
end;

procedure TAdvCloudImage.SetVersion(const Value: string);
begin

end;

{ TDownLoadThread }

constructor TDownLoadThread.Create(ACloudPicture: TCloudPicture);
begin
  inherited Create(False);
  CloudPicture := ACloudPicture;
  FreeOnTerminate := True;
end;

procedure TDownLoadThread.Execute;
begin
  CloudPicture.DownLoad;
end;




end.
