この発言に対し以下のコメントが寄せられています

#00868　寅次            さん　RE:計時用ユニット






　処理の時間を計るユニットを作ってみました。

var
        LP : TLapTime;
begin
        ………

//　＠その１「ある時間のかかる処理を単純に計る」
//　　　　　計時したい処理の前に TLapTime.TimerReset しておけば
//　　　　　処理後に TLapTime.PassTimeStr で単純な経過時間が得られます。

        LP.TimerReset;
        zikannokakarusyori;
        ShowMessage( LP.PassTimeStr );

//　＠その２「プログラム、手続きの速度を計る」
//　　　　　プログラム → TLapTime.Execute( ProgramName, LoopNum );
//　　　　　手続き     → TLapTime.Proc( TestProc, LoopNum );
//          クラス内   → TLapTime.ProcOfObj( TestClass.TestProc, LoopNum );
//          それぞれ LoopNum 回の処理を LapNum ラップ（デフォルト１０ラップ）
//          繰り返し、合計から最小ラップと最大ラップを引いて平均を出します。
//          結果は TLapTime.LoopList で得られます。

procedure TForm1.…
begin
        LP.ProcOfObj( Self.TestProc, 5 );
        Memo1.Text := LP.LoopList.Text;
end:

procedure TForm1.TestProc;
begin
        Hide; Show;
end;

//　LapNum に３未満を指定した場合のチェックはしてません。(^^;

unit TraTime;

interface

uses
        Windows, SysUtils, Classes;

type
        TLapTimeProc = Procedure;
        TLapTimeProcOfObj = Procedure of Object;
        TLapTime = class
        private
                StartTime       : TDateTime;            //計時開始時間
                FLoopNum        : Cardinal;             //ループ回数
                FLapNum         : Cardinal;             //ラップ回数
                FNowLap         : Cardinal;             //今処理してるラップ
                FLoopList       : TStringList;          //結果出力
                TestProc        : TLapTimeProc;
                TestProcOfObj   : TLapTimeProcOfObj;
                TestPrg         : PChar;
                function        GetPassTime: TDateTime;
                function        GetPassTimeStr: String;
                procedure       StartRunning;           //ループ計測処理
                procedure       Proc_LoopProc;          //  Procedure 用
                procedure       ProcOfObj_LoopProc;     //  Proc of Obj 用
                procedure       Execute_LoopProc;       //  Prg 用
                procedure       ProgressAtLoop; virtual;//  ラップ毎の追加処理
        public
                constructor     Create;
                destructor      Destroy; override;
                procedure       TimerReset;             //計時リセット
                procedure       Execute(PrgName: String; Count: Cardinal);
                procedure       Proc(Proc: TLapTimeProc; Count: Cardinal);
                procedure       ProcOfObj(Proc: TLapTimeProcOfObj;
                                Count: Cardinal);
        published
                property        LoopList: TStringList Read FLoopList;
                property        PassTime: TDateTime Read GetPassTime;
                property        PassTimeStr: String Read GetPassTimeStr;
                property        LapNum: Cardinal Read FLapNum
                                                 Write FLapNum;
                property        LoopNum: Cardinal Read FLoopNum;
                property        NowLap: Cardinal Read FNowLap;
        end;

implementation

type
        TLoopProc = Procedure of Object;
var
        LoopProc : TLoopProc;

function DecodeTimeToStr(Time: TDateTime): String;
 (* TDateTime の時間部分だけを文字列へ *)
var
        Hour, Min, Sec, Msec : Word;
begin
        DecodeTime( Time, Hour, Min, Sec, Msec );
        Result := Format( '%.2d:%.2d:%.2d.%.3d', [Hour, Min, Sec, MSec] );
end;

function TLapTime.GetPassTime: TDateTime;
begin
        Result := Now-StartTime;
end;

function TLapTime.GetPassTimeStr: String;
begin
        Result := DecodeTimeToStr( PassTime );
end;

