mmconect.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [phone]               =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/index.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: 05.10.98 - 17:53:10 $                                        =}
{========================================================================}
unit MMConect;

{$I COMPILER.INC}

{.$DEFINE _MMDEBUG}

{$C FIXED PRELOAD PERMANENT}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Messages,
    Classes,
    Controls,
    Forms,
    MMSystem,
    MMObj,
    MMDSPObj,
    MMTimer,
    MMUtils,
    MMString,
    MMMulDiv,
    MMRegs,
    MMPCMSup,
    MMWaveIO,
    MMLevel,
{$IFNDEF LEVEL_ONLY}
    MMMeter,
    MMOscope,
    MMSpectr,
    MMSpGram,
    MMLight,
{$ENDIF}
    MMACMSup
    {$IFDEF _MMDEBUG}
    ,MMDebug
    {$ENDIF};

const
   { set this to true if you have problems with hints or flat buttons }
   ENTER_IDLE_MODE : Boolean = False;
   {$IFDEF CBUILDER3} {$EXTERNALSYM MAXSPEED} {$ENDIF}
   MAXSPEED        = 5000;

type
   TMMTriggerMode    = (tmNone, tmUpFlank, tmDownFlank);
   EMMConnectorError = class(Exception);

   {-- TMMConnector ------------------------------------------------------}
   TMMConnector = class(TMMDSPComponent)
   private
    {$IFDEF WIN32}
    FDataSection   : TRtlCriticalSection;
    {$ENDIF}
    FTimerID       : integer;
    FEnabled       : Boolean;
    FRestoreIdle   : Boolean;
    FAutoTrigger   : Boolean;
    FTriggerMode   : TMMTriggerMode;
    FTriggerLevel  : integer;
    FSynchronize   : Boolean;
    FSilence       : integer;
    FStarted       : Boolean;
    FRunning       : Boolean;
    FPaused        : Boolean;
    FConvert       : PACMConvert;
    FDstWaveFormat : PWaveFormatEx;
    FDstBufferSize : Longint;
    FRealBufferSize: Longint;
    FSrcData       : PChar;
    FDstData       : PChar;
    FAutoConvert   : Boolean;
    FIsPCMFormat   : Boolean;
    FCanConvert    : Boolean;
    FSpeed         : integer;
    FRefresh       : Boolean;
    FInHandler     : integer;
    FRealTime      : Boolean;

    FLevel1        : TMMLevel;
    FLevel2        : TMMLevel;
    {$IFNDEF LEVEL_ONLY}
    FMeter1        : TMMMeter;
    FMeter2        : TMMMeter;
    FOscope1       : TMMOscope;
    FOscope2       : TMMOscope;
    FLight1        : TMMLight;
    FLight2        : TMMLight;
    FSpectrum1     : TMMSpectrum;
    FSpectrum2     : TMMSpectrum;
    FSpectrum3     : TMMSpectrum;
    FSpectrum4     : TMMSpectrum;
    FSpectrogram1  : TMMSpectrogram;
    FSpectrogram2  : TMMSpectrogram;
    {$ENDIF}

    FIndexLevel        : Longint;
    {$IFNDEF LEVEL_ONLY}
    FIndexMeter        : Longint;
    FIndexScope        : Longint;
    FIndexLight        : Longint;
    FIndexSpectrum     : Longint;
    FIndexSpectrogram1 : Longint;
    FIndexSpectrogram2 : Longint;
    {$ENDIF}

    FRefreshLevel      : Boolean;
    {$IFNDEF LEVEL_ONLY}
    FRefreshMeter      : Boolean;
    FRefreshScope      : Boolean;
    FRefreshLight      : Boolean;
    FRefreshSpectrum   : Boolean;
    FRefreshSpectrogram: Boolean;
    {$ENDIF}

    FLevelRefresh      : Longint;
    {$IFNDEF LEVEL_ONLY}
    FMeterRefresh      : Longint;
    FOscopeRefresh     : Longint;
    FLightRefresh      : Longint;
    FSpectrumRefresh   : Longint;
    FSpectrogramRefresh: Longint;
    {$ENDIF}

    FBufTime           : Int64;
    FStepTime          : Int64;

    FOnTrigger         : TNotifyEvent;

    procedure SetEnabled(aValue: Boolean);
    procedure SetAutoTrigger(aValue: Boolean);
    procedure SetSpeed(aValue: integer);
    procedure SetTriggerMode(aValue: TMMTriggerMode);
    procedure SetTriggerLevel(aValue: integer);
    procedure SetRealTime(aValue: Boolean);
    procedure SetLevel(index: integer; aValue: TMMLevel);
    {$IFNDEF LEVEL_ONLY}
    procedure SetMeter(index: integer; aValue: TMMMeter);
    procedure SetOscope(index: integer; aValue: TMMOscope);
    procedure SetLight(index: integer; aValue: TMMLight);
    procedure SetSpectrum(index: integer; aValue: TMMSpectrum);
    procedure SetSpectrogram(index: integer; aValue: TMMSpectrogram);
    {$ENDIF}
    procedure SetEnterIdle(aValue: Boolean);
    function  GetEnterIdle: Boolean;
    procedure SetWaveParams;
    procedure ProcessData;
    procedure UpdateTimer(Enabled: Boolean);

  protected
    procedure ChangeDesigning(aValue: Boolean); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetPWaveFormat(aValue: PWaveFormatEx); override;

    procedure Started; override;
    procedure Paused; override;
    procedure Restarted; override;
    procedure Stopped; override;
    procedure Reseting; override;
    procedure BufferReady(lpwh: PWaveHdr); override;
    procedure BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean); override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure NewBuffer(lpData: PChar; dwLength: DWORD); virtual;

    property  IsPaused: Boolean read FPaused;
    property  IsStarted: Boolean read FStarted;
    
    procedure Trigger; virtual;

    property  RefreshCountLevel: Longint read FLevelRefresh write FLevelRefresh;
    {$IFNDEF LEVEL_ONLY}
    property  RefreshCountMeter: Longint read FMeterRefresh write FMeterRefresh;
    property  RefreshCountOscope: Longint read FOscopeRefresh write FOscopeRefresh;
    property  RefreshCountLight: Longint read FLightRefresh write FLightRefresh;
    property  RefreshCountSpectrum: Longint read FSpectrumRefresh write FSpectrumRefresh;
    property  RefreshCountSpectrogram: Longint read FSpectrogramRefresh write FSpectrogramRefresh;
    {$ENDIF}

    procedure GetPeak(var PeakL, PeakR: Smallint);

  published
    property OnTrigger: TNotifyEvent read FOnTrigger write FOnTrigger;

    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property AutoConvert: Boolean read FAutoConvert write FAutoConvert default True;
    property AutoTrigger: Boolean read FAutoTrigger write SetAutoTrigger default True;
    property Synchronize: Boolean read FSynchronize  write FSynchronize default True;
    property Speed: integer read FSpeed write SetSpeed default MAXSPEED;
    property TriggerMode: TMMTriggerMode read FTriggerMode write SetTriggerMode default tmNone;
    property TriggerLevel: integer read FTriggerLevel write SetTriggerLevel default 0;
    property RefreshOnStop: Boolean read FRefresh write FRefresh default True;
    property RealTime: Boolean read FRealTime write SetRealTime default True;
    property EnterIdle: Boolean read GetEnterIdle write SetEnterIdle;

    property Input;
    property Output;
    property Level1: TMMLevel index 0 read FLevel1 write SetLevel;
    property Level2: TMMLevel index 1 read FLevel2 write SetLevel;
    {$IFNDEF LEVEL_ONLY}
    property Meter1: TMMMeter index 0 read FMeter1 write SetMeter;
    property Meter2: TMMMeter index 1 read FMeter2 write SetMeter;
    property Oscope1: TMMOscope index 0 read FOscope1 write SetOscope;
    property Oscope2: TMMOscope index 1 read FOscope2 write SetOscope;
    property Light1: TMMLight index 0 read FLight1 write SetLight;
    property Light2: TMMLight index 1 read FLight2 write SetLight;
    property Spectrum1: TMMSpectrum index 0 read FSpectrum1 write SetSpectrum;
    property Spectrum2: TMMSpectrum index 1 read FSpectrum2 write SetSpectrum;
    property Spectrum3: TMMSpectrum index 2 read FSpectrum3 write SetSpectrum;
    property Spectrum4: TMMSpectrum index 3 read FSpectrum4 write SetSpectrum;
    property Spectrogram1: TMMSpectrogram index 0 read FSpectrogram1 write SetSpectrogram;
    property Spectrogram2: TMMSpectrogram index 1 read FSpectrogram2 write SetSpectrogram;
    {$ENDIF}
  end;

