mmwmixer.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: 17.09.98 - 22:21:52 $                                        =}
{========================================================================}
unit MMWMixer;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    SysUtils,
    Messages,
    Classes,
    Controls,
    MMSystem,
    MMObj,
    MMDSPObj,
    MMUtils,
    MMString,
    MMRegs,
    MMPCMSup,
    MMACMSup,
    MMWaveIO;

const
  {$IFDEF CBUILDER3} {$EXTERNALSYM MAXTRACKS} {$ENDIF}
  MAXTRACKS = 4;

type
  EMMWaveMixerError = class(Exception);

  PBufferItem       = ^TBufferItem;
  TBufferItem       = packed record
      lpData        : PChar;           { buffer to load data             }
      dwBufferLength: Longint;         { the buffer length               }
      dwBytesLoaded : Longint;         { how much is loaded ?            }
  end;

  PBufferPool       = ^TBufferPool;
  TBufferPool       = array[0..0] of PBufferItem;

  PMMMixerTrack     = ^TMMMixerTrack;
  TMMMixerTrack     = packed record
        InPort        : TMMDSPComponent;
        StartPosition : int64;          { start position for this port    }
        StartSamplePos: int64;          { start position in samples       }
        CurPosition   : int64;          { current playback position       }
        Loop          : Boolean;        { loop the input                  }
        LoopCount     : Word;           { number of loops  (0 = infinite) }
        LoopTempCount : integer;        { temp loop counter for playing   }
        Done          : Boolean;        { nomore to read                  }
        Loading       : Boolean;        { do we reading from port ?       }
        bMustConvert  : Boolean;        { the format must be converted    }
        bCanConvert   : Boolean;        { the format can be converted     }
        lpACMConvert  : PACMConvert;    { structure for conversion        }
  end;

  TMMWaveMixerTracks = array[0..MAXTRACKS-1] of TMMMixerTrack;

  TMMMixerNotifyEvent= procedure(Sender: TObject; index: integer) of object;

  {-- TMMWaveMixer ------------------------------------------------------}
  TMMWaveMixer = class(TMMDSPComponent)
  private
    FTracks      : TMMWaveMixerTracks;
    FEnabled     : Boolean;
    FSampleRate  : Longint;       { samplerate 8000..88200               }
    FTimeFormat  : TMMTimeFormats;{ the actual time format for Positions }
    FWaveFormat  : TWaveFormatEx; { internal WaveFormatEx                }
    FBufferPool  : PBufferPool;
    FMixPool     : PMMMixPool;
    FTempBuffer  : PLongint;
    FRealBufSize : Longint;
    FOpen        : Boolean;
    FStarted     : Boolean;
    FUsedTracks  : integer;
    FLocator     : int64;         { current mix/load position            }
    FBPS         : integer;       { bytes per sample for the format      }
    FMaxPlayTime : int64;         { maximal playback time                }
    FOverflow    : Boolean;       { overflow detected                    }
    FVolume      : Longint; { 0 = silence, 16384 = 0 dB, 32768 = +6dB    }
    FPanning     : Longint; { L <-  -16384..0..16384  -> R               }
    FLeftVolume  : Longint;
    FRightVolume : Longint;
    DataSection  : TRtlCriticalSection;{ CriticalSection Object          }
    DataSectionOK: Boolean;        { CriticalSection is prepared         }
    Ftwh         : TMMWaveHdr;

    FOnOpenPort  : TMMMixerNotifyEvent;
    FOnClosePort : TMMMixerNotifyEvent;

    procedure InitCritical;
    procedure EnterCritical;
    procedure LeaveCritical;
    procedure DoneCritical;

    procedure SetVolumeValues(index: integer; aValue: Longint);
    procedure SetMaxPlayTime(aValue: int64);
    function  GetMaxPlayTime: int64;
    procedure SetTimeFormat(aValue: TMMTimeFormats);
    procedure SetInputs(index: integer; aValue: TMMDSPComponent);
    function  GetInputs(index: integer): TMMDSPComponent;
    function  GetTracks(index: integer): PMMMixerTrack;
    procedure SetStartPos(index: integer; aValue: int64);
    function  GetStartPos(index: integer): int64;
    procedure SetLoops(index: integer; aValue: Boolean);
    function  GetLoops(index: integer): Boolean;
    procedure SetLoopCounts(index: integer; aValue: integer);
    function  GetLoopCounts(index: integer): integer;
    procedure SetInputDone(index: integer; aValue: Boolean);
    function  GetInputDone(index: integer): Boolean;
    function  GetInputLoading(index: integer): Boolean;
    function  GetInputPosition(index: integer): int64;
    function  GetMixPosition: int64;
    procedure SetSampleRate(Rate: Longint);
    procedure SetWaveParams;

    function  AllocBuffer(Size: Longint): PBufferItem;
    procedure CreateBuffers;
    procedure FreeBuffers;
    procedure CloseAllTracks;

    procedure FillBuffers(dwSamples: Longint);
    procedure MixBuffers(lpBuffer: PChar; dwLength: Longint);

    procedure OpenPort(aPort: TMMDSPComponent);
    procedure ClosePort(aPort: TMMDSPComponent);
    procedure OpenInput(idx: integer);
    procedure CloseInput(idx: integer);
    function  ReadFromInput(idx: integer; Buffer: PChar; nBytes: Longint): Longint;
    function  IsInputDone(idx: integer): Boolean;

  protected
    function  TimeFormatToSamples(aValue: int64): int64; virtual;
    function  SamplesToTimeFormat(aValue: int64): int64; virtual;
    procedure ChangePWaveFormat(aValue: PWaveFormatEx); override;
    procedure SetPWaveFormat(aValue: PWaveFormatEx); override;
    procedure Opened; override;
    procedure Closed; override;
    procedure Started; override;
    procedure Stopped; override;
    procedure Reseting; override;
    procedure BufferReady(lpwh: PWaveHdr); override;
    procedure BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean); override;
    procedure DeconnectNotification(C: TComponent; Port: TMMPort; PortName: string); override;
    function  CanConnectOutput(aComponent: TComponent): Boolean; override;

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

    function CanConnectInput1(aComponent: TComponent): Boolean; virtual;
    function CanConnectInput2(aComponent: TComponent): Boolean; virtual;
    function CanConnectInput3(aComponent: TComponent): Boolean; virtual;
    function CanConnectInput4(aComponent: TComponent): Boolean; virtual;

    procedure Open;
    procedure Close;
    procedure Reset;

    { you should not need this !!! }
    property  Tracks[index: integer]: PMMMixerTrack read GetTracks;
    property  Inputs[index: integer]: TMMDSPComponent read GetInputs;

    property  InputDone[index: integer]: Boolean read GetInputDone write SetInputDone;
    property  InputLoading[index: integer]: Boolean read GetInputLoading;
    property  InputPosition[index: integer]: int64 read GetInputPosition;

    property  Overflow: Boolean read FOverflow write FOverflow;
    property  MixPosition: int64 read GetMixPosition;

    property StartPos1: int64 index 0 read GetStartPos write SetStartPos;
    property StartPos2: int64 index 1 read GetStartPos write SetStartPos;
    property StartPos3: int64 index 2 read GetStartPos write SetStartPos;
    property StartPos4: int64 index 3 read GetStartPos write SetStartPos;
    property MaxPlayTime: int64 read GetMaxPlayTime write SetMaxPlayTime;

  published
    property OnOpenPort : TMMMixerNotifyEvent read FOnOpenPort write FOnOpenPort;
    property OnClosePort: TMMMixerNotifyEvent read FOnClosePort write FOnClosePort;

    property TimeFormat: TMMTimeFormats read FTimeFormat write SetTimeFormat default tfMillisecond;

    property Output;
    property Input1: TMMDSPComponent index 0 read GetInputs write SetInputs;
    property Input2: TMMDSPComponent index 1 read GetInputs write SetInputs;
    property Input3: TMMDSPComponent index 2 read GetInputs write SetInputs;
    property Input4: TMMDSPComponent index 3 read GetInputs write SetInputs;

    property Loop1: Boolean index 0 read GetLoops write SetLoops;
    property Loop2: Boolean index 1 read GetLoops write SetLoops;
    property Loop3: Boolean index 2 read GetLoops write SetLoops;
    property Loop4: Boolean index 3 read GetLoops write SetLoops;

    property LoopCount1: integer index 0 read GetLoopCounts write SetLoopCounts;
    property LoopCount2: integer index 1 read GetLoopCounts write SetLoopCounts;
    property LoopCount3: integer index 2 read GetLoopCounts write SetLoopCounts;
    property LoopCount4: integer index 3 read GetLoopCounts write SetLoopCounts;

    property Enabled: Boolean read FEnabled write FEnabled default True;
    property SampleRate: Longint read FSampleRate write SetSampleRate default 44100;
    property Volume: Longint index 0 read FVolume write SetVolumeValues default VOLUMEBASE;
    property Panning: Longint index 1 read FPanning write SetVolumeValues default 0;
  end;