constructor TLapTime.Create;
begin
        FLoopList := TStringList.Create;
        FLoopList.add( '- LapTime by Delphi -' );
        FLapNum := 10;
end;

destructor TLapTime.Destroy;
begin
        FLoopList.Free;
end;

procedure TLapTime.TimerReset;
begin
        StartTime := Now;
end;

procedure TLapTime.StartRunning;
var
        Res, Total, Mini, Max : TDateTime;
        i : Cardinal;
        s : String;
begin
        Total := 0;
        Mini := 100000000;      //値はてきとぉ〜な最大値
        Max := 0;

        FLoopList.add( Format( 'Loop    : %u ( *%u Lap )',
                        [FLoopNum, FLapNum] ) );
        FLoopList.add( StringOfChar( '-', 40 ) );
        for i := 1 to FLapNum do begin
                FNowLap := i;           // NowLap を設定
                ProgressAtLoop;         //追加経過処理（メッセージ表示など）
                TimerReset;             //タイマーをリセット
                LoopProc;               //ループ処理
                Res := PassTime;        //経過時間を取得
                Total := Total+Res;
                if Mini>Res then Mini := Res;
                if Max<Res then Max := Res;
                FLoopList.add( Format( 'Lap %3d : %s',
                                [i, DecodeTimeToStr( Res )] ) );
        end;
        FLoopList.add( StringOfChar( '-', 40 ) );

        s := 'Total   : '+DecodeTimeToStr( Total )+
             '  Min : '+DecodeTimeToStr( Mini )+
             '  Max : '+DecodeTimeToStr( Max );
        FLoopList.add( s );

        //最小値を最大値を引いたものから平均値を出す
        Total := ( Total-Mini-Max )/( FLapNum-2 );
        FLoopList.add( 'Average : '+DecodeTimeToStr( Total )+
                        '  (Total-Min-Max)/(Lap-2)' );
        Total := Total/FLoopNum;
        FLoopList.add( 'Once    : '+DecodeTimeToStr( Total )+
                        '  Average/Loop' );
end;

procedure TLapTime.Proc_LoopProc;
begin
        TestProc;
end;

procedure TLapTime.ProcOfObj_LoopProc;
begin
        TestProcOfObj;
end;

procedure TLapTime.Execute_LoopProc;
var
        i : Cardinal;
        PI : TProcessInformation;
        SI : TStartupInfo;
begin
        for i := 1 to FLoopNum do begin
                // CreateProcess にエラーがあったら Raise
                GetStartupInfo( SI );
                if not CreateProcess( nil, TestPrg, nil, nil,
                False, CREATE_DEFAULT_ERROR_MODE, nil, nil, SI, PI ) then
                        Raise Exception.Create( String( TestPrg )+' : '+
                        SysErrorMessage( GetLastError ) );
                while WaitForSingleObject( PI.hProcess, 0 )=WAIT_TIMEOUT do;
        end;
end;

procedure TLapTime.ProgressAtLoop;
begin
        {$I-} Writeln( 'Now Lap', FNowLap ); {$I+}
end;

procedure TLapTime.Execute(PrgName: String; Count: Cardinal);
begin
        FLoopList.add( 'Program : '+PrgName );
        TestPrg := PChar( PrgName );
        FLoopNum := Count;
        LoopProc := Execute_LoopProc;
        StartRunning;
end;

procedure TLapTime.Proc(Proc: TLapTimeProc; Count: Cardinal);
begin
        FLoopList.add( 'Procedure' );
        TestProc := Proc;
        FLoopNum := Count;
        LoopProc := Proc_LoopProc;
        StartRunning;
end;

procedure TLapTime.ProcOfObj(Proc: TLapTimeProcOfObj; Count: Cardinal);
begin
        FLoopList.add( 'Procedure of Object' );
        TestProcOfObj := Proc;
        FLoopNum := Count;
        LoopProc := ProcOfObj_LoopProc;
        StartRunning;
end;

end.


(PXC07042) - とらじ -

Original document by 寅次            氏 ID:(PXC07042)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。