Mat*_*hou 4 delphi multithreading progress-bar
所有StackOverFlow会员和读者新年快乐!
今天我来找你一个关于Delphi中线程的问题(我浏览了大部分已经在主题上发布但未找到线索的内容).
我有一个非常简单的测试应用程序,其中包含一个Form(frmIMGDown)和一个线程单元.在表格上找到了
单击时,该按钮将启动一个从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;
侧面注意:我使用TWICImage下载图像(LoadFromStream),因为我不知道图像的格式(这里URl是硬编码的测试),然后将其分配给TBitmap.
提前谢谢,再次祝大家新年快乐.
数学
您的线程正在访问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;