implementation

uses TypInfo;

const
     ACM_CONVERT_SIZE = 8192;
     {$IFDEF DELPHI4}
     MIX_MAX_INT64    = High(Int64) div 10;
    {$ELSE}
     MIX_MAX_INT64    = 922337203685477580.0;
    {$ENDIF}

{== TMMWaveMixer ==============================================================}
constructor TMMWaveMixer.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);

   FillChar(FTracks,sizeOf(FTracks),0);

   FEnabled      := True;
   FSampleRate   := 44100;
   FTimeFormat   := tfMillisecond;
   FBufferPool   := nil;
   FMixPool      := nil;
   FTempBuffer   := nil;
   FOpen         := False;
   FStarted      := False;
   FUsedTracks   := 0;
   FOverflow     := False;
   FMaxPlayTime  := MIX_MAX_INT64;
   FLeftVolume   := VOLUMEBASE;
   FRightVolume  := VOLUMEBASE;
   FVolume       := VOLUMEBASE;
   FPanning      := 0;
   DataSectionOK := False;
   SetWaveParams;

   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;

{-- TMMWaveMixer --------------------------------------------------------------}
destructor TMMWaveMixer.Destroy;
begin
   Close;

   Input1 := nil;
   Input2 := nil;
   Input3 := nil;
   Input4 := nil;

   inherited Destroy;
