在下面的代码中,我在一个空表单上创建了一些按钮。每个按钮在点击时启动一个线程,该线程连接到SQL并打开一些查询。它工作得很好。当一个线程正在工作时,单击相同的按钮将其挂起。点击再次恢复它。这也工作得很好。
一旦我开始垃圾邮件随机按钮,程序冻结和neihter返回正常也不给出一个错误。我只是不知道它有什么问题。
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Data.Win.ADODB, IdThread, Winapi.ADOInt, ActiveX,
Vcl.StdCtrls, Vcl.ExtCtrls, System.SyncObjs, System.Threading, Vcl.Buttons,
Vcl.AppEvnts, Vcl.ComCtrls;
const
CnnStr = 'write your connection string here';
OpenCmnd1 = 'write a query that returns some result. ie: "select * from xxx"';
type
TMyButton = class(Vcl.StdCtrls.TButton)
OwnedThread: TThread;
ProgressBar: TProgressBar;
end;
TMyThread = class(TThread)
private
FCounter: Integer;
FCountTo: Integer;
FProgressBar: TProgressBar;
FOwnerButton: TMyButton;
FConnection: TADOConnection;
FQuery: TADOQuery;
procedure DoProgress;
procedure SetCountTo(const Value: Integer);
procedure SetProgressBar(const Value: TProgressBar);
procedure SetOwnerButton(const Value: TMyButton);
protected
procedure Execute; override;
public
constructor Create(CreateSuspended: Boolean);
destructor Done;
property CountTo: Integer read FCountTo write SetCountTo;
property ProgressBar: TProgressBar read FProgressBar write SetProgressBar;
property OwnerButton: TMyButton read FOwnerButton write SetOwnerButton;
end;
TForm2 = class(TForm)
procedure Button1Click(Sender: TObject) ;
procedure FormCreate(Sender: TObject);
end;
var
Form2: TForm2;
allThreads: array of TMyThread;
implementation
{$R *.dfm}
constructor TMyThread.Create(CreateSuspended: Boolean) ;
begin
inherited;
FCounter := 0;
FCountTo := 100;
end;
destructor TMyThread.Done;
begin
inherited;
FQuery.Close;
FreeAndNil(FQuery);
FConnection.Close;
FreeAndNil(FConnection);
end;
procedure TMyThread.DoProgress;
var
PctDone: Extended;
begin
PctDone := (FCounter / FCountTo) ;
FProgressBar.Position := Round(FProgressBar.Step * PctDone) ;
FOwnerButton.Caption := FormatFloat('0.00 %', PctDone * 100) ;
end;
procedure TMyThread.Execute;
const
Interval = 1;
var
aThreadID:integer;
begin
CoInitialize(nil);
try
FreeOnTerminate := True;
FProgressBar.Max := FCountTo div Interval;
FProgressBar.Step := FProgressBar.Max;
FProgressBar.ShowHint := True;
FProgressBar.Hint := 'Thread ID ='+IntToStr(GetCurrentThreadID);
aThreadID := GetCurrentThreadID;
if not Assigned(FConnection) then
begin
FConnection := TADOConnection.Create(nil);
FConnection.LoginPrompt := False;
FConnection.ConnectionString := FORMAT(CnnStr,[GetCurrentThreadID]);
//FConnection.ConnectOptions := coAsyncConnect;
end;
if not FConnection.Connected then
FConnection.Open;
if not Assigned(FQuery) then
begin
FQuery := TADOQuery.Create(nil);
FQuery.Connection := FConnection;
FQuery.SQL.Text := OpenCmnd1;
FQuery.ExecuteOptions := [];
FQuery.ParamCheck;
end;
while FCounter < FCountTo do
begin
if FQuery.State = dsBrowse then
FQuery.Close;
FQuery.Open;
if FCounter mod Interval = 0 then Synchronize(DoProgress) ;
Inc(FCounter) ;
end;
FOwnerButton.Caption := 'Start';
FOwnerButton.OwnedThread := nil;
FProgressBar.Position := FProgressBar.Max;
finally
CoUnInitialize;
end;
end;
procedure TMyThread.SetCountTo(const Value: Integer) ;
begin
FCountTo := Value;
end;
procedure TMyThread.SetOwnerButton(const Value: TMyButton) ;
begin
FOwnerButton := Value;
end;
procedure TMyThread.SetProgressBar(const Value: TProgressBar) ;
begin
FProgressBar := Value;
end;
procedure TForm2.Button1Click(Sender: TObject) ;
var
aButton: TMyButton;
aProgressBar: TProgressBar;
begin
aButton := TMyButton(Sender) ;
if not Assigned(aButton.OwnedThread) then
begin
allThreads[aButton.Tag] := TMyThread.Create(True) ;
aButton.OwnedThread := allThreads[aButton.Tag];
aProgressBar := TProgressBar(FindComponent(StringReplace(aButton.Name, 'Button', 'ProgressBar', []))) ;
allThreads[aButton.Tag].ProgressBar := aProgressBar;
allThreads[aButton.Tag].OwnerButton := aButton;
allThreads[aButton.Tag].Resume;
aButton.Caption := 'Pause';
end
else
begin
if aButton.OwnedThread.Suspended then
aButton.OwnedThread.Resume
else
aButton.OwnedThread.Suspend;
aButton.Caption := 'Run';
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
var
i : integer;
begin
for i := 1 to 5 do
begin
with TMyButton.Create(self) do
begin
Parent := Self;
Tag := i;
Left := 10;
Top := 10 + 30*i;
width := 100;
Caption := 'Button'+IntToStr(i);
Name := 'Button'+IntToStr(i);
onClick := Button1Click;
end;
with TProgressBar.Create(self) do
begin
Parent := Self;
Tag := i;
Left := 120;
Top := 12 + 30*i;
width := 200;
Name := 'ProgressBar'+IntToStr(i);
end;
end;
SetLength(allThreads,6);
end;
end.
这只是一个演示,代表我的问题。对不起的编码。
1条答案
按热度按时间ve7v8dk21#
首先,当从工作线程访问UI控件时(即,当更新进度条等时),您必须与UI线程同步。您已经有了一个用于此目的的
DoProgress()
方法,但您没有使用它。其次,
Suspend()
/Resume()
在被滥用时是危险的,这就是为什么它们被 * 弃用 *。如果你想 * 安全地 * 挂起一个线程,你需要要求线程在安全的时候挂起自己。你不能盲目地在外部挂起一个线程,你不知道这个线程当时处于什么状态,如果它在锁或同步中,那么坏事情就会发生(正如你所发现的)。在修复了UI同步问题之后,挂起问题最简单的解决方案是在线程类中添加一个布尔值,并在想要挂起线程时将其设置为true,然后让线程的
Execute()
方法定期查看该布尔值,并仅在不做其他事情时调用Suspend()
。