图像通过线程错误

时间：2018-01-08 06:19:05

标签： multithreading delphi progress-bar

所有StackOverFlow会员和读者新年快乐！

今天我来找你一个关于Delphi中线程的问题（我浏览了大部分已经发布在主题上但未找到线索的内容）。

我有一个非常简单的测试应用程序，其中包含一个Form（frmIMGDown）和一个线程单元。 在表格上找到

  • 一个Tbutton
  • a TImage
  • 一个TprogressBar

单击此按钮时，该按钮将启动一个从Web下载图像的线程，在此过程中更新进度条并在Timage中显示下载的图像。

只要调用Form（frmIMGDown）是主要的应用程序表单，或者如果从另一个表单调用它，但所有表单都是在应用程序启动时创建的 >

现在，如果我从按钮动态创建frmIMGDown，请单击主窗体上的：

procedure TForm1.Button2Click(Sender: TObject);
var
  frmIMGDown : TfrmIMGDown;
begin
  try
    frmIMGDown := TfrmIMGDown.Create(nil);
    frmIMGDown.ShowModal;
  finally
    frmIMGDown.Free;
  end;
end;

我收到地址违规行为错误

如果我改变

frmIMGDown := TfrmIMGDown.Create(nil);

到

frmIMGDown := TfrmIMGDown.Create(Form1);

结果与相同的错误相同。

我怀疑这与我实现的线程有关，也许是使用的变量，我尝试发送回frmIMGDown，但我找不到解决方案。

这是线程单位：

unit unit_MyThread;

interface

uses
  Classes, IdHTTP, VCL.Forms, SyStem.UITypes, SysUtils, VCL.Dialogs, Graphics, IdTCPClient, IdTCPConnection, IdComponent,IdBaseComponent;

type
  TIdHTTPThread = class(TThread)
  private
    FURL : String;
    idHTTP: TIdHTTP;
    B : TBitMap;
    W : TWICImage;
    //MS : TMemoryStream;
  public
    Constructor Create(CreateSuspended: Boolean);
    Destructor Destroy; override;
    Property URL : String read FURL WRITE FURL;
    procedure OnWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure OnWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
    procedure OnWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  protected
    procedure Execute; override;
  end;

implementation
uses
  unit_IMG_Down;

Constructor TiDHTTPThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(Suspended);
  IdHTTP := TIdHTTP.Create;
  Screen.Cursor := crHourGlass;
  IdHTTP.onWork := OnWork;
  IdHTTP.OnWorkbegin := OnWorkBegin;
  IdHTTP.OnWorkEnd := OnWorkEnd;
  B := TBitmap.Create;
  W := TWICImage.Create;
end;

Destructor TIdHTTPThread.Destroy;
begin
  idHTTP.Free;
  B.Free;
  W.Free;
  Screen.Cursor := crDefault;
  inherited Destroy;
end;

procedure TIdHTTPThread.Execute;
var
  MS : TMemoryStream;
begin
  Screen.Cursor := crHourGlass;
    try
      MS := TMemoryStream.Create;
      try
        IdHTTP.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0';

        IdHTTP.Get(URL,MS);
        MS.Position := 0;
        W.LoadFromStream(MS);
        B.Assign(W);
        frmIMGDown.Image3.Picture.Assign(B);
      except
        On E: Exception do ShowMessage(E.Message);
      end;
    finally
      MS.Free;
    end;
end;

