【delphi开源代码栏目提醒】:以下是网学会员为您推荐的delphi开源代码-Frm_Thread.pas,希望本篇文章对您学习有所帮助。
unit Frm_Thread;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, XPMan, Buttons;
type
TPlayThread = class(TThread)
private
FWight:integer;
FControl:TGraphicControl;
{ Private declarations }
protected
Procedure SetControl(value:TGraphicControl);
procedure SetWight(value:Integer);
{ protected declarations }
public
procedure Execute;override;
{ Public declarations }
published
property SControl:TGraphicControl Write SetControl;
property Wight:integer read FWight Write SetWight;
end;
TFrmmutil = class(TForm)
BtnStartPaint: TButton;
BtnClose: TButton;
GroupBox1: TGroupBox;
Image1: TImage;
Image2: TImage;
Image3: TImage;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure BtnStartPaintClick(Sender: TObject);
procedure BtnCloseClick(Sender: TObject);
private
Pt,pt1,pt2:TPlayThread;
{ Private declarations }
public
{ Public declarations }
end;
var
Frmmutil: TFrmmutil;
implementation
{$R *.dfm}
procedure TPlayThread.SetControl(value:TGraphicControl);
begin
if assigned(value) then
begin
FControl:=Value;
end;
end;
procedure TPlayThread.Execute;
begin
Randomize;
if assigned(FControl) then
begin
while FControl.Left<FWight do
begin
FControl.Left:=FControl.Left+Random(2);
sleep(Random(80));
end;
end;
end;
procedure TPlayThread.SetWight(value:integer);
begin
if value > FControl.Left then
begin
FWight:=Value;
end;
end;
procedure TFrmmutil.FormCreate(Sender: TObject);
begin
pt:=TPlayThread.Create(true);
pt1:=TPlayThread.Create(true);
pt2:=TPlayThread.Create(true);
pt.SControl:=image1;
pt1.SControl:=image2;
pt2.SControl:=image3;
pt.Wight:=self.Width-image1.Width;
pt1.Wight:=self.Width-image2.Width;
pt2.Wight:=self.Width-image3.Width;
pt.Priority:=tpHigher;
pt1.Priority:=tpHigher;
pt2.Priority:=tpHigher;
end;
procedure TFrmmutil.FormDestroy(Sender: TObject);
begin
pt.Terminate;
pt1.Terminate;
pt2.Terminate;
freeandnil(pt);
freeandnil(pt1);
freeandnil(pt2);
end;
procedure TFrmmutil.BtnStartPaintClick(Sender: TObject);
begin
pt.Resume;
pt2.Resume;
pt1.Resume;
end;
procedure TFrmmutil.BtnCloseClick(Sender: TObject);
begin
Close;
end;
end.