end;

{-- TMMWaveMixer --------------------------------------------------------------}
procedure TMMWaveMixer.InitCritical;
begin
   { create critical section object }
   FillChar(DataSection, SizeOf(DataSection), 0);
   InitializeCriticalSection(DataSection);
   DataSectionOK := True;
end;

{-- TMMWaveMixer --------------------------------------------------------------}
procedure TMMWaveMixer.EnterCritical;
begin
   if DataSectionOK then
      EnterCriticalSection(DataSection);
end;

{-- TMMWaveMixer --------------------------------------------------------------}
procedure TMMWaveMixer.LeaveCritical;
begin
   if DataSectionOK then
      LeaveCriticalSection(DataSection);
end;

{-- TMMWaveMixer --------------------------------------------------------------}
procedure TMMWaveMixer.DoneCritical;
begin
   if DataSectionOK then
   begin
      DataSectionOK := False;
      DeleteCriticalSection(DataSection);
   end;
end;

{-- TMMWaveMixer --------------------------------------------------------------}
procedure TMMWaveMixer.ChangePWaveFormat(aValue: PWaveFormatEx);
begin
   // do nothing here, we don't use the WaveFormat from the left side
end;

{-- TMMWaveMixer --------------------------------------------------------------}
Procedure TMMWaveMixer.SetPWaveFormat(aValue: PWaveFormatEx);
begin
   if (aValue <> nil) then
   begin
      if not (csDesigning in ComponentState) then
         if not pcmIsValidFormat(aValue) then
            raise EMMWaveMixerError.Create(LoadResStr(IDS_INVALIDFORMAT));

      SampleRate := aValue^.nSamplesPerSec;
   end;

   inherited SetPWaveFormat(aValue);

   if (PWaveFormat <> nil) then
       FBPS := wioBytesPerSample(PWaveFormat);
