TTimer的OnTime事件居然不被触发!(10分)

  • 主题发起人 主题发起人 linuxping
  • 开始时间 开始时间
L

linuxping

Unregistered / Unconfirmed
GUEST, unregistred user!
我在类中封装了一个TTimer:
type TDlgText=class(TThread) //检查QQH里句柄的有效性加入文本文件保存.
private
FList:TThreadList;
FTime:TTimer; //记时器
..........

然后在TThread的Execute里创建Timer,并把OnTime事件和自己定义的函数联系起来:
procedure TQQText.Execute;
begin
inherited;
FTime:=TTimer.Create(frmMainOperation);
FTime.Interval:=350;
FTime.OnTimer:=MyOnTimer;
FTime.Enabled:=True;
end;

procedure TQQText.MyOnTimer(Sender: TObject);
var
sStr:string;
sFileName:string;
i:Integer;
FileHandle: Integer;

begin
CheckList;
with FList.LockList do
begin
for i:=0 to Count-1 do
begin
..................

但是,我在CheckList;处设置断点,发现MyOnTimer里的代码从来未被执行过!!!!!
期待解决!
 
procedure TQQText.Execute;
begin
inherited;
FTime:=TTimer.Create(frmMainOperation);
FTime.Interval:=350;
FTime.OnTimer:=MyOnTimer;
FTime.Enabled:=True;
while not Self.Terminated do
begin
Application.ProcessMessages;
Sleep(1000);
end;
end;
 
另外补充一句,你Timer.OnTimer中的代码很不安全
可能引起死锁
 
to muhx:
你按照你的代码修改,可是MyOnTimer里的代码依然没有被执行.

'你Timer.OnTimer中的代码很不安全'---为什么不安全?那么该怎么做?
 
我根据你的要求刚才写的一段测试代码,可以执行,你参考一下

unit Unit1;

interface

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

const
WM_MyMsg = WM_USER + 1;

type
TMyThread = class(TThread)
private
FTimer: TTimer;
procedure OnProcess(Sender: TObject);
protected
procedure Execute; override;
end;
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure ProcessMsg(var AMessage: TMessage); message WM_MyMsg;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TMyThread }

procedure TMyThread.Execute;
begin
inherited;
Self.FreeOnTerminate := True;
FTimer := TTimer.Create(nil);
FTimer.Interval := 350;
FTimer.OnTimer := OnProcess;
FTimer.Enabled := True;
while not Self.Terminated do
begin
Sleep(1000);
Application.ProcessMessages;
end;
end;

procedure TMyThread.OnProcess(Sender: TObject);
begin
PostMessage(Application.MainForm.Handle, WM_MyMsg, 0, 0);
end;

{ TForm1 }

procedure TForm1.ProcessMsg(var AMessage: TMessage);
begin
Self.Caption := DateTimeToStr(Now);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Tmp: TMyThread;
begin
Tmp := TMyThread.Create(False);
end;

end.
 
Timer要通过消息循环来实现,你的线程并没有消息循环,所以不触发也是不奇怪的。
线程中控制时间最好通过别的方法来实现。
 
建议不要在线程中动态创建时间组件,而改为在线程中打开时间组件的开关。这样处理应该比较简单。
 
procedure TMyThread.Execute;
var
tmpTime: TDateTime;
begin
inherited;
while not Terminated do
begin
tmpTime := Now;
try
if (Now - tmpTime) * 24 * 3600 > Interval then
begin
//-------------------//
//...需要定时执行的程序
//-------------------//
tmpTime := Now;
end;
except
Continue;
end;
end;
end;
 
在线程中打开开关不是个好办法~~
 
??????何以见得??
 
后退
顶部