mmdsmidi.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: 27.01.98 - 19:11:03 $                                        =}
{========================================================================}
unit MMDSMidi;

{$I COMPILER.INC}

interface

uses
    Windows,
    SysUtils,
    Classes,
    Forms,
    ExtCtrls,
    Dialogs,
    MMObj,
    ActiveX,
    ComObj,
    MMSystem,
    MMDMusic,
    MMUtils,
    MMMulDiv,
    MMPCMSup,
    MMDSound,
    MMDSMix,
    MM3D;

type
    EMMDSMidiChannelError = class(Exception);

    {--------------------------------------------------------------------------}
    TMMDSMidiChannel = class(TMMNonVisualComponent)
    private
       FFileName     : string;
       FOpen         : Boolean;
       FPlaying      : Boolean;

       FSoundBuffer  : TMMDSSoundBuffer;
       F3DBuffer     : TMMDS3DBuffer;
       FMixer        : TMMDSWaveMixer;
       FWaveFormat   : TWaveFormatEx;
       FBufferLength : DWORD;

       FIMusic       : IDirectMusic;
       FIPort        : IDirectMusicPort;
       FIPerf        : IDirectMusicPerformance;
       FILoader      : IDirectMusicLoader;
       FIMIDIseg     : IDirectMusicSegment;
       FIMIDISegState: IDirectMusicSegmentState;

       FmtStart      : TMUSIC_TIME;
       FmtOffset     : TMUSIC_TIME;
       FrtStart      : TREFERENCE_TIME;
       FrtOffset     : TREFERENCE_TIME;

       FLoops        : Longint;
       FTimer        : TTimer;
       FOnPlayEnd    : TNotifyEvent;

       procedure SetFileName(aValue: string);
       procedure DoTimer(Sender: TObject);
       function  GetDirectSound: IDirectSound;
       procedure SetMuted(aValue: Boolean);
       function  GetMuted: Boolean;
       procedure SetVolume(aValue: Longint);
       function  GetVolume: Longint;
       procedure SetPanning(aValue: Longint);
       function  GetPanning: Longint;
       procedure Set3DBuffer(Value: TMMDS3DBuffer);

    protected
       procedure Loaded; override;
       procedure Notification(AComponent: TComponent; Operation: TOperation); override;

       property DirectSound: IDirectSound read GetDirectSound;

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

       procedure GetVUMeter(var LeftValue, RightValue, BothValue: integer; Interval: integer);

       function  Open: Boolean;
       function  Play: Boolean;
       procedure Stop;
       procedure Close;

       property IsOpen: Boolean read FOpen;
       property IsPlaying: Boolean read FPlaying;

    published
       property OnPlayEnd: TNotifyEvent read FOnPlayEnd write FOnPlayEnd;

       property Mixer: TMMDSWaveMixer read FMixer write FMixer;
       property FileName: string read FFileName write SetFileName;
       property Loops: Longint read FLoops write FLoops default 0;
       property Muted: Boolean read GetMuted write SetMuted default False;
       property Volume: Longint read GetVolume write SetVolume default 0;
       property Panning: Longint read GetPanning write SetPanning default 0;
       property Sound3D: TMMDS3DBuffer read F3DBuffer write Set3DBuffer;
    end;

implementation

{------------------------------------------------------------------------------}
function CreateDirectMusic(DirectSound: IDirectSound): IDirectMusic;
var
   pMusic: IDirectMusic;
   Res: integer;
begin
   CoInitialize(nil);

   Res := CoCreateInstance(CLSID_DirectMusic,
                           nil,
                           CLSCTX_INPROC,
                           IID_IDirectMusic,
                           pMusic);

   if (Res = S_OK) then
   begin
      if (DirectSound <> nil) then
       	  pMusic.SetDirectSound(DirectSound, 0);
      Result := pMusic;
   end
   else Result := nil
end;

{------------------------------------------------------------------------------}
function CreatePerformance(pMusic: IDirectMusic; DirectSound: IDirectSound): IDirectMusicPerformance;
var
   fAutoDownload: BOOL;
   pPerf: IDirectMusicPerformance;
begin
   Result := nil;

   if (DirectSound = nil) then pMusic := nil;
       
   if CoCreateInstance(CLSID_DirectMusicPerformance,
                       nil,
                       CLSCTX_INPROC,
                       IID_IDirectMusicPerformance,
                       pPerf) = S_OK then
   begin
      if pPerf.Init(@pMusic,DirectSound,0) = S_OK then
      begin
         // Turn autodownloading on
         fAutoDownload := True;
         if pPerf.SetGlobalParam(GUID_PerfAutoDownload, @fAutoDownload,sizeOf(fAutoDownload)) = S_OK then
            Result := pPerf;
      end;
   end;
end;

{------------------------------------------------------------------------------}
function CreateMusicPort(pMusic: IDirectMusic): IDirectMusicPort;
var
   guidPort: TGUID;
   pPort: IDirectMusicPort;
   dmPortParams: TDMUS_PORTPARAMS;
   dmPortCaps: TDMUS_PORTCAPS;
   i: integer;