end;

{-- TMMWaveMixer --------------------------------------------------------------}
procedure TMMWaveMixer.SetWaveParams;
begin
   pcmBuildWaveHeader(@FWaveFormat,16,2,FSampleRate);
   PWaveFormat := @FWaveFormat;
end;

{-- TMMWaveMixer --------------------------------------------------------------}
Procedure TMMWaveMixer.SetSampleRate(Rate: Longint);
begin
     if (Rate <> SampleRate) then
     begin
        FSampleRate := MinMax(Rate,8000,100000);
        SetWaveParams;
     end;
end;

{-- TMMWaveMixer --------------------------------------------------------------}
procedure TMMWaveMixer.DeconnectNotification(C: TComponent; Port: TMMPort; PortName: string);
var
   PropInfo: PPropInfo;
   i: integer;
begin
   if (Port = poOutput) then
   begin
      for i := 0 to MAXTRACKS-1 do
      if (FTracks[i].InPort = C) and (FInpPropName = PortName) then
      begin
         PropInfo := GetPropInfo(C.ClassInfo, FInpPropName);
         if (PropInfo <> nil) and (GetOrdProp(C,PropInfo) = Longint(Self)) then
         begin
            CloseInput(i);
            FTracks[i].InPort := nil;
         end;
      end;
   end;

   inherited DeconnectNotification(C,Port,PortName);
end;

{-- TMMWaveMixer --------------------------------------------------------------}
function TMMWaveMixer.CanConnectOutput(aComponent: TComponent): Boolean;
var
   i: integer;
begin
   Result := False;
   if (aComponent <> Self) and (aComponent is TMMDSPComponent) and
      (GetPropInfo(TMMDSPComponent(aComponent).ClassInfo, 'Input') <> nil) then
   begin
      Result := True;

      { don't allow ring connection }
      i := 0;
      while i < MAXTRACKS do
      begin
         if (FTracks[i].InPort <> nil) and not FTracks[i].InPort.CanConnectOutput(aComponent) then
         begin
            Result := False;
            exit;
         end;
         inc(i);
      end;
   end;
end;

{-- TMMWaveMixer --------------------------------------------------------------}
function TMMWaveMixer.CanConnectInput1(aComponent: TComponent): Boolean;
begin
   Result := False;
   if (aComponent <> Self) and (aComponent is TMMDSPComponent) and
      (aComponent <> Input2) and (aComponent <> Input3) and (aComponent <> Input4) and
      (GetPropInfo(TMMDSPComponent(aComponent).ClassInfo, 'Output') <> nil) then
   begin
      { don't allow ring connection }
      if (Output <> nil) then
          Result := Output.CanConnectInput(aComponent)
      else
          Result := True;
   end;
end;

{-- TMMWaveMixer --------------------------------------------------------------}
function TMMWaveMixer.CanConnectInput2(aComponent: TComponent): Boolean;
begin
   Result := False;
   if (aComponent <> Self) and (aComponent is TMMDSPComponent) and
      (aComponent <> Input1) and (aComponent <> Input3) and (aComponent <> Input4) and
      (GetPropInfo(TMMDSPComponent(aComponent).ClassInfo, 'Output') <> nil) then
   begin