unit Unit1;interfaceuses
 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个,程序一运行就出问题,甚至死掉.

解决方案 »

  1.   

    不要在线程中直接操作界面的控件要就用Synchronize()
      

  2.   

    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一定会出错 。
      

  3.   

    嘿~VCL不是线程安全的。要按照 citytramper(阿琪) 说的那样做
      

  4.   

    同上;
    除了Synchronize()还可以用消息来解决问题。
      

  5.   

    Synchronize()好像应该调用Form1里的函数才对吧,很久没用Delphi了,可能我弄错了。
    这个问题好像是在“delphi程序员开发指南”里讲过了,翻以前的帖子应该有的。
    我以前是在线程里向主线程发消息解决的。