begin
   pPort := nil;

   // First, try the default port
   if pMusic.GetDefaultPort(guidPort) = S_OK then
   begin
      FillChar(dmPortParams, sizeOf(TDMUS_PORTPARAMS), 0);

      dmPortParams.dwSize          := sizeOf(TDMUS_PORTPARAMS);
      dmPortParams.dwChannelGroups := 1;
      dmPortParams.dwValidParams   := DMUS_PORTPARAMS_CHANNELGROUPS;

      // Create the default port and check the capabilities
      if pMusic.CreatePort(guidPort, dmPortParams, pPort, nil) = S_OK then
      begin
         FillChar(dmPortCaps, sizeOf(TDMUS_PORTCAPS), 0);

         dmPortCaps.dwSize := sizeOf(TDMUS_PORTCAPS);
	 if pPort.GetCaps(dmPortCaps) = S_OK then
         begin
	    if (dmPortCaps.dwClass <> DMUS_PC_OUTPUTCLASS) or
               (dmPortCaps.dwFlags and DMUS_PC_DLS = 0) or
               (dmPortCaps.dwFlags and DMUS_PC_DIRECTSOUND = 0) then
            begin
               pPort := nil;
            end;
         end;
      end;

      // If the default port doesn't handle the capabilities we need,
      // then enumerate all ports until we find one that does.
      if (pPort = nil) then
      begin
         i := 0;
         while True do
         begin
            FillChar(dmPortCaps, sizeOf(TDMUS_PORTCAPS), 0);

            dmPortCaps.dwSize := sizeOf(TDMUS_PORTCAPS);
            if pMusic.EnumPort(i, dmPortCaps) = S_OK then
            begin
               if (dmPortCaps.dwClass = DMUS_PC_OUTPUTCLASS) and
                  (dmPortCaps.dwFlags and DMUS_PC_DLS <> 0) and
                  (dmPortCaps.dwFlags and DMUS_PC_DIRECTSOUND <> 0) then
               begin
                  CopyMemory(@guidPort, @dmPortCaps.guidPort, sizeOf(TGUID));

             	  FillChar(dmPortParams, sizeOf(TDMUS_PORTPARAMS), 0);

                  dmPortParams.dwSize          := sizeOf(TDMUS_PORTPARAMS);
                  dmPortParams.dwChannelGroups := 1;
	          dmPortParams.dwValidParams   := DMUS_PORTPARAMS_CHANNELGROUPS;

		  if pMusic.CreatePort(guidPort, dmPortParams, pPort,nil) = S_OK then
                  begin
                     break;
                  end;
               end;
            end
            else break;
            inc(i);
         end;
      end;
   end;
   Result := pPort;
end;

{------------------------------------------------------------------------------}
function CreateLoader: IDirectMusicLoader;
var
   pLoader: IDirectMusicLoader;
begin
   if CoCreateInstance(CLSID_DirectMusicLoader,
                       nil,
                       CLSCTX_INPROC,
                       IID_IDirectMusicLoader,
                       pLoader) <> S_OK then
      Result := nil
   else
      Result := pLoader;
end;

{------------------------------------------------------------------------------}
function LoadSegment(pLoader: IDirectMusicLoader; FName: string): IDirectMusicSegment;
var
   ObjDesc: TDMUS_OBJECTDESC;
   pSeg: IDirectMusicSegment;

begin
   Result := nil;

   FillChar(ObjDesc,sizeOf(ObjDesc),0);
   ObjDesc.dwSize := sizeof(ObjDesc);
   ObjDesc.guidClass := CLSID_DirectMusicSegment;
   StringToWideChar(FName,ObjDesc.wszFileName,sizeOf(ObjDesc.wszFileName)div 2);
   ObjDesc.dwValidData := DMUS_OBJ_CLASS or DMUS_OBJ_FILENAME or DMUS_OBJ_FULLPATH;

   if pLoader.GetObject(@ObjDesc,IID_IDirectMusicSegment, pSeg) = S_OK then
      Result := pSeg
end;

{==============================================================================}
constructor TMMDSMidiChannel.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);

   FMixer := nil;

   if _WinNT3_ then
      raise EMMDSWaveMixError.Create(LoadResStr(IDS_DSNOTSUPPORTED));

   if not LoadDSoundDLL then
      raise EMMDSWaveMixError.Create(LoadResStr(IDS_DLLERROR)+' DSOUND.DLL...');

   FSoundBuffer := TMMDSSoundBuffer.Create;
   FSoundBuffer.FOwned := True;

   F3DBuffer      := TMMDS3DBuffer.Create((aOwner <> nil) and (csLoading in aOwner.ComponentState));

   FFileName      := '';
   FOpen          := False;
   FPlaying       := False;
   FLoops         := 0;

   FIMusic        := nil;
   FIPort         := nil;
   FIPerf         := nil;
   FILoader       := nil;
   FIMIDIseg      := nil;