我能否实现多线程? (300分)

  • 主题发起人 主题发起人 woodcutter
  • 开始时间 开始时间
W

woodcutter

Unregistered / Unconfirmed
GUEST, unregistred user!
我要编一个简单的多线程绘图程序,我用delphi自带的thread object创建如下
我在主窗口中放了三个paintbox,一个button,
button的onclick事件如下
procedure TForm1.Button1Click(Sender: TObject);
begin
paintclock.create(paintbox2) ;
paintclock.create(paintbox1) ;
paintclock.create(paintbox3) ;
end;
多线程单元如下
unit Unit2;
interface
uses
Classes,Graphics,windows, ExtCtrls;
type
paintclock = class(TThread)
private
fbox:tpaintbox;
a:integer;
protected
procedure drawlines;
procedure Execute;
override;
public
constructor create(box:tpaintbox);
end;
implementation
procedure paintclock.drawlines;
begin
with fboxdo
begin
while a<=100do
begin
canvas.pen.color:=clred;
//一根木棍绕着paintbox的中点转动
canvas.moveto(33+round(33*sin(5*a*3.14/180)),33-round(33*cos(5*a*3.14/180)));
canvas.lineto(33-round(33*sin(5*a*3.14/180)),33+round(33*cos(5*a*3.14/180)));
a:=a+1;
sleep(100);
{if terminated then
exit;}
end;
end;
end;
constructor paintclock.create(box:tpaintbox);
begin
fbox:=box;
freeonterminate:=true;
inherited create(false);
end;
procedure paintclock.Execute;
begin
synchronize(drawlines);
end;

end.
请问,这个程序能够实现真正的多线程吗?如有不妥,应该怎么改正,谢谢!
 
是大富翁们吗?
我这个马虎的人没看出有什么毛病来。
不过你那个线程的生存时间可能太短。
 
我觉得可以,你为什么会有这个疑问呢?
 
procedure TForm1.Button1Click(Sender: TObject);
var
p1,p2,p3:paintclock:
begin
p1 := Tpaintclock.create(paintbox2);
p2 := Tpaintclock.create(paintbox1) ;
p3 := Tpaintclock.create(paintbox3) ;
end;
 
哦,是这样,没看仔细,yhaochuan说得对。
 
对,yhaochuan说得对。
马虎要不得。
 
to yhaochuan;
我的三个paintbox是paintbox2先画图,然后是paintbox3,最后是paintbox1画图
,如此循环, 而不会同时画图,为什么呢?
 
改了点,试了一下没问题呀
procedure paintclock.drawlines;
var
a:integer;/////////
begin
with fboxdo
begin
a:=0;///////////
while a<=100do
begin
canvas.pen.color:=clred;
//一根木棍绕着paintbox的中点转动
canvas.moveto(33+round(33*sin(5*a*3.14/180)),33-round(33*cos(5*a*3.14/180)));
canvas.lineto(33-round(33*sin(5*a*3.14/180)),33+round(33*cos(5*a*3.14/180)));
a:=a+1;
sleep(0);
{if terminated then
exit;}///////////////
end;
end;
end;
 
请各位多多指点呀,论者有分[:)]
 
你照yhaochuan说的改过之后还那样吗??
 
在delphi带的DEMO
C:/Program Files/Borland/Delphi5/Demos/Threads
我看到里面按钮CLICK的事件代码:
procedure TThreadSortForm.StartBtnClick(Sender: TObject);
begin
RandomizeArrays;
ThreadsRunning := 3;
with TBubbleSort.Create(BubbleSortBox, BubbleSortArray)do
OnTerminate := ThreadDone;
with TSelectionSort.Create(SelectionSortBox, SelectionSortArray)do
OnTerminate := ThreadDone;
with TQuickSort.Create(QuickSortBox, QuickSortArray)do
OnTerminate := ThreadDone;
StartBtn.Enabled := False;
end;
它直接使用TSelectionSort而不是申请一个TSelectionSort变量,我想原因是
它在程序中只使用一次,所以直接就把TSelectionSort拿来用了。
我做了如下的改动。将三个线程改为同一个线程(即都用同一种排序方法TBubbleSort)如下:
procedure TThreadSortForm.StartBtnClick(Sender: TObject);
begin
RandomizeArrays;
ThreadsRunning := 3;
with TBubbleSort.Create(BubbleSortBox, BubbleSortArray)do
OnTerminate := ThreadDone;
with TBubbleSort.Create(SelectionSortBox, SelectionSortArray)do
OnTerminate := ThreadDone;
with TBubbleSort.Create(QuickSortBox, QuickSortArray)do
OnTerminate := ThreadDone;
StartBtn.Enabled := False;
end;
当我执行,然后按这个按钮后可以看到画面上是三个同样的排序方法是同时执行的,
不知这对你有没有帮助。
 
我试了你和程序,没看到有木棍在转绕着paintbox的中点转动。
而且过程
procedure paintclock.drawlines;少定义一个变量a:integer。
为什么?
 
