在玩一个非常无聊的小游戏时为了保存纪录，需要计时，而且要精确到毫秒，随时可暂停并继续，并且能保存当前的时间。这样的小软件无需上网到处找，随便自己写一个算了。

实现原理非常简单，利用一个ＡＰＩ函数 GetTickCount 即可，其它都是一些辅助性功能。界面懒得去弄了，要的是功能。看代码。

unit Unit1;

interface

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

type
   TForm1 = class(TForm)
   B1: TButton;
   B2: TButton;
   B3: TButton;
   Timer1: TTimer;
   Timer2: TTimer;
   BtnRun: TButton;
   B4: TButton;
   B5: TButton;
   L1: TLabel;
   procedure B1Click(Sender: TObject);
   procedure Timer1Timer(Sender: TObject);
   procedure FormCreate(Sender: TObject);
   procedure B2Click(Sender: TObject);
   procedure B3Click(Sender: TObject);
   procedure Timer2Timer(Sender: TObject);
   procedure B4Click(Sender: TObject);
   procedure BtnRunClick(Sender: TObject);
   procedure B5Click(Sender: TObject);
   private
   { Private declarations }
   public
   { Public declarations }
   end;

var
   Form1: TForm1;
   iStart, iPauseStart, iElipse: LongInt;
   iFlash: integer;
   strFlash: string;
implementation

{$R *.dfm}

function CheckTask(ExeFileName: string): Boolean;
const
   PROCESS_TERMINATE = $0001;
var
   ContinueLoop: BOOL;
   FSnapshotHandle: THandle;
   FProcessEntry32: TProcessEntry32;
begin
   result := False;
   FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
   FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
   ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
   while integer(ContinueLoop) <> 0 do
   begin
   if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
   UpperCase(ExeFileName))
   or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName)))
   then
   result := True;
   ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
   end;
end;

procedure TForm1.B1Click(Sender: TObject);
begin
   iStart := GetTickCount;
   Timer1.Enabled := True;
   B1.Enabled := False;
   B2.Enabled := True;
   B3.Enabled := True;
   B3.Caption := '结束';
   B2.Caption := '暂停';
   L1.Font.Color := clBlue;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
   iHour, iMin, iSec, iMSec: string;
   i: integer;
begin
   iElipse := GetTickCount - iStart;
   i := iElipse mod 1000;
   iMSec := inttostr(i);
   if Length(iMSec) = 1 then iMSec := '00' + iMSec;
   if Length(iMSec) = 2 then iMSec := '0' + iMSec;

   iSec := inttostr(Trunc(iElipse div 1000) mod 60);
   if Length(iSec) = 1 then iSec := '0' + iSec;

   iMin := inttostr(Trunc(iElipse div 1000 div 60) mod 60);
   if Length(iMin) = 1 then iMin := '0' + iMin;

   iHour := inttostr(Trunc(iElipse div 1000 div 60 div 60) mod 60);
   if Length(iHour) = 1 then iHour := '0' + iHour;

   L1.Caption := iHour + '时' + iMin + '分' + iSec + '秒' + iMSec + '毫秒';

   //声音提示：
   if (iSec = '00') and (iMin <> '00') and (iMin <> '20')
   and (iMin <> '30') and (i <= 100) then
   PlaySound('ding.wav', 0, SND_ASYNC);

   if (iSec = '00') and (iMin = '20') and (i <= 100) then
   PlaySound('20.wav', 0, SND_ASYNC);

   if (iSec = '00') and (iMin = '30') and (i <= 100) then
   PlaySound('30.wav', 0, SND_ASYNC);

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Form1.DoubleBuffered := True;
   Form1.Top := 0;
   SetWindowPos(Handle, Hwnd_Topmost, 0, 0, 0, 0,
   (SWP_NOMOVE or SWP_NOSIZE));
end;

procedure TForm1.B2Click(Sender: TObject);
begin
   if B2.Caption = '暂停' then
   begin
   Timer1.Enabled := False;
   iPauseStart := GetTickCount;
   B2.Caption := '继续';
   strFlash := L1.Caption;
   Timer2.Enabled := True;
   Form1.Caption := '高精度秒表 -- 暂停';
   Exit;
   end else
   begin
   Timer1.Enabled := True;
   iStart := iStart + GetTickCount - iPauseStart; //累加中间停顿时间；
   B2.Caption := '暂停';
   L1.Font.Color := clBlue;
   Timer2.Enabled := False;
   Form1.Caption := '高精度秒表';
   Exit;
   end;

end;

procedure TForm1.B3Click(Sender: TObject);
begin
   if B3.Caption = '结束' then
   begin
   Timer1.Enabled := False;
   Timer2.Enabled := False;
   if L1.Caption = '' then L1.Caption := strFlash;
   L1.Font.Color := clRed;
   Form1.Caption := '高精度秒表';
   B1.Enabled := True;
   B2.Enabled := False;
   B2.Caption := '暂停';
   B3.Caption := '清零';
   Exit;
   end else //清零
   begin
   L1.Caption := '00时00分00秒000毫秒';
   L1.Font.Color := clBlue;
   B3.Caption := '结束';
   B3.Enabled := False;
   Exit;
   end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
   iFlash := iFlash + 1;
   if iFlash >= 256 then iFlash := 0;
   if not (iFlash mod 2 = 1) then
   begin
   L1.Caption := strFlash;
   Exit;
   end else
   begin
   L1.Caption := '';
   Exit;
   end;
end;

procedure TForm1.B4Click(Sender: TObject);
var
   TXT: TextFile;
   F: string;
   Buf: string;
begin
   if not Timer1.Enabled then Exit;
   F := ExtractFilePath(ParamStr(0)) + '记录.txt';
   AssignFile(TXT, F);
   if not FileExists(F) then ReWrite(TXT) else Append(TXT);
   Buf := '本次纪录耗时共：' + L1.Caption + ' 完成时间:' + DateToStr(Now) + ' '
   + TimetoStr(Now);
   WriteLn(TXT, Buf);
   CloseFile(TXT);
end;

procedure TForm1.BtnRunClick(Sender: TObject);
begin
if not CheckTask('bs5_.exe') then
begin
   ShellExecute(0, nil, '泡泡.lnk', nil, nil, SW_SHOW);
end;
end;

procedure TForm1.B5Click(Sender: TObject);
begin
   ShellExecute(0, 'open', '记录.txt', nil, nil, SW_SHOW);
end;

end.