Delphi控件源码

开发平台：
Delphi

MMSplitt.pas：源码内容
							{========================================================================}
{=                (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/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 MMSplitt;
{$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 MAXPORTS} {$ENDIF}
  MAXPORTS = 4;
type
  EMMSplitterError  = class(Exception);
  {-- TMMOutputSplitter -------------------------------------------------------}
  TMMOutputSplitter = class(TMMDSPComponent)
  private
    FPorts      : array[0..MAXPORTS-1] of TMMDSPComponent;
    FTempBuffer : PChar;
    procedure SetOutputs(index: integer; aValue: TMMDSPComponent);
    function  GetOutputs(index: integer): TMMDSPComponent;
  protected
    procedure UpdateParams; override;
    procedure SetPWaveFormat(aValue: PWaveFormatEx); override;
    procedure Opened; override;
    procedure Closed; override;
    procedure Started; override;
    procedure Paused; override;
    procedure Restarted; override;
    procedure Stopped; override;
    procedure Reseting; override;
    procedure Looped; override;
    procedure BufferReady(lpwh: PWaveHdr); override;
    procedure BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean); override;
    procedure DeconnectNotification(C: TComponent; Port: TMMPort; PortName: string); override;
    function  CanConnectInput(aComponent: TComponent): Boolean; override;
  public
    constructor Create(AOwner:TComponent); override;
    destructor  Destroy; override;
    function CanConnectOutput1(aComponent: TComponent): Boolean; virtual;
    function CanConnectOutput2(aComponent: TComponent): Boolean; virtual;
    function CanConnectOutput3(aComponent: TComponent): Boolean; virtual;
    function CanConnectOutput4(aComponent: TComponent): Boolean; virtual;
  published
    property Input;
    property Output1: TMMDSPComponent index 0 read GetOutputs write SetOutputs;
    property Output2: TMMDSPComponent index 1 read GetOutputs write SetOutputs;
    property Output3: TMMDSPComponent index 2 read GetOutputs write SetOutputs;
    property Output4: TMMDSPComponent index 3 read GetOutputs write SetOutputs;
  end;
implementation
uses TypInfo;
{== TMMOutputSplitter =========================================================}
constructor TMMOutputSplitter.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   FillChar(FPorts,sizeOf(FPorts),0);
   FTempBuffer := nil;
   ErrorCode := ComponentRegistered(InitCode, Self, ClassName);
   if (ErrorCode <> 0) then RegisterFailed(InitCode, Self , ClassName);
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
destructor TMMOutputSplitter.Destroy;
begin
   Output1 := nil;
   Output2 := nil;
   Output3 := nil;
   Output4 := nil;
   inherited Destroy;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
procedure TMMOutputSplitter.UpdateParams;
var
   i: integer;
begin
   inherited UpdateParams;
   if (csLoading in ComponentState) or
      (csReading in ComponentState) or
      (csDestroying in ComponentState) then exit;
   for i := 0 to MAXPORTS-1 do
   begin
      if (FPorts[i] <> nil) then
          FPorts[i].ChangePWaveFormat(PWaveFormat);
   end;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
Procedure TMMOutputSplitter.SetPWaveFormat(aValue: PWaveFormatEx);
var
   i: integer;
begin
   inherited SetPWaveFormat(aValue);
   if not (csLoading in ComponentState) and
      not (csReading in ComponentState) and
      not (csDestroying in ComponentState) then
   begin
      for i := 0 to MAXPORTS-1 do
          if (FPorts[i] <> nil) then
              FPorts[i].ChangePWaveFormat(PWaveFormat);
   end;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
procedure TMMOutputSplitter.DeconnectNotification(C: TComponent; Port: TMMPort; PortName: string);
var
   PropInfo: PPropInfo;
   i: integer;
begin
   if (Port = poInput) then
   begin
      for i := 0 to MAXPORTS-1 do
      if (FPorts[i] = C) and (FOutPropName = PortName) then
      begin
         PropInfo := GetPropInfo(C.ClassInfo, FOutPropName);
         if (PropInfo <> nil) and (GetOrdProp(C,PropInfo) = Longint(Self)) then
         begin
            FPorts[i] := nil;
         end;
      end;
   end;
   inherited DeconnectNotification(C,Port,PortName);
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
function TMMOutputSplitter.CanConnectInput(aComponent: TComponent): Boolean;
var
   i: integer;
begin
   Result := False;
   if (aComponent <> Self) and (aComponent is TMMDSPComponent) and
      (GetPropInfo(TMMDSPComponent(aComponent).ClassInfo, 'Output') <> nil) then
   begin
      Result := True;
      { don't allow ring connection }
      i := 0;
      while i < MAXPORTS do
      begin
         if (FPorts[i] <> nil) and not FPorts[i].CanConnectInput(aComponent) then
         begin
            Result := False;
            exit;
         end;
         inc(i);
      end;
   end;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
function TMMOutputSplitter.CanConnectOutput1(aComponent: TComponent): Boolean;
begin
   Result := False;
   if (aComponent <> Self) and (aComponent is TMMDSPComponent) and
      (aComponent <> Output2) and (aComponent <> Output3) and (aComponent <> Output4) and
      (GetPropInfo(TMMDSPComponent(aComponent).ClassInfo, 'Input') <> nil) then
   begin
      { don't allow ring connection }
      if (Input <> nil) then
          Result := Input.CanConnectOutput(aComponent)
      else
          Result := True;
   end;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
function TMMOutputSplitter.CanConnectOutput2(aComponent: TComponent): Boolean;
begin
   Result := False;
   if (aComponent <> Self) and (aComponent is TMMDSPComponent) and
      (aComponent <> Output1) and (aComponent <> Output3) and (aComponent <> Output4) and
      (GetPropInfo(TMMDSPComponent(aComponent).ClassInfo, 'Input') <> nil) then
   begin
      { don't allow ring connection }
      if (Input <> nil) then
          Result := Input.CanConnectOutput(aComponent)
      else
          Result := True;
   end;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
function TMMOutputSplitter.CanConnectOutput3(aComponent: TComponent): Boolean;
begin
   Result := False;
   if (aComponent <> Self) and (aComponent is TMMDSPComponent) and
      (aComponent <> Output1) and (aComponent <> Output2) and (aComponent <> Output4) and
      (GetPropInfo(TMMDSPComponent(aComponent).ClassInfo, 'Input') <> nil) then
   begin
      { don't allow ring connection }
      if (Input <> nil) then
          Result := Input.CanConnectOutput(aComponent)
      else
          Result := True;
   end;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
function TMMOutputSplitter.CanConnectOutput4(aComponent: TComponent): Boolean;
begin
   Result := False;
   if (aComponent <> Self) and (aComponent is TMMDSPComponent) and
      (aComponent <> Output1) and (aComponent <> Output2) and (aComponent <> Output3) and
      (GetPropInfo(TMMDSPComponent(aComponent).ClassInfo, 'Input') <> nil) then
   begin
      { don't allow ring connection }
      if (Input <> nil) then
          Result := Input.CanConnectOutput(aComponent)
      else
          Result := True;
   end;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
procedure TMMOutputSplitter.SetOutputs(index: integer; aValue: TMMDSPComponent);
   procedure SetPort(idx: integer; PortName: string; C: TMMDSPComponent);
   type
      TCheckProc = function(aComponent: TComponent): Boolean of object;
   var
      CheckProc: TCheckProc;
   begin
      case index of
          0: CheckProc := CanConnectOutput1;
          1: CheckProc := CanConnectOutput2;
          2: CheckProc := CanConnectOutput3;
          3: CheckProc := CanConnectOutput4;
      end;
      if (C <> FPorts[idx]) and ((C = nil) or CheckProc(C)) then
      begin
         if (FPorts[idx] <> nil) then
         begin
            GlobalDeconnectNotification(Self,poOutput,PortName);
            FPorts[idx].ChangePWaveFormat(nil);
            FPorts[idx]  := nil;
            FOutPropName := '';
         end;
         if (C <> nil) then
         begin
            GlobalDeconnectNotification(C,poInput,'Input');
            FPorts[idx]  := C;
            FOutPropName := 'Input';
            FPorts[idx].SetInputPort(Self,PortName);
            UpdateParams;
         end;
      end;
   end;
begin
   SetPort(index,'Output'+IntToStr(index+1),aValue);
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
function TMMOutputSplitter.GetOutputs(index: integer): TMMDSPComponent;
begin
   Result := FPorts[index];
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
procedure TMMOutputSplitter.Opened;
var
   i: integer;
   Current: TMMDSPComponent;
begin
   if not IsOpen then
   begin
      FTempBuffer := GlobalAllocMem(Max(QUEUE_WRITE_SIZE,BufferSize));
      for i := 0 to MAXPORTS-1 do
      begin
         if (FPorts[i] <> nil) then
         begin
            Current := FPorts[i];
            { go trough all components and notify }
            repeat
               if not (Current is TMMCustomSoundComponent) then
               begin
                  Current.BufferSize := BufferSize;
                  Current.Opened;
               end
               else if (Current <> Self) then
               begin       { there is another sound component on the right side }
                  Current.BufferSize := BufferSize;
                  Current.Opened;
                  break;
               end;
               Current := Current.Output;
            until (Current = nil);
         end;
      end;
      inherited Opened;
   end;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
procedure TMMOutputSplitter.Closed;
var
   i: integer;
   Current: TMMDSPComponent;
begin
   if IsOpen then
   begin
      for i := 0 to MAXPORTS-1 do
      begin
         if (FPorts[i] <> nil) then
         begin
            Current := FPorts[i];
            { search the last component }
            while (Current.Output <> nil) do
            begin
               Current := Current.Output;
               if (Current is TMMCustomSoundComponent) and (Current <> Self) then
               begin
                  { there is another sound component on the right side }
                  Current.Closed;
                  break;
               end;
            end;
            Current := FPorts[i];
            { go trough all components and notify }
            repeat
               if not (Current is TMMCustomSoundComponent) then
               begin
                  Current.Closed;
               end
               else if (Current <> Self) then
               begin
                  { there is another sound component on the right side }
                  break;
               end;
               Current := Current.Output;
            until (Current = nil);
         end;
      end;
      GlobalFreeMem(Pointer(FTempBuffer));
      inherited Closed;
   end;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
procedure TMMOutputSplitter.Started;
var
   i: integer;
   Current: TMMDSPComponent;
begin
   if IsOpen and not IsStarted then
   begin
      for i := 0 to MAXPORTS-1 do
      begin
         if (FPorts[i] <> nil) then
         begin
            Current := FPorts[i];
            { go trough all components and notify }
            repeat
               if not (Current is TMMCustomSoundComponent) then
               begin
                  Current.Started;
               end
               else if (Current <> Self) then
               begin
                  Current.Started;
                  break;   { there is another sound component on the right side }
               end;
               Current := Current.Output;
            until (Current = nil);
         end;
      end;
      inherited Started;
   end;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
procedure TMMOutputSplitter.Stopped;
var
   i: integer;
   Current: TMMDSPComponent;
begin
   if IsStarted then
   begin
      for i := 0 to MAXPORTS-1 do
      begin
         if (FPorts[i] <> nil) then
         begin
            Current := FPorts[i];
            { search the last component }
            while (Current.Output <> nil) do
            begin
               Current := Current.Output;
               if (Current is TMMCustomSoundComponent) and (Current <> Self) then
               begin
                  { there is another sound component on the right side }
                  Current.Stopped;
                  break;
               end;
            end;
            Current := FPorts[i];
            { now go trough all components and notify }
            repeat
               if not (Current is TMMCustomSoundComponent) then
               begin
                  Current.Stopped;
               end
               else if (Current <> Self) then
               begin
                  { there is another sound component on the right side }
                  break;
               end;
               Current := Current.Output;
            until (Current = nil);
         end;
      end;
      inherited Stopped;
   end;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
procedure TMMOutputSplitter.Paused;
var
   i: integer;
   Current: TMMDSPComponent;
begin
   if IsOpen and not IsPaused then
   begin
      for i := 0 to MAXPORTS-1 do
      begin
         if (FPorts[i] <> nil) then
         begin
           Current := FPorts[i];
           { go trough all components and notify }
           repeat
              if not (Current is TMMCustomSoundComponent) then
              begin
                 Current.Paused;
              end
              else if (Current <> Self) then
              begin
                 Current.Paused;
                 break;   { there is another sound component on the right side }
              end;
              Current := Current.Output;
           until (Current = nil);
         end;
      end;
      inherited Paused;
   end;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
procedure TMMOutputSplitter.Restarted;
var
   i: integer;
   Current: TMMDSPComponent;
begin
   if IsPaused then
   begin
      for i := 0 to MAXPORTS-1 do
      begin
         if (FPorts[i] <> nil) then
         begin
            Current := FPorts[i];
            { go trough all components and notify }
            repeat
               if not (Current is TMMCustomSoundComponent) then
               begin
                  Current.Restarted;
               end
               else if (Current <> Self) then
               begin
                  Current.Restarted;
                  break;   { there is another sound component on the right side }
               end;
               Current := Current.Output;
            until (Current = nil);
         end;
      end;
      inherited Paused;
   end;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
procedure TMMOutputSplitter.Reseting;
var
   i: integer;
   Current: TMMDSPComponent;
begin
   for i := 0 to MAXPORTS-1 do
   begin
      if (FPorts[i] <> nil) then
      begin
         Current := FPorts[i];
         { go trough all components and notify }
         repeat
            if not (Current is TMMCustomSoundComponent) then
            begin
               Current.Reseting;
            end
            else if (Current <> Self) then
            begin
               Current.Reseting;
               break;   { there is another sound component on the right side }
            end;
            Current := Current.Output;
         until (Current = nil);
      end;
   end;
   inherited Reseting;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
procedure TMMOutputSplitter.Looped;
var
   i: integer;
   Current: TMMDSPComponent;
begin
   for i := 0 to MAXPORTS-1 do
   begin
      if (FPorts[i] <> nil) then
      begin
         Current := FPorts[i];
         { go trough all components and notify }
         repeat
            if not (Current is TMMCustomSoundComponent) then
            begin
               Current.Looped;
            end
            else if (Current <> Self) then
            begin
               Current.Looped;
               break;   { there is another sound component on the right side }
            end;
            Current := Current.Output;
         until (Current = nil);
      end;
   end;
   inherited Looped;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
procedure TMMOutputSplitter.BufferReady(lpwh: PWaveHdr);
var
   i: integer;
   Current: TMMDSPComponent;
   lpdata: PChar;
begin
   inherited BufferReady(lpwh);
   lpData := lpwh.lpData;
   lpwh.lpData := FTempBuffer;
   for i := 0 to MAXPORTS-1 do
   begin
      if (FPorts[i] <> nil) then
      begin
         // we need to make a copy of the data because some filters might change the buffer data
         GlobalMoveMem(lpData^,lpwh.lpData^,lpwh.dwBytesRecorded);
         FPorts[i].BufferReady(lpwh);
      end;
   end;
   lpwh.lpData := lpData;
end;
{-- TMMOutputSplitter ---------------------------------------------------------}
procedure TMMOutputSplitter.BufferLoad(lpwh: PWaveHdr; var MoreBuffers: Boolean);
begin
   raise EMMSplitterError.Create('You can not load data from a splitter !');
end;
end.

						