因为你使用了synchronize这个线程同步技术,所以drawlines不会同时执行。
 
To yhaochuan: To everyone:
感谢yhaochuan告诉我 "它直接使用TSelectionSort而不是申请一个TSelectionSort变量,我想原因是
它在程序中只使用一次,所以直接就把TSelectionSort拿来用了"。这个例子对我这个学多线程不是很熟练的家伙很有帮助,再次感谢。
我还有一个问题,就是如果我想让他一直不停的排序的话该怎么做呢?

当我做三个木棍绕paintbox中点同时转动成功后,有一个问题,就是,在主窗口的其他输入
组建如edit组建的输入响应变得非常慢,以致不能正常工作,不知为什么?
 
你可以再建立一个线程,由这个线程去画画嘛。
 
TO yhaochuan;
在delphi带的DEMO C:/Program Files/Borland/Delphi5/Demos/Threads中
我加进一个edit组建和一个按钮,按下按钮edit的值发生变化,我在那三个paintbox组建
排序的同时可以在edit组建中输入数据,响应很快。但是在我如下改进的程序中,主窗口
edit组建的输入根本无法及时响应,我的改进程序如下,在主窗口放三个paintbox组建
,button1,button2,一个edit组建,
button1click如下
procedure button1click;
var p1,p2,p3:paintclock;
begin
p1:=paintclock.create(paintbox1);
p2:=paintclock.create(paitnbox2);
p3:=paintclock.create(paintbox3);
end;
button2如下
procedure button2onclick
begin
edit1.text:=inttostr(strtoint(edit1.text)*3);//初值为10;
end;
我的多线程单元如下;
unit Unit2;
interface
uses
Classes,Graphics,windows, ExtCtrls;
type
paintclock = class(TThread)
private
fbox:tpaintbox;
a:integer;
b,c,x,y:integer;
protected
procedure drawlines;
procedure Execute;
override;
public
constructor create(box:tpaintbox);
end;
implementation
procedure paintclock.drawlines;
begin
with fboxdo
//显示三跟木棒绕着三个paintbox中点转动;
begin
while a>=144do
a:=0;
canvas.Pen.color:=clgreen;
canvas.MoveTo(b,c);
canvas.LineTo(x,y);
canvas.pen.color:=clred;
canvas.moveto(33+round(33*sin(5*a*3.14/180)),33-round(33*cos(5*a*3.14/180)));
canvas.lineto(33-round(33*sin(5*a*3.14/180)),33+round(33*cos(5*a*3.14/180)));
b:=33+round(33*sin(5*a*3.14/180));
c:=33-round(33*cos(5*a*3.14/180));
x:=33-round(33*sin(5*a*3.14/180));
y:=33+round(33*cos(5*a*3.14/180));
a:=a+1;
sleep(10);
if terminated then
exit;
end;
end;
constructor paintclock.create(box:tpaintbox);
begin
a:=0;
fbox:=box;
freeonterminate:=true;
inherited create(false);
end;
procedure paintclock.Execute;
begin
while not terminateddo
synchronize(drawlines);
end;
end.
我就是无法知道,为什么edit组建的响应就那么慢呢?还有,如我想在主程序中能够用
button来挂起线称程,该怎么做?
 
挂起线程可用suspend方法,然后用resume恢复运行。
其它的问题在考虑中
 
第一次测试:我自己做线程对象,下面是线程代码
unit Unit2;
interface
uses
Classes, Windows, stdctrls, Sysutils;
type
changeedit = class(TThread)
private
{ Private declarations }
FEdit: TEdit;
proceduredo
changeedit;
protected
procedure Execute;
override;
procedure prochangeeidt;
public
constructor Create(Edit: TEdit);
end;

implementation
{ Important: Methods and properties of objects in VCL can only be used in a
method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure changeedit.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end;
}
{ changeedit }
procedure changeedit.prochangeeidt;
begin
do
changeedit;
end;

constructor changeedit.Create(Edit: TEdit);
begin
FreeOnTerminate := True;
FEdit := Edit;
inherited Create(False);
end;

procedure changeedit.dochangeedit;
var
i:integer;
begin
for i:=1 to 600do
begin
FEdit.Text := IntToStr(i);
sleep(5);
end;
end;

procedure changeedit.Execute;
begin
{ Place thread code here }
prochangeeidt;
end;

end.

