分已用尽. 帮个忙,多线程的问题,实在不知道问题出在哪里了,贴上全部源程序,

綏子 2003-07-16 03:25:59
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComCtrls, ExtCtrls,SyncObjs;

type
TRec=record
data:array[0..19] of integer;
end;

TAThread = class(TThread)
protected
procedure Execute; override;
procedure Updata;
end;

TBThread = class(TThread)
protected
m_index: Integer;
m_data:TRec;
m_x:int64;
coun:integer;
procedure Execute; override;
procedure Draw;
procedure Updata;
procedure Updata1;
public
constructor Create(index:Integer;data:TRec);
end;

TForm1 = class(TForm)
ProgressBar1: TProgressBar;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Edit1: TEdit;
UpDown1: TUpDown;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
ListBox1: TListBox;
Memo1: TMemo;
Button4: TButton;
Label4: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
A:TAThread;
List:TList;
strList:TStringList;
ThreadNum:integer;
TaskTotalNum:integer;
CurrenPoint:integer;
ResultTotal:int64;
procedure endGetText(Sender: TObject);
procedure endTotal(Sender: TObject);
procedure Total;
function Getdata:TRec;
public
{ Public declarations }
end;
const
FileName='OutFile.txt';
var
Form1: TForm1;

implementation

{$R *.DFM}
//******************* 以下代码用来产生需要的数据 *************************
procedure TAThread.Execute;
var
i:integer;
f:TextFile;
begin
i:=0;
Randomize;
try
AssignFile(f,FileName);
if FileExists(FileName) then
if not DeleteFile(FileName) then exit;
Rewrite(f);
Reset(f);
Append(f);
while i<100000 do
begin
Write(f,Round(Random(100)));
Write(f,#13#10);
Synchronize(Updata);
inc(i);
end;
finally
CloseFile(f);
end;
end;
procedure TAThread.Updata;
begin
Form1.ProgressBar1.Position:=Form1.ProgressBar1.Position+1;
Form1.Button1.Caption:='完成: '+IntToStr(Form1.ProgressBar1.Position div 1000)+'%';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
A:=TAThread.Create(true);
A.OnTerminate:=endGetText;
A.FreeOnTerminate:=true;
A.Resume;
end;
procedure TForm1.endGetText(Sender: TObject);
begin
ProgressBar1.Position:=0;
Button1.Caption:='数据已经生成';
Button1.Enabled:=false;
Button2.Enabled:=True;
end;
//******************* 以上代码用来产生需要的数据 *************************


procedure TForm1.FormCreate(Sender: TObject);
begin
List:=TList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(List);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
f:TextFile;
s:string;
begin
if not FileExists(FileName) then exit;
try
AssignFile(f,FileName);
strList:=TStringList.Create;
FileMode:=0;
Reset(f);
while not EOF(f) do
begin
ReadLn(f,s);
strList.Add(s);
end;
Button3.Enabled:=True;
Edit1.Enabled:=True;
Label1.Enabled:=True;
UpDown1.Enabled:=True;
Button2.Enabled:=false;
Label2.Caption:='共计有: '+IntToStr(strList.Count)+' 笔数据';
TaskTotalNum:=strList.Count;
finally
CloseFile(f);
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
CurrenPoint:=0;
ThreadNum:=0;
Total;
Button3.Enabled:=false;
Edit1.Enabled:=false;
Label1.Enabled:=false;
UpDown1.Enabled:=false;
end;

function TForm1.Getdata: TRec;
var
i:integer;
datas:TRec;
begin
for i:=0 to 19 do
begin
if CurrenPoint < TaskTotalNum then
begin

datas.data[i]:=StrToInt(strList.Strings[CurrenPoint]);
inc(CurrenPoint);
end
else
begin
datas.data[i]:=0;
end;
end;
end;

procedure TForm1.Total;
var
i:integer;
B:TBThread;
begin
if TaskTotalNum > UpDown1.Position*20 then
begin
for i:=0 to UpDown1.Position-1 do
begin
B:=TBThread.Create(i,GetData);
B.OnTerminate:=endTotal;
List.Add(Pointer(B));
inc(ThreadNum);
end;
end
else
for i:=0 to (TaskTotalNum div 20)+1 do // 总数少于 100 个数据的处理
begin
B:=TBThread.Create(i,GetData);
B.OnTerminate:=endTotal;
List.Add(Pointer(B));
inc(ThreadNum);
end;
end;

constructor TBThread.Create(index: Integer; data: TRec);
begin
// FreeOnTerminate:=true;
inherited Create(true);
m_index:=Index;
m_data:=data;
// Coun:=5;
Resume;
end;

procedure TBThread.Draw;
begin
// 不画了,画了速度太慢了
end;

procedure TBThread.Execute;
var
i:integer;
//m_criticalsection:tcriticalsection;
begin
for i:=0 to High(m_data.data) do
begin
m_x:=m_x+m_data.data[i];
end;
//try
// m_criticalsection:=tcriticalsection.create;
// m_criticalsection.Acquire;
// Synchronize(Updata1);
Synchronize(Updata);
// finally
// m_criticalsection.Release;
//m_criticalsection.Free;
// m_criticalsection.Leave;
//end;
end;

procedure TBThread.Updata;

begin
Form1.ResultTotal:=Form1.ResultTotal+m_x;



// Form1.label4.caption:='Demo, 调用线程 '+IntToStr(Form1.ThreadNum)+' 次';
//我加上这句 经常出错,很奇怪的错误.

Form1.Caption:='Demo, 调用线程 '+IntToStr(Form1.ThreadNum)+' 次';
Form1.ProgressBar1.Position:=Form1.ProgressBar1.Position+20;
if (Form1.ThreadNum mod 10 =0) then
Form1.Memo1.Lines.Text:=Form1.Memo1.Lines.Text+'◎';
end;

procedure TBthread.updata1;
begin
Form1.label4.caption:='Demo, 调用线程 '+IntToStr(Form1.ThreadNum)+' 次';
end;
procedure TForm1.endTotal(Sender:TObject);
var
i:integer;
B:TBThread;
begin
if CurrenPoint < TaskTotalNum then
begin
i:=TBThread(Sender).m_index;
TBThread(List.Items[i]).Free;
B:=TBThread.Create(i,GetData);
B.OnTerminate:=endTotal;
List.Delete(i);
List.Insert(i,Pointer(B));
inc(ThreadNum);
end
else
Label3.Caption:='累计结果: '+IntToStr(ResultTotal);
end;
end.

上面是完整的源程序,程序的作用解释.

开启一个多线程的程序, 线程A随机产生10000个数据,

线程B,(开启多线程)进行统计 10000个数据的和

问题:开启5个线程程序一点错误都没有,但是程序的线程数增加,比如10个,50个,100个,程序一运行就出问题,甚至死掉.
...全文
24 7 打赏 收藏 转发到动态 举报
写回复
用AI写文章
7 条回复
切换为时间正序
请发表友善的回复…
发表回复
jpyc 2003-07-16
  • 打赏
  • 举报
回复
在98下调的吧,建议使用2000/XP
lastshrill 2003-07-16
  • 打赏
  • 举报
回复
Synchronize()好像应该调用Form1里的函数才对吧,很久没用Delphi了,可能我弄错了。
这个问题好像是在“delphi程序员开发指南”里讲过了,翻以前的帖子应该有的。
我以前是在线程里向主线程发消息解决的。
lastshrill 2003-07-16
  • 打赏
  • 举报
回复
同上;
除了Synchronize()还可以用消息来解决问题。
Eastunfail 2003-07-16
  • 打赏
  • 举报
回复
嘿~VCL不是线程安全的。要按照 citytramper(阿琪) 说的那样做
綏子 2003-07-16
  • 打赏
  • 举报
回复
up
綏子 2003-07-16
  • 打赏
  • 举报
回复
procedure TBThread.Execute;
var
i:integer;

begin
for i:=0 to High(m_data.data) do
begin
m_x:=m_x+m_data.data[i];
end;
Synchronize(Updata); //调用操作界面的过程, 我用了Synchronize
end;

procedure TBThread.Updata;

begin
Form1.ResultTotal:=Form1.ResultTotal+m_x;

Form1.Caption:='Demo, 调用线程 '+IntToStr(Form1.ThreadNum)+' 次';
Form1.ProgressBar1.Position:=Form1.ProgressBar1.Position+20;
if (Form1.ThreadNum mod 10 =0) then
Form1.Memo1.Lines.Text:=Form1.Memo1.Lines.Text+'◎';
end;


线程数量少一点问题也没,调到30个或50一定会出错 。

citytramper 2003-07-16
  • 打赏
  • 举报
回复
不要在线程中直接操作界面的控件

要就用Synchronize()

5,388

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