MMDSPMtr.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:7k
- {========================================================================}
- {= (c) 1995-98 SwiftSoft Ronald Dittrich =}
- {========================================================================}
- {= All Rights Reserved =}
- {========================================================================}
- {= D 01099 Dresden = Fax.: +49 (0)351-8037944 =}
- {= Loewenstr.7a = info@swiftsoft.de =}
- {========================================================================}
- {= Actual versions on http://www.swiftsoft.de/mmtools.html =}
- {========================================================================}
- {= This code is for reference purposes only and may not be copied or =}
- {= distributed in any format electronic or otherwise except one copy =}
- {= for backup purposes. =}
- {= =}
- {= No Delphi Component Kit or Component individually or in a collection=}
- {= subclassed or otherwise from the code in this unit, or associated =}
- {= .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed =}
- {= without express permission from SwiftSoft. =}
- {= =}
- {= For more licence informations please refer to the associated =}
- {= HelpFile. =}
- {========================================================================}
- {= $Date: 08.07.98 - 03:32:54 $ =}
- {========================================================================}
- unit MMDSPMtr;
- {$I COMPILER.INC}
- interface
- uses
- {$IFDEF WIN32}
- Windows,
- {$ELSE}
- WinTypes,
- WinProcs,
- {$ENDIF}
- SysUtils,
- Controls,
- Classes,
- Forms,
- MMSystem,
- MMObj,
- MMUtils,
- MMTimer;
- const
- INTERVAL = 100;
- type
- {-- TMMMDSPMeter ----------------------------------------------------------}
- TMMDSPMeter = class(TMMNonVisualComponent)
- private
- FTimerID : Longint;
- FInitCount : Longint;
- FMeasureTime : Longint;
- FStartTime : Longint;
- FMeasureCount: Longint;
- FLastTime : FLoat;
- FCurTime : Longint;
- function GetValue: integer;
- public
- constructor Create(aOwner: TComponent); override;
- destructor Destroy; override;
- procedure Init;
- procedure Done;
- procedure StartMeasurement;
- procedure StopMeasurement;
- property Value: integer read GetValue;
- end;
- procedure InitDSPMeter;
- procedure DoneDSPMeter;
- procedure StartDSPMeter;
- procedure StopDSPMeter;
- implementation
- const
- GlobalDSPMeter: TMMDSPMeter = nil;
- {------------------------------------------------------------------------------}
- procedure InitDSPMeter;
- begin
- if (GlobalDSPMeter <> nil) then
- begin
- GlobalDSPMeter.Init;
- end;
- end;
- {------------------------------------------------------------------------------}
- procedure DoneDSPMeter;
- begin
- if (GlobalDSPMeter <> nil) then
- begin
- GlobalDSPMeter.Done;
- end;
- end;
- {------------------------------------------------------------------------------}
- procedure StartDSPMeter;
- begin
- if (GlobalDSPMeter <> nil) then
- begin
- GlobalDSPMeter.StartMeasurement;
- end;
- end;
- {------------------------------------------------------------------------------}
- procedure StopDSPMeter;
- begin
- if (GlobalDSPMeter <> nil) then
- begin
- GlobalDSPMeter.StopMeasurement;
- end;
- end;
- {------------------------------------------------------------------------}
- procedure TimeCallBack(uTimerID, dwUser: Longint); export;
- const
- Decay = 0.9;
- var
- CurTime: Longint;
- begin
- if (dwUser <> 0) then
- with TMMDSPMeter(dwUser) do
- begin
- if (FInitCount > 0) then
- begin
- if (FMeasureCount > 0) then
- begin
- CurTime := TimeGetTime;
- inc(FMeasureTime,CurTime-FStartTime);
- FStartTime := CurTime;
- end;
- FLastTime := FLastTime*Decay+(1-Decay)*FMeasureTime+0.05;
- FCurTime := Trunc(FLastTime);
- FMeasureTime := 0;
- end;
- end
- end;
- {== TMMDSPMeter ===============================================================}
- constructor TMMDSPMeter.Create(aOwner: TComponent);
- begin
- inherited Create(aOwner);
- FInitCount := 0;
- TimeBeginPeriod(1);
- if (GlobalDSPMeter = nil) then GlobalDSPMeter := Self;
- ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
- if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
- end;
- {-- TMMDSPMeter ---------------------------------------------------------------}
- destructor TMMDSPMeter.Destroy;
- begin
- TimeEndPeriod(1);
- if (GlobalDSPMeter = Self) then GlobalDSPMeter := nil;
- inherited Destroy;
- end;
- {-- TMMDSPMeter ---------------------------------------------------------------}
- procedure TMMDSPMeter.Init;
- begin
- if (GlobalDSPMeter <> Self) then exit;
- inc(FInitCount);
- if (FInitCount = 1) then
- begin
- FMeasureCount := 0;
- FMeasureTime := 0;
- FLastTime := 0;
- FCurTime := 0;
- FTimerID := MMTimeSetEvent(INTERVAL, False, TimeCallBack, Longint(Self));
- end;
- end;
- {-- TMMDSPMeter ---------------------------------------------------------------}
- procedure TMMDSPMeter.Done;
- begin
- if (FInitCount > 0) then
- begin
- dec(FInitCount);
- if (FInitCount = 0) then
- begin
- MMTimeKillEvent(FTimerID);
- end;
- end;
- end;
- {-- TMMDSPMeter ---------------------------------------------------------------}
- procedure TMMDSPMeter.StartMeasurement;
- begin
- if (FInitCount > 0) then
- begin
- inc(FMeasureCount);
- if (FMeasureCount = 1) then FStartTime := TimeGetTime;
- end;
- end;
- {-- TMMDSPMeter ---------------------------------------------------------------}
- procedure TMMDSPMeter.StopMeasurement;
- begin
- if (FInitCount > 0) then
- begin
- dec(FMeasureCount);
- if (FMeasureCount = 0) then
- begin
- inc(FMeasureTime,TimeGetTime-FStartTime);
- end;
- end;
- end;
- {-- TMMDSPMeter ---------------------------------------------------------------}
- function TMMDSPMeter.GetValue: integer;
- begin
- Result := 0;
- if (FInitCount > 0) then
- begin
- Result := Min((FCurTime * 100) div INTERVAL,100);
- end;
- end;
- end.