请您解答:delphi多线程例程

liyue 2000-07-08 08:54:00
我在本网的delphi开发文章中看到《delphi32下的多线程程序设计》一文。但其给的例程无法运行,我已经“研究”了一夜,头都“大”了,请大虾指点。谢谢!一定要将程序在您的计算机上运行通过,然后照原样贴上来。我是初级水平,无法辨认任何“打印错误”。谢谢!例程如下:

  这是一个多线程的碰碰球游戏,你可以有多个不同的球,它们分属不同的线程,各自独立的在屏幕上碰撞。显然,由于多个球运行的显示会同时操作vcl资源,为了安
全,我们在execute过程中的执行部分加入了synchronize(moveshape)来调用moveshape过程,实际上,在任何需要操作vcl资源的地方,例如窗体、位图,都应加入synchronize调用。

  unit bncthrd;
  interface
  uses
  winprocs,classes,graphics,extctrls;
  type
  tbouncethread=class(tthread)
  private
  fshape:tshape;
  fxspeed:integer;
  fyspeed:integer;
  procedure moveshape;
  protected
  procedure execute;override;
  public
  constructor create(suspended:boolean;shape:tshape;xspeed,yspeed:integer);
  propertyshape:tshapereadfshape;
  end;
  implementation
  procedure tbouad.moveshape;
  var
  maxheight,maxwidth:integer;
  begin
  with fshape do
  begin
  left:=left+fxspeed;
  top:=top+fyspeed;
  if(left=0) or(left+width=parent.width)then
  fxspeed:=fxspeed*-1;
  if(top=0)or(top=height+parent.height)then
  fyspeed:=fyspeed*-1;
  end;
  end;
  procedure tbouncethread.execute;
  begin
  while not terminated do
  begin
  synchronize(moveshape);
  end;
  end;
  constructor tbouncethread.create(suspended:boolean;shape:tshape;
  xspeed,yspeed:integer);
  begin
  inherited create(suspended);
  fshape:=shape;
  fxspeed:=xspeed;{x轴走向的速度}
  fyspeed:=yspeed;{y轴走向的速度}
  freeonterminate:=true;
  end;
  end.

  执行时我们可以新建一个程序,然后在uses部分加入以上的bncthrd单元,再在它的窗体form1上加入两个shape控件shape1和shape2,shape1可以是一个矩形而shape2
是一个圆。加入以下的代码就可以让矩形和圆动起来。
unit Unit1;
interface
uses
bncthrd,Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TForm1 = class(TForm)
Shape1: TShape;
Shape2: TShape;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
tbouncethread.create(false,shape1,1,2);
  tbouncethread.create(false,shape2,2,3);
end;
end.
...全文
212 5 打赏 收藏 转发到动态 举报
写回复
用AI写文章
5 条回复
切换为时间正序
请发表友善的回复…
发表回复
liyue 2000-07-08
  • 打赏
  • 举报
回复
程序已经调试通过,十分谢谢DXZ_pl,我把分数全部送给您。
dxz_pl 2000-07-08
  • 打赏
  • 举报
回复
unit Unit_1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
Uses UnitBncThred;

{$R *.DFM}

procedure TForm1.FormShow(Sender: TObject);
begin
TBounceThread.Create(False,Button1,1,2);
TBounceThread.Create(False,Button2,1,2);
end;

end.
//该程序在Delphi4、5中都已调试通过。
liyue 2000-07-08
  • 打赏
  • 举报
回复
先谢谢DXZ_pl,我马上试一试。
但怎样在程序中调用?请帖一个例程。谢谢!
liyue 2000-07-08
  • 打赏
  • 举报
回复
先谢谢DXZ_pl,我马上试一试。
dxz_pl 2000-07-08
  • 打赏
  • 举报
回复
//----线程
unit UnitBncThred;

interface

Uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
AppEvnts, StdCtrls, ExtCtrls;

Type
TBounceThread=Class(TThread)

Private
FShape:TButton;
FXSpeed:Integer;
FYSpeed:Integer;
Procedure MoveShape;
Protected
procedure Execute;Override;
public
Constructor Create(Suspended:Boolean;Shape:TButton;XSpeed,YSpeed:integer);
End;

implementation