在FORM上放三个EDIT和三个BUTTON
CLICK代码分别为
var
p1,p2,p3: changeedit;
procedure TForm1.Button1Click(Sender: TObject);
begin
p1 := changeedit.Create(edit1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
p2 := changeedit.Create(edit2);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
p3 := changeedit.Create(edit3);
end;
这时候没有出现你说的问题(FORM停顿住了,没有反应,
要强制关掉整个程序才行。),可以将FORM拉动,我试了你的程序,
本贴没有作用的,可以略过它。
回头看这段代码,竟没有用到Synhronize,见笑了。
 
有点眉目的,应该是同步(Synchronize)的时候花的时间太长了
写线程的时候DELPHI警告说,在改变Button.Caption的时候最好
将代码单独写一个过程,然后用Synchronize(改变CAPTION的过程)去调用。
那么Synchronize起到什么作用呢?
Synchronize的作用相当于它里面的过程和主线程同步
即:程序将主线程在这里停住了,由Synchronize里面的过程
接手,等Synchronize里面的过程结束后主线程才接着进行它的处理。
好了,回头看看你的线程里面的代码 
procedure paintclock.Execute;
begin
 while not terminateddo
 synchronize(drawlines);
end;
你将DRAWLINES过程和主线程同步住了,主线程等DRAWLINES结束后才继续它的处理。
问题出来了,你DRAWLINES要花不短的时间(除了画四条线,还要SLEEP(5)),
当只有一个线程在运行的时候,看不出什么变化。
当两个以上线程一起运行时,变成了有三个同步线程在排队,
也就是
主线程->线程1的DRAWLINES->线程2的drawlines->线程3和drawlines->主线程
想想,线程2要drawlines的时候要等其它线程的drawlines结束,
这变成了三个线程并没有达到线程的目的,它在要请示在paintbox上画线的的时候不能同时进行。
即使只有一个线程,假设drawlines里面的sleep(5000),让线程等候5秒,这时候即使只有一
个线程在运行,它也将使程序挂住5秒。

我将你的程序做了个改变。将画线的那部份代码用单独的过程写起,
然后在drawlines中用Synchronize去画线。
然后将execute中的
synchronize(drawlines);
改为drawlines(不要在这里同步);
 
下面是修改过后的线程单元代码
unit Unit2;
interface
uses
Classes, extctrls, Windows, Graphics;
type
TPaintClock = class(TThread)
private
{ Private declarations }
fbox:TPaintBox;
a:integer;
b,c,x,y:integer;
proceduredo
DrawLine;
proceduredo
CanvasMoveToBC;
proceduredo
canvasLineToXY;
proceduredo
CanvasMoveToCalc;
proceduredo
canvasLineToCalc;
protected
procedure Execute;
override;
procedure DrawLine;
public
constructor Create(PaintBox: TPaintBox);
end;

implementation
{ TPaintClock }
constructor TPaintClock.Create(PaintBox: TPaintBox);
begin
a:= 0;
FreeOnTerminate := True;
FBox := PaintBox;
inherited Create(false);
end;

procedure TPaintClock.DocanvasLineToCalc;
begin
fbox.canvas.pen.color:=clred;
Fbox.canvas.lineto(33-round(33*sin(5*a*3.14/180)),33+round(33*cos(5*a*3.14/180)));
end;

procedure TPaintClock.DocanvasLineToXY;
begin
FBox.canvas.Pen.color:=clgreen;
FBox.Canvas.LineTo(x,y);
end;

procedure TPaintClock.DoCanvasMoveToBC;
begin
FBox.canvas.Pen.color:=clgreen;
FBox.Canvas.MoveTo(b,c);
end;

procedure TPaintClock.DoCanvasMoveToCalc;
begin
fbox.canvas.pen.color:=clred;
fbox.canvas.moveto(33+round(33*sin(5*a*3.14/180)),33-round(33*cos(5*a*3.14/180)));
end;

procedure TPaintClock.DoDrawLine;
begin
with fboxdo
//显示三跟木棒绕着三个paintbox中点转动;
begin
if a>=144 then
//do
a:=0;
// canvas.Pen.color:=clgreen;
// canvas.MoveTo(b,c);
// canvas.LineTo(x,y);
Synchronize(DoCanvasMoveToBC);
Synchronize(DocanvasLineToXY);

// canvas.pen.color:=clred;
// canvas.moveto(33+round(33*sin(5*a*3.14/180)),33-round(33*cos(5*a*3.14/180)));
// canvas.lineto(33-round(33*sin(5*a*3.14/180)),33+round(33*cos(5*a*3.14/180)));
Synchronize(DocanvasMoveToCalc);
Synchronize(DocanvasLineToCalc);
b:=33+round(33*sin(5*a*3.14/180));
c:=33-round(33*cos(5*a*3.14/180));
x:=33-round(33*sin(5*a*3.14/180));
y:=33+round(33*cos(5*a*3.14/180));
a:=a+1;
sleep(5);
// if terminated then
exit;
end;
end;

procedure TPaintClock.DrawLine;
begin
while not Terminateddo
do
DrawLine;
end;

procedure TPaintClock.Execute;
begin
{ Place thread code here }
//while not terminateddo
//synchronize(drawlines);
DrawLine;
end;

end.
说一下我找到解决问题的过程:
我看到drawlines里面有一个sleep(5)后,很好奇,就把它加了三个零。
然后运行程序,只用一个线程,发现程序挂住了,要几秒钟后才有反应(比如我移动窗口)
然后想到到5000毫秒,然后想到了syschronize,明白了问题所在。
 
后退
顶部