Firemonkey 和 TDownloadUrl答案

【问题标题】：Firemonkey and TDownloadUrlFiremonkey 和 TDownloadUrl
【发布时间】：2011-11-21 10:14:52
【问题描述】：

我有一个 (Delphi XE2) VCL 应用程序，其中包含一个对象 TDownloadUrl (VCL.ExtActns) 来检查多个网页，所以我想知道 FireMonkey 中是否有等效对象，因为我想利用这个新功能的丰富功能平台。

使用线程的 Firemonkey 应用演示将不胜感激。提前致谢。

【问题讨论】：

【解决方案1】：

FireMonkey 尚不存在操作。

顺便说一句，您可以使用如下代码创建相同的行为：

IdHTTP1: TIdHTTP;

...

procedure TForm2.MenuItem1Click(Sender: TObject);
const
  FILENAME = 'C:\Users\Whiler\Desktop\test.htm';
  URL      = 'http://stackoverflow.com/questions/7491389/firemonkey-and-tdownloadurl';
var
//  sSource: string;
  fsSource: TFileStream;
begin
  if FileExists(FILENAME) then
  begin
    fsSource := TFileStream.Create(FILENAME, fmOpenWrite);
  end
  else
  begin
    fsSource := TFileStream.Create(FILENAME, fmCreate);
  end;

  try
    IdHTTP1.Get(URL, fsSource);
  finally
    fsSource.Free;
  end;
//  sSource := IdHTTP1.Get(URL);
end;

如果您只需要内存中的源代码，注释行可以替换其他行...

如果要使用线程，可以这样管理：

unit Unit2;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, FMX.Menus;

type
  TDownloadThread = class(TThread)
  private
    idDownloader: TIdHTTP;
    FFileName   : string;
    FURL        : string;
  protected
    procedure Execute; override;
    procedure Finished;
  public
    constructor Create(const sURL: string; const sFileName: string);
    destructor  Destroy; override;
  end;
type
  TForm2 = class(TForm)
    MenuBar1: TMenuBar;
    MenuItem1: TMenuItem;
    procedure MenuItem1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.fmx}

procedure TForm2.MenuItem1Click(Sender: TObject);
const
  FILENAME = 'C:\Users\Whiler\Desktop\test.htm';
  URL      = 'http://stackoverflow.com/questions/7491389/firemonkey-and-tdownloadurl';
var
//  sSource: string;
  fsSource: TFileStream;
begin
  TDownloadThread.Create(URL, FILENAME).Start;
end;

{ TDownloadThread }

constructor TDownloadThread.Create(const sURL, sFileName: string);
begin
  inherited Create(true);
  idDownloader := TIdHTTP.Create(nil);
  FFileName       := sFileName;
  FURL            := sURL;
  FreeOnTerminate := True;
end;

destructor TDownloadThread.Destroy;
begin
  idDownloader.Free;
  inherited;
end;

procedure TDownloadThread.Execute;
var
//  sSource: string;
  fsSource: TFileStream;
begin
  inherited;
  if FileExists(FFileName) then
  begin
    fsSource := TFileStream.Create(FFileName, fmOpenWrite);
  end
  else
  begin
    fsSource := TFileStream.Create(FFileName, fmCreate);
  end;

  try
    idDownloader.Get(FURL, fsSource);
  finally
    fsSource.Free;
  end;
  Synchronize(Finished);
end;

procedure TDownloadThread.Finished;
begin
  // replace by whatever you need
  ShowMessage(FURL + ' has been downloaded!');
end;

end.

【讨论】：

你必须爱上火猴。我担心 TThread 不会被实施。我很高兴我的担心是不真实的。

【解决方案2】：

关于这个：

使用线程的 Firemonkey 应用演示将不胜感激。

您可以在此处找到使用 Thread 的 FireMonkey 演示：https://radstudiodemos.svn.sourceforge.net/svnroot/radstudiodemos/branches/RadStudio_XE2/FireMonkey/FireFlow/MainForm.pas

type

  TImageThread = class(TThread)
  private
    FImage: TImage;
    FTempBitmap: TBitmap;
    FFileName: string;
  protected
    procedure Execute; override;
    procedure Finished;
  public
    constructor Create(const AImage: TImage; const AFileName: string);
    destructor Destroy; override;
  end;

...

TImageThread.Create(Image, Image.TagString).Start;

如果您的示例目录中没有此演示，您可以从上面链接中使用的 subversion 存储库中查看它。

【讨论】：

【解决方案3】：

您可以使用此代码。

unit BitmapHelperClass;

interface

uses
  System.Classes, FMX.Graphics;

type
  TBitmapHelper = class helper for TBitmap
  public
    procedure LoadFromUrl(AUrl: string);

    procedure LoadThumbnailFromUrl(AUrl: string; const AFitWidth, AFitHeight: Integer);
  end;

implementation

uses
  System.SysUtils, System.Types, IdHttp, IdTCPClient, AnonThread;

procedure TBitmapHelper.LoadFromUrl(AUrl: string);
var
  _Thread: TAnonymousThread<TMemoryStream>;
begin
  _Thread := TAnonymousThread<TMemoryStream>.Create(
    function: TMemoryStream
    var
      Http: TIdHttp;
    begin
      Result := TMemoryStream.Create;
      Http := TIdHttp.Create(nil);
      try
        try
          Http.Get(AUrl, Result);
        except
          Result.Free;
        end;
      finally
        Http.Free;
      end;
    end,
    procedure(AResult: TMemoryStream)
    begin
      if AResult.Size > 0 then
        LoadFromStream(AResult);
      AResult.Free;
    end,
    procedure(AException: Exception)
    begin
    end
  );
end;

procedure TBitmapHelper.LoadThumbnailFromUrl(AUrl: string; const AFitWidth,
  AFitHeight: Integer);
var
  Bitmap: TBitmap;
  scale: Single;
begin
  LoadFromUrl(AUrl);
  scale := RectF(0, 0, Width, Height).Fit(RectF(0, 0, AFitWidth, AFitHeight));
  Bitmap := CreateThumbnail(Round(Width / scale), Round(Height / scale));
  try
    Assign(Bitmap);
  finally
    Bitmap.Free;
  end;
end;

end.

【讨论】：