implementation

uses Consts;

type
  TIdleHandler = class
    procedure Idle(Sender: TObject; var Done: Boolean);
  end;

const
  CM_CON_START         = CM_BASE + 501;
  CM_CON_TRIGGER       = CM_BASE + 502;
  CM_CON_AUTOTRIGGER   = CM_BASE + 503;

const
  ConnectorWindow: HWND    = 0;
  ConnectorCount : Longint = 0;
  ConnectorList  : TList   = nil;
  LoopStarted    : integer = 0;
  LoopSpeed      : integer = 0;
  RestoreIdle    : Boolean = False;
  IdleHandler    : TIdleHandler = nil;

{-------------------------------------------------------------------------}
procedure DebugStr(s: String);
begin
{$IFDEF _MMDEBUG}
   if (s <> ' ') then s := 'Trigger: '+s;
   DB_WriteStrLn(0,s);
{$ENDIF}
end;

{-- TIdleHandler --------------------------------------------------------}
procedure TIdleHandler.Idle(Sender: TObject; var Done: Boolean);
begin
   Done := False;
end;

{------------------------------------------------------------------------}
procedure ProcessConnectors;
var
   i: integer;

begin
   { let windows have some time }
   for i := 0 to MAXSPEED-LoopSpeed do Application.ProcessMessages;

   { now go trough all connectors in the list }
   if (LoopStarted > 0) and (not Application.Terminated) and
      (ConnectorList.Count > 0) then
   begin
      for i := 0 to ConnectorList.Count-1 do
      with TMMConnector(ConnectorList.Items[i]) do
      begin
         if FAutoTrigger and FEnabled and FRunning then ProcessData;
      end;
   end;