Procedure TBounceThRead.MoveShape;
Begin
With FShape Do
Begin
Left :=Left+FXSpeed;
Top :=Top+FYSpeed;
if (Left <0) or (Left +Width>Screen.Width) Then
FXSpeed:=FXSpeed*-1;
if (Top <0) or (Top+Height>Screen.Height) Then
FYSpeed:=FYSpeed*-1;
End;
End;

Procedure TBounceThRead.execute;
begin
While Not TerMinated do
Begin
Synchronize(moveShape);
End;
End;

Constructor TBounceThRead.Create(Suspended:Boolean;Shape:TButton;XSpeed,YSpeed:Integer);
Begin
inherited Create(Suspended);
FShape :=Shape;
FXSpeed :=XSpeed;
FYSpeed :=YSpeed;
FreeOnTerminate:=True;
End;
end.
//----
//----在程序中调用
TBounceThread.Create(False,Button1,1,2);
//----
一、临界区 所谓临界区,就是一次只能由一个线程来执行的一段代码。如果把初始化数组的代码放在临界区内,另一个线程在第一个线程处理完之前是不会被执行的。 使用临界区的步骤: 1、先声明一个全局变量类型为TRTLCriticalSection; 2、在线程Create()前调用InitializeCriticalSection()过程来初始化,该函数定义是: void WINAPI InitializeCriticalSection(LPCRITICAL_SECTION lpCriticalSection); 类型lpCriticalSection即是Delphi封装的TRTLCriticalSection。 3、在线程的需要放入临界区的代码前面使用EnterCriticalSection(lpCriticalSection)过程来开始建立临界区。在代码完成后用LeaveCriticalSection(lpCriticalSection)来标志临界区的结束。 4、在线程执行完后用DeleteCriticalSection(lpCriticalSection)来清除临界区。这个清除过程必须放在线程执行完后的地方,比如FormDesroy事件中。上面的例子中,若把该过程放在TMyThread.Create(False);后,会产生错误。 二、互斥: 互斥非常类似于临界区,除了两个关键的区别:首先,互斥可用于跨进程的线程同步。其次,互斥能被赋予一个字符串名字,并且通过引用此名字创建现有互斥对象的附加句柄。 提示临界区与事件对象(比如互斥对象)的最大的区别是在性能上。临界区在没有线程冲突时,要用10~15个时间片,而事件对象由于涉及到系统内核要用400~600个时间片。 使用互斥的步骤: 1、声明一个类型为Thandle或Hwnd的全局变量,其实都是Cardinal类型。Hwnd是handle of window,主要用于窗口句柄;而Thandle则没有限制。 2、线程Create()前用CreateMutex()来创建一个互斥量。该函数定义为: HANDLE WINAPI CreateMutex( LPSECURITY_ATTRIBUTES lpMutexAttributes, BOOL bInitialOwner, LPCTSTR lpName:Pchar); LPSECURITY_ATTRIBUTES参数为一个指向TSecurityAttributtes记录的指针。此参数设为nil,表示访问控制列表默认的安全属性。 bInitalOwner参数表示创建互斥对象的线程是否要成为此互斥对象的拥有者。当此参数为False时,表示互斥对象没有拥有者。 lpName参数指定互斥对象的名称。设为nil表示无命名,如果参数不是设为nil,函数会搜索是否有同名的互斥对象存在。如果有,函数就会返回同名互斥对象的句柄。否则,就新创建一个互斥对象并返回其句柄。 返回值是一handle。当错误发生时,返回null,此时用GetLastError函数可查看错误的信息。 利用CreateMutex()可以防止程序多个实例运行,如下例: Program ABC; Uses Forms,Windows,…; {$R *.res} Var hMutex:Hwnd; Begin Application.Initialize; hMutex:=CreateMutex(nil,False,Pchar(Application.Title)); if GetLastErrorERROR_ALREADY_EXISTS then begin //项目要运行的咚咚 end; ReleaseMutex(hMutex); Application.Run; End; 在本节的例程中,我们只是要防止线程进入同步代码区域中,所以lpName参数设置为nil。 3、在同步代码前用WaitForSingleObject()函数。该函数使得线程取得互斥对象(同步代码)的拥有权。该函数定义为: DWORD WINAPI WaitForSingleObject( HANDLE hHandle, DWORD dwMilliseconds); 这个函数可以使当前线程在dwMilliseconds指定的时间内睡眠,直到hHandle参数指定的对象进入发信号状态为止。一个互斥对象不再被线程拥有时,它就进入发信号状态。当一个进程要终止时,它就进入发信号状态。dwMilliseconds参数可以设为0,这意味着只检查hHandle参数指定的对象是否处于发信号状态,而后立即返回。dwMilliseconds参数设为INFINITE,表示如果信号不出现将一直等下去。 这个函数的返回值含义: WAIT_ABANDONED 指定的对象是互斥对象,并且拥有这个互斥对象的线程在没有释放此对象之前就已终止。此时就称互斥对象被抛弃。这种情况下,这个互斥对象归当前线程所有,并把它设为非发信号状态 WAIT_OBJECT_0 指定的对象处于发信号状态 WAIT_TIMEOUT 等待的时间已过,对象仍然是非发信号状态 再次声明,当一个互斥对象不再被一个线程所拥有,它就处于发信号状态。此时首先调用WaitForSingleObject()函数的线程就成为该互斥对象的拥有者,此互斥对象设为不发信号状态。当线程调用ReleaseMutex()函数并传递一个互斥对象的句柄作为参数时,这种拥有关系就被解除,互斥对象重新进入发信号状态。 注意除WaitForSingleObject()函数外,你还可以使用WaitForMultipleObject()和MsgWaitForMultipleObject()函数,它们可以等待几个对象变为发信号状态。这两个函数的详细情况看Win32 API联机文档。 4、在同步代码结束后,使用ReleaseMutex(THandle)函数来标志。该函数只是释放互斥对象和线程的拥有者关系,并不释放互斥对象的句柄。 5、调用CloseHandle(THandle)来关闭互斥对象。注意例程中该函数的使用位置。 三、还有一种用信号量对象来管理线程同步的,它是在互斥的基础上建立的,但信号量增加了资源计数的功能,预定数目的线程允许同时进入要同步的代码。有点复杂,想不到在哪可以用,现在就不研究论了。 unit Tst_Thread3U; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; Button2: TButton; Button3: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); private procedure ThreadsDone(Sender: TObject); end; TMyThread=class(TThread) protected procedure Execute;override; end; var Form1: TForm1; implementation {$R *.dfm} const MaxSize=128; var NextNumber:Integer=0; DoneFlags:Integer=0; GlobalArry:array[1..MaxSize] of Integer; Lock:byte; //1-不同步 2-临界区 3-互斥 CS:TRTLCriticalSection; //临界区 hMutex:THandle; //互斥 function GetNextNumber:Integer; begin Result:=NextNumber; inc(NextNumber); end; procedure TMyThread.Execute; var i:Integer; begin FreeOnTerminate:=True; //终止后自动free OnTerminate:=Form1.ThreadsDone; if Lock3 then //非互斥情况 begin if Lock=2 then EnterCriticalSection(CS); //建立临界区 for i := 1 to MaxSize do begin GlobalArry[i]:=GetNextNumber; Sleep(5); end; if Lock=2 then LeaveCriticalSection(CS);//离开临界区 end else //-------互斥 begin if WaitForSingleObject(hMutex,INFINITE)=WAIT_OBJECT_0 then begin for i := 1 to MaxSize do begin GlobalArry[i]:=GetNextNumber; Sleep(5); end; end; ReleaseMutex(hMutex); //释放 end; end; procedure TForm1.ThreadsDone(Sender: TObject); var i:Integer; begin Inc(DoneFlags); if DoneFlags=2 then begin for i := 1 to MaxSize do Memo1.Lines.Add(inttostr(GlobalArry[i])); if Lock=2 then DeleteCriticalSection(CS); //删除临界区 If Lock=3 then CloseHandle(hMutex); //关闭互斥 end; end; //非同步 procedure TForm1.Button1Click(Sender: TObject); begin Lock:=1; TMyThread.Create(False); TMyThread.Create(False); end; //临界区 procedure TForm1.Button2Click(Sender: TObject); begin Lock:=2; InitializeCriticalSection(CS); //初始化临界区 TMyThread.Create(False); TMyThread.Create(False); end; //互斥 procedure TForm1.Button3Click(Sender: TObject); begin Lock:=3; // 互斥 hMutex:=CreateMutex(0,False,nil); TMyThread.Create(False); TMyThread.Create(False); end; end.

5,388

社区成员

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

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