MMDSPMtr.pas
上传用户:hylc_2004
上传日期:2014-01-23
资源大小:46800k
文件大小:7k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Fax.: +49 (0)351-8037944              =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
  10. {========================================================================}
  11. {=  This code is for reference purposes only and may not be copied or   =}
  12. {=  distributed in any format electronic or otherwise except one copy   =}
  13. {=  for backup purposes.                                                =}
  14. {=                                                                      =}
  15. {=  No Delphi Component Kit or Component individually or in a collection=}
  16. {=  subclassed or otherwise from the code in this unit, or associated   =}
  17. {=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
  18. {=  without express permission from SwiftSoft.                          =}
  19. {=                                                                      =}
  20. {=  For more licence informations please refer to the associated        =}
  21. {=  HelpFile.                                                           =}
  22. {========================================================================}
  23. {=  $Date: 08.07.98 - 03:32:54 $                                        =}
  24. {========================================================================}
  25. unit MMDSPMtr;
  26. {$I COMPILER.INC}
  27. interface
  28. uses
  29. {$IFDEF WIN32}
  30.     Windows,
  31. {$ELSE}
  32.     WinTypes,
  33.     WinProcs,
  34. {$ENDIF}
  35.     SysUtils,
  36.     Controls,
  37.     Classes,
  38.     Forms,
  39.     MMSystem,
  40.     MMObj,
  41.     MMUtils,
  42.     MMTimer;
  43. const
  44.     INTERVAL = 100;
  45. type
  46.     {-- TMMMDSPMeter ----------------------------------------------------------}
  47.     TMMDSPMeter = class(TMMNonVisualComponent)
  48.     private
  49.        FTimerID     : Longint;
  50.        FInitCount   : Longint;
  51.        FMeasureTime : Longint;
  52.        FStartTime   : Longint;
  53.        FMeasureCount: Longint;
  54.        FLastTime    : FLoat;
  55.        FCurTime     : Longint;
  56.        function GetValue: integer;
  57.     public
  58.        constructor Create(aOwner: TComponent); override;
  59.        destructor  Destroy; override;
  60.        procedure Init;
  61.        procedure Done;
  62.        procedure StartMeasurement;
  63.        procedure StopMeasurement;
  64.        property  Value: integer read GetValue;
  65.     end;
  66. procedure InitDSPMeter;
  67. procedure DoneDSPMeter;
  68. procedure StartDSPMeter;
  69. procedure StopDSPMeter;
  70. implementation
  71. const
  72.      GlobalDSPMeter: TMMDSPMeter = nil;
  73. {------------------------------------------------------------------------------}
  74. procedure InitDSPMeter;
  75. begin
  76.    if (GlobalDSPMeter <> nil) then
  77.    begin
  78.       GlobalDSPMeter.Init;
  79.    end;
  80. end;
  81. {------------------------------------------------------------------------------}
  82. procedure DoneDSPMeter;
  83. begin
  84.    if (GlobalDSPMeter <> nil) then
  85.    begin
  86.       GlobalDSPMeter.Done;
  87.    end;
  88. end;
  89. {------------------------------------------------------------------------------}
  90. procedure StartDSPMeter;
  91. begin
  92.    if (GlobalDSPMeter <> nil) then
  93.    begin
  94.       GlobalDSPMeter.StartMeasurement;
  95.    end;
  96. end;
  97. {------------------------------------------------------------------------------}
  98. procedure StopDSPMeter;
  99. begin
  100.    if (GlobalDSPMeter <> nil) then
  101.    begin
  102.       GlobalDSPMeter.StopMeasurement;
  103.    end;
  104. end;
  105. {------------------------------------------------------------------------}
  106. procedure TimeCallBack(uTimerID, dwUser: Longint); export;
  107. const
  108.    Decay = 0.9;
  109. var
  110.    CurTime: Longint;
  111. begin
  112.   if (dwUser <> 0) then
  113.   with TMMDSPMeter(dwUser) do
  114.   begin
  115.      if (FInitCount > 0) then
  116.      begin
  117.         if (FMeasureCount > 0) then
  118.         begin
  119.            CurTime := TimeGetTime;
  120.            inc(FMeasureTime,CurTime-FStartTime);
  121.            FStartTime := CurTime;
  122.         end;
  123.         FLastTime := FLastTime*Decay+(1-Decay)*FMeasureTime+0.05;
  124.         FCurTime := Trunc(FLastTime);
  125.         FMeasureTime := 0;
  126.      end;
  127.   end
  128. end;
  129. {== TMMDSPMeter ===============================================================}
  130. constructor TMMDSPMeter.Create(aOwner: TComponent);
  131. begin
  132.    inherited Create(aOwner);
  133.    FInitCount := 0;
  134.    TimeBeginPeriod(1);
  135.    if (GlobalDSPMeter = nil) then GlobalDSPMeter := Self;
  136.    ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
  137.    if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
  138. end;
  139. {-- TMMDSPMeter ---------------------------------------------------------------}
  140. destructor TMMDSPMeter.Destroy;
  141. begin
  142.    TimeEndPeriod(1);
  143.    if (GlobalDSPMeter = Self) then GlobalDSPMeter := nil;
  144.    inherited Destroy;
  145. end;
  146. {-- TMMDSPMeter ---------------------------------------------------------------}
  147. procedure TMMDSPMeter.Init;
  148. begin
  149.    if (GlobalDSPMeter <> Self) then exit;
  150.    inc(FInitCount);
  151.    if (FInitCount = 1) then
  152.    begin
  153.       FMeasureCount := 0;
  154.       FMeasureTime := 0;
  155.       FLastTime := 0;
  156.       FCurTime := 0;
  157.       FTimerID := MMTimeSetEvent(INTERVAL, False, TimeCallBack, Longint(Self));
  158.    end;
  159. end;
  160. {-- TMMDSPMeter ---------------------------------------------------------------}
  161. procedure TMMDSPMeter.Done;
  162. begin
  163.    if (FInitCount > 0) then
  164.    begin
  165.       dec(FInitCount);
  166.       if (FInitCount = 0) then
  167.       begin
  168.          MMTimeKillEvent(FTimerID);
  169.       end;
  170.    end;
  171. end;
  172. {-- TMMDSPMeter ---------------------------------------------------------------}
  173. procedure TMMDSPMeter.StartMeasurement;
  174. begin
  175.    if (FInitCount > 0) then
  176.    begin
  177.       inc(FMeasureCount);
  178.       if (FMeasureCount = 1) then FStartTime := TimeGetTime;
  179.    end;
  180. end;
  181. {-- TMMDSPMeter ---------------------------------------------------------------}
  182. procedure TMMDSPMeter.StopMeasurement;
  183. begin
  184.    if (FInitCount > 0) then
  185.    begin
  186.       dec(FMeasureCount);
  187.       if (FMeasureCount = 0) then
  188.       begin
  189.          inc(FMeasureTime,TimeGetTime-FStartTime);
  190.       end;
  191.    end;
  192. end;
  193. {-- TMMDSPMeter ---------------------------------------------------------------}
  194. function TMMDSPMeter.GetValue: integer;
  195. begin
  196.    Result := 0;
  197.    if (FInitCount > 0) then
  198.    begin
  199.       Result := Min((FCurTime * 100) div INTERVAL,100);
  200.    end;
  201. end;
  202. end.