end;

{------------------------------------------------------------------------}
function ConnectorWndProc(Window: HWND; Message, wParam: UINT; lParam: Longint): Longint;
export;{$IFDEF WIN32}stdcall;{$ENDIF}

begin
   if (ConnectorList <> nil) then
   try
      case Message of
        CM_CON_START:
        if (lParam <> 0) then
        with TMMConnector(lParam) do
        begin
           if FStarted then
           begin
              FInHandler := 0;
              FRunning := True;
              if FAutoTrigger then
              begin
                 inc(LoopStarted);
                 PostMessage(ConnectorWindow,CM_CON_AUTOTRIGGER,0,0);
              end;
           end;
           exit;
        end;
        CM_CON_TRIGGER:
        if (lParam <> 0) then
        with TMMConnector(lParam) do
        begin
           if FEnabled and FRunning then
           begin
              { process the controls }
              ProcessData;
              {$IFDEF WIN32}
              InterlockedDecrement(FInHandler);
              {$ENDIF}
           end;
           exit;
        end;
        CM_CON_AUTOTRIGGER:
        begin
           { go trough all connectors }
           ProcessConnectors;
           { decide if we need a new loop }
           if (LoopStarted > 0) and (not Application.Terminated) and
              (ConnectorList.Count > 0) then
           begin
              {$IFDEF WIN32}
              Sleep(1);
              {$ENDIF}

              { give the app a chance }
              if ENTER_IDLE_MODE then
                 Application.HandleMessage;

              PostMessage(ConnectorWindow,CM_CON_AUTOTRIGGER,0,0);
           end;
           exit;
        end;
      end;

   except
      Application.HandleException(nil);
   end;
   Result := DefWindowProc(Window, Message, wParam, lParam);
end;

{------------------------------------------------------------------------}
const
  TMMConnectorWindowClass: TWndClass = (
       style: 0;
       lpfnWndProc: @ConnectorWndProc;
       cbClsExtra: 0;
       cbWndExtra: 0;
       hInstance: 0;
       hIcon: 0;
       hCursor: 0;
       hbrBackground: 0;
       lpszMenuName: nil;
       lpszClassName: 'TMMConnectorWindow');

{------------------------------------------------------------------------}
function AllocateConnectorWindow: HWND;
var
   TempClass: TWndClass;
   ClassRegistered: Boolean;
begin
   TMMConnectorWindowClass.hInstance := HInstance;
   ClassRegistered := GetClassInfo(HInstance,
                      TMMConnectorWindowClass.lpszClassName, TempClass);
    if not ClassRegistered or (TempClass.lpfnWndProc <> @ConnectorWndProc) then
    begin
       {$IFDEF WIN32}
       if ClassRegistered then
          Windows.UnregisterClass(TMMConnectorWindowClass.lpszClassName, HInstance);
       Windows.RegisterClass(TMMConnectorWindowClass);
       {$ELSE}
       if ClassRegistered then
          WinProcs.UnregisterClass(TMMConnectorWindowClass.lpszClassName, HInstance);
       WinProcs.RegisterClass(TMMConnectorWindowClass);
       {$ENDIF}
    end;
    Result := CreateWindow(TMMConnectorWindowClass.lpszClassName, '', 0,
                           0, 0, 0, 0, 0, 0, HInstance, nil);
end;

{------------------------------------------------------------------------}
procedure UpdateSpeed(Connector: TMMConnector);
var
   i: integer;

begin
   LoopSpeed := 0;