procedure TIdHTTPThread.OnWork(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
var
  Http: TIdHTTP;
  ContentLength: Int64;
  Percent: Integer;
begin
  Http := TIdHTTP(ASender);
  ContentLength := Http.Response.ContentLength;

  if (Pos('chunked', LowerCase(Http.Response.TransferEncoding)) = 0) and
     (ContentLength > 0) then
  begin
    Percent := 100*AWorkCount div ContentLength;
    frmIMGDown.ProgressBar3.Position := AWorkCount +2;
    frmIMGDown.ProgressBar3.Position := AWorkCount -1;
  end;
end;

procedure TIdHTTPThread.OnWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
begin
  frmIMGDown.ProgressBar3.Visible := True;
  frmIMGDown.ProgressBar3.Position := 0;
end;

procedure TIdHTTPThread.OnWorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  frmIMGDown.ProgressBar3.Visible := false;
end;

end.

从按钮调用线程

procedure TfrmIMGDown.Button3Click(Sender: TObject);
var
  HTTPThread : TIdHTTPThread;
begin
  HTTPThread := TIdHTTPThread.Create(False);
  HTTPThread.URL := 'https://bw-1651cf0d2f737d7adeab84d339dbabd3-bcs.s3.amazonaws.com/products/product_119522/Full119522_283b3acc91f119ab4b2939b1beb67211.jpg';

  HTTPThread.FreeOnTerminate := True;
end;

SIDE注意：我使用TWICImage下载图像（LoadFromStream），因为我不知道图像的格式（这里URl是硬编码的测试），然后将其分配给TBitmap。

先谢谢，再次祝大家新年快乐。

数学

1 个答案:

答案 0 :(得分：8)

您的主题正在访问Form的全局指针变量。当您收到“访问冲突”错误时，这是​​因为您没有将新的Form对象分配给该全局变量，而是将其分配给同名的本地变量。因此，当线程尝试访问它时，全局指针无效。

解决方案是让Form对象将其Self指针传递给线程，然后将其存储在线程的成员中。根本不要依赖全局指针。

更好的解决方案是不要让线程知道关于UI的任何信息。我建议在线程类中定义事件，并让线程在需要时触发这些事件（图像下载，进度更新，错误等）。然后，Form可以为这些事件分配处理程序，以根据需要更新UI。

此外，在访问Form的UI控件时，您的线程未与主线程同步。 VCL不是线程安全的，因此您必须同步对UI的访问。即使TBitmap不是线程安全的（不确定TWICImage），但在线程中使用Lock Canvas时必须Unlock，URL时FreeOnTerminated完成。

此外，您有竞争条件，因为您在分配其CreateSuspended=False和CreateSuspended=True值之前允许线程（可能）开始运行。您需要创建处于挂起状态的线程，并且在完成初始化之前不要启动它。最好的方法是使用unit unit_MyThread; interface uses Classes, IdComponent, IdBaseComponent; type THTTPStage = (HTTPInit, HTTPDownloading, HTTPDone); THTTPStatusEvent = procedure(Sender: TObject; Progress, Total: Int64; Stage: THTTPStage) of object; THTTPImageEvent = procedure(Sender: TObject; Data: TStream) of object; THTTPThread = class(TThread) private FURL : String; FStream : TMemoryStream; FProgress, FTotal : Int64; FStage : THTTPStage; FOnStatus : THTTPStatusEvent; FOnImage : THTTPImageEvent; procedure DoOnStatus; procedure DoOnImage; procedure HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); procedure HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); procedure HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode); protected procedure Execute; override; public constructor Create(const AURL: string); property OnStatus: THTTPStatusEvent read FOnStatus write FOnStatus; property OnImage: THTTPImageEvent read FOnImage write FOnImage; end; implementation uses IdTCPClient, IdTCPConnection, IdHTTP; constructor THTTPThread.Create(const AURL: string); begin inherited Create(True); FreeOnTerminate := True; FURL := AURL; end; procedure THTTPThread.Execute; var IdHTTP: TIdHTTP; begin IdHTTP := TIdHTTP.Create; try IdHTTP.OnWork := HTTPWork; IdHTTP.OnWorkBegin := HTTPWorkBegin; IdHTTP.OnWorkEnd := HTTPWorkEnd; IdHTTP.Request.UserAgent := 'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0'; FStream := TMemoryStream.Create; try IdHTTP.Get(FURL, FStream); FStream.Position := 0; if Assigned(FOnImage) then Synchronize(DoOnImage); finally FStream.Free; end; finally IdHTTP.Free; end; end; procedure THTTPThread.DoOnStatus; begin if Assigned(FOnStatus) then FOnStatus(Self, FProgress, FTotal, FStage); end; procedure THTTPThread.DoOnImage; begin if Assigned(FOnImage) then FOnImage(Self, FStream); end; procedure THTTPThread.HTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); begin if AWorkMode = wmRead then begin FProgress := AWorkCount; FStage := HTTPDownloading; if Assigned(FOnStatus) then Synchronize(DoOnStatus); end; end; procedure THTTPThread.HTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); begin if AWorkMode = wmRead then begin FProgress := 0; FTotal := AWorkCountMax; FStage := HTTPInit; if Assigned(FOnStatus) then Synchronize(DoOnStatus); end; end; procedure THTTPThread.HTTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode); begin if AWorkMode = wmRead then begin FProgress := FTotal; FStage := HTTPDone; if Assigned(FOnStatus) then Synchronize(DoOnStatus); end; end; end. 创建线程并处理线程构造函数本身的所有初始化。在构造函数退出之前，线程不会开始运行。否则，使用procedure TfrmIMGDown.Button3Click(Sender: TObject); var HTTPThread : THTTPThread; begin HTTPThread := THTTPThread.Create('https://bw-1651cf0d2f737d7adeab84d339dbabd3-bcs.s3.amazonaws.com/products/product_119522/Full119522_283b3acc91f119ab4b2939b1beb67211.jpg'); HTTPThread.OnStatus := HTTPStatus; HTTPThread.OnImage := HTTPImage; HTTPThread.OnTerminate := HTTPTerminated; HTTPThread.Resume; end; procedure TfrmIMGDown.HTTPStatus(Sender: TObject; Progress, Total: Int64; Stage: THTTPStage); begin case Stage of HTTPInit: begin ProgressBar3.Visible := True; ProgressBar3.Position := 0; ProgressBar3.Max := 100; Screen.Cursor := crHourGlass; end; HTTPDownloading: begin if Total <> 0 then ProgressBar3.Position := 100*Progress div Total; end; HTTPDone: begin ProgressBar3.Visible := false; Screen.Cursor := crDefault; end; end; procedure TfrmIMGDown.HTTPImage(Sender: TObject; Data: TStream); var J: TJPEGImage; begin J := TJPEGImage.Create; try J.LoadFromStream(Data); Image3.Picture.Assign(J); finally J.Free; end; end; procedure TfrmIMGDown.HTTPTerminated(Sender: TObject); begin if TThread(Sender).FatalException <> nil then ShowMessage(Exception(TThread(Sender).FatalException).Message); end; 创建线程，并在准备好后显式恢复。

所有这些都说，尝试更像这样的事情：

{{1}}

{{1}}
相关问题
最新问题