begin
i:=1;
button1.Caption :='开始';
button2.Caption :='退出';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if button1.Caption='开始' then begin
button1.Caption :='停止';
timer1.Enabled :=true;
label7.Caption :='00' ;
label5.Caption :='00' ;
label3.Caption :='00' ;
label1.Caption :='00' ;
end
else
begin
timer1.Enabled :=false;
button1.Caption :='开始';
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if button1.Caption='停止' then
//while strtoint(label7.Caption)<60 do
begin
i:=i+1;
label7.Caption:=inttostr(i) ;
end;
if label7.Caption='60' then
begin
label7.Caption :='00';
i:=1;
label5.Caption :=inttostr(strtoint(label5.Caption)+1);
end;
if label5.Caption='60' then
begin
label5.Caption :='00';
label3.Caption :=inttostr(strtoint(label3.Caption)+1);
end;
if label3.Caption='60' then
begin
label3.Caption :='00';
label1.Caption :=inttostr(strtoint(label1.Caption)+1)
end;
//if (strtoint(label7.Caption)<10)and(strtoint(label7.Caption)>0) then
//label7.Caption :='0'+label7.Caption ;
//if (strtoint(label5.Caption)<10)and(strtoint(label5.Caption)>0) then
//label5.Caption :='0'+label5.Caption ;
destructor TMMTimer.Destroy;
begin
FEnabled := False;
UpdateTimer;
inherited Destroy;
end;
procedure TMMTimer.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
UpdateTimer;
end;
end;
procedure TMMTimer.SetInterval(Value: Cardinal);
begin
if Value <> FInterval then
begin
FInterval := Value;
UpdateTimer;
end;
end;
procedure TMMTimer.SetOnTimer(Value: TNotifyEvent);
begin
FOnTimer := Value;
UpdateTimer;
end;
procedure TMMTimer.SetResolution(Value: Cardinal);
var
Caps: TTimeCaps;
begin
if (Value <> FResolution) and (timeGetDevCaps(@Caps, Sizeof(TTimeCaps)) <> 0) then
begin
if Value < Caps.wPeriodMin then //小于最小分辨率
Value := 0
else if Value > Caps.wPeriodMax then //大于最小分辨率
Value := Caps.wPeriodMax;
FInterval := Value;
UpdateTimer;
end;
end;
procedure TMMTimer.Timer;
begin
// if Assigned(MMTimer.OnTimer) then
// FOnTimer(MMTimer);
if Assigned(OnTimer) then
FOnTimer(Self);
end;
procedure TMMTimer.UpdateTimer;
var
lpTimerProc: TFNTimeCallBack;
begin
if uTimerID <> 0 then
timeKillEvent(uTimerID); //销毁
if (FInterval > 0) and FEnabled and Assigned(FOnTimer) then
begin
lpTimerProc := @TimerCallback;
uTimerID := TimeSetEvent(FInterval, FResolution, lpTimerProc, DWORD(Self), TIME_PERIODIC);
if uTimerID = 0 then
begin
FEnabled := FALSE;
raise EMMTimer.Create('定时器创建失败!');
end;
end;
end;
end.
var
BeginTime:int64 ; //Timer Begin time
EndTime:int64 ; //Timer End time
Frequency:int64 ; //used by system time counter
begin
QueryPerformanceFrequency(Frequency);
QueryPerformanceCounter(BeginTime); //Get Start Timer Time
while not Terminated do
begin
ServiceThread.ProcessRequests(false);
QueryPerformanceCounter(EndTime); //Get Current Time
if (EndTime-BeginTime)*1000/Frequency>=100 then //100 =1/10秒
begin
//
//Raise Timer Event or Dosomething here
//
QueryPerformanceCounter(BeginTime); //Get Next Timer Start Time
end;
Sleep(1);
end;
end;