mmmixer.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: [phone]                   =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.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: 12.02.98 - 06:07:59 $                                        =}
{========================================================================}
unit MMMixer;

{$I COMPILER.INC}

interface

uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    Messages,
    Classes,
    SysUtils,
    Forms,
    MMSystem,
    MMObj,
    MMUtils,
    MMObsrv,
    MMDevice;

type
    { D3: This lines rely on current Win32 API}

    { To override Borland's bug directly declare TMixerControl }
    { instead of TMixerControlA                                }
    PMixerControl = ^TMixerControl;
    TMixerControl = record
        cbStruct     : DWORD; { size in bytes of MIXERCONTROL         }
        dwControlID  : DWORD; { unique control id for mixer device    }
        dwControlType: DWORD; { MIXERCONTROL_CONTROLTYPE_xxx          }
        fdwControl   : DWORD; { MIXERCONTROL_CONTROLF_xxx             }
        cMultipleItems: DWORD; { if MIXERCONTROL_CONTROLF_MULTIPLE set }
        szShortName  : array[0..MIXER_SHORT_NAME_CHARS - 1] of AnsiChar;
        szName       : array[0..MIXER_LONG_NAME_CHARS - 1] of AnsiChar;
        Bounds: record
           case Integer of
               0: (lMinimum, lMaximum: Longint);
               { !! HERE IT IS !! }
               1: (dwMinimum, dwMaximum: DWORD);
               2: (dwReserved: array[0..5] of DWORD);
               { !! HERE IT IS !! }
        end;
        Metrics: record
           case Integer of
               0: (cSteps: DWORD);       { # of steps between min & max }
               1: (cbCustomData: DWORD); { size in bytes of custom data }
               2: (dwReserved: array[0..5] of DWORD);
        end;
    end;

const
    badLineId    = -1;
    badControlId = -1;
    NoItem       = -1;

type
    { D3: This lines rely on current Win32 API}
    {$IFDEF WIN32}
    TMMLineId           = type integer;
    TMMControlId        = type integer;
    TMMChannelIndex     = Integer;
    TMMItemIndex        = type Integer;
    TMMLineIndex        = Integer;
    TMMControlIndex     = Integer;
    TMMConnectionIndex  = Integer;
    {$ENDIF}
    TMMComponentType    = (ctDstDigital,ctDstHeadPhones,ctDstLine,
                           ctDstMonitor,ctDstSpeakers,ctDstTelephone,
                           ctDstUndefined,ctDstVoiceIn,ctDstWaveIn,
                           ctSrcAnalog,ctSrcAux,ctSrcCD,ctSrcDigital,
                           ctSrcLine,ctSrcMicrophone,ctSrcPCSpeaker,
                           ctSrcSynthesizer,ctSrcTelephone,ctSrcUndefined,
                           ctSrcWaveOut);

    TMMControlClass     = (ccCustom,ccFader,ccList,ccMeter,ccNumber,
                           ccSlider,ccSwitch,ccTime);
    TMMControlClasses   = set of TMMControlClass;

    TMMControlType      = (ctCustom,ctBass,ctEqualizer,ctFader,ctTreble,
                           ctVolume,ctMixer,ctMultipleSelect,ctMux,
                           ctSingleSelect,ctBooleanMeter,ctPeakMeter,
                           ctSignerMeter,ctUnsignedMeter,ctDecibels,
                           ctPercent,ctSigned,ctUnsigned,ctPan,ctQSoundPan,
                           ctSlider,ctBoolean,ctButton,ctLoudness,ctMono,
                           ctMute,ctOnOff,ctStereoEnh,ctMicroTime,ctMilliTime);

    TMMLineChangeEvent      = procedure(Sender: TObject; LineId: TMMLineId) of object;
    TMMControlChangeEvent   = procedure(Sender: TObject; LineId: TMMLineId; CtlId: TMMControlId) of object;

{$IFNDEF BUILD_ACTIVEX}
    TMMComponent1 = TMMComponent;
{$ELSE}
    TMMComponent1 = TMMNonVisualComponent;
{$ENDIF}

    {-- TMMMixerDevice ------------------------------------------------------}
    TMMMixerDevice = class(TMMCustomAudioDevice)
    private
       FHandle        : HMIXER;
       FCBWnd         : HWND;
       FDevice        : TMMCustomAudioDevice;
       FObserver      : TMMObserver;
       FObservable    : TMMObservable;
       FDummyInd      : TMMLineIndex;
       FOnLineChange  : TMMLineChangeEvent;
       FOnControlChange: TMMControlChangeEvent;

       procedure SetDevice(Value: TMMCustomAudioDevice);
       procedure DeviceNotify(Sender, Data: TObject);
       function  StoreDeviceId: Boolean;
       function  GetDestinations: TMMLineIndex;
       function  GetDestination(Index: TMMLineIndex): TMMLineId;
       function  GetMixerId: TMMDeviceId;
       procedure MixerWndProc(var Msg: TMessage);
    protected
       procedure Notification(AComponent: TComponent; Operation: TOperation); override;
       procedure Changed; override;
       procedure UpdateDevice; override;
       procedure Open; override;
       procedure Close; override;
       procedure LineChanged(LineId: TMMLineId); virtual;
       procedure ControlChanged(CtlId: TMMControlId); virtual;
       procedure DoLineChange(LineId: TMMLineId); dynamic;
       procedure DoControlChange(LineId: TMMLineId; CtlId: TMMControlId); dynamic;
       { D3: This lines rely on current Win32 API}
       function  GetLineInfo(var Info: TMixerLine; Flags: DWORD): Boolean;
       procedure GetControlValues(Id: TMMControlId; ItemSize: DWORD; Channels: Integer; Items: TMMItemIndex; Values: Pointer; Flags: DWORD);
       procedure SetControlValues(Id: TMMControlId; ItemSize: DWORD; Channels: Integer; Items: TMMItemIndex; Values: Pointer; Flags: DWORD);
       function  GetControlInfo(var Info: TMixerLineControls; Flags: DWORD): Boolean;
    public
       constructor Create(AOwner: TComponent); override;
       destructor  Destroy; override;

       procedure AddObserver(O: TMMObserver);
       procedure RemoveObserver(O: TMMObserver);

       function  GetLineOfControl(CtlId: TMMControlId): TMMLineId;

       function  GetLineInfoById(LineId: TMMLineId; var Info: TMixerLine): Boolean;
       function  GetLineInfoByCompType(CompType: TMMComponentType; var Info: TMixerLine): Boolean;
       function  GetLineInfoByTarget(Device: TMMCustomAudioDevice; var Info: TMixerLine): Boolean;
       function  GetLineInfoByDestination(Dest: TMMLineIndex; var Info: TMixerLine): Boolean;
       function  GetLineInfoBySource(Dest, Src: TMMLineIndex; var Info: TMixerLine): Boolean;

       function  GetControlInfoById(ControlId: TMMControlId; var Info: TMixerControl): Boolean;
       function  GetControlInfoByType(LineId: TMMLineId; ControlType: TMMControlType; var Info: TMixerControl): Boolean;
       function  GetControlByType(LineId: TMMLineId; ControlType: TMMControlType): TMMControlId;

       procedure GetAllControls(LineId: TMMLineId; Controls: TMMControlIndex; P: PMixerControl);

       procedure GetBooleanControl(Id: TMMControlId; Channels: TMMChannelIndex; Items: TMMItemIndex; Values: PBoolean);
       procedure SetBooleanControl(Id: TMMControlId; Channels: TMMChannelIndex; Items: TMMItemIndex; Values: PBoolean);
       procedure GetSignedControl(Id: TMMControlId; Channels: TMMChannelIndex; Items: TMMItemIndex; Values: PInteger);
       procedure SetSignedControl(Id: TMMControlId; Channels: TMMChannelIndex; Items: TMMItemIndex; Values: PInteger);
       procedure GetUnsignedControl(Id: TMMControlId; Channels: TMMChannelIndex; Items: TMMItemIndex; Values: PCardinal);
       procedure SetUnsignedControl(Id: TMMControlId; Channels: TMMChannelIndex; Items: TMMItemIndex; Values: PCardinal);

       procedure GetItemsInfo(Id: TMMControlId; Channels: TMMChannelIndex; Items: TMMItemIndex; Infos: PMixerControlDetailsListText);

       { If mixer is opened then get id of handle and update DeviceId if needed }
       property MixerId: TMMDeviceId read GetMixerId;
       property Destination[Index:TMMLineIndex]: TMMLineId read GetDestination;
    published
       property DeviceId stored StoreDeviceId;
       property Device: TMMCustomAudioDevice read FDevice write SetDevice;
       property Destinations: TMMLineIndex read GetDestinations write FDummyInd stored False;
       property OnLineChange: TMMLineChangeEvent read FOnLineChange write FOnLineChange;
       property OnControlChange: TMMControlChangeEvent read FOnControlChange write FOnControlChange;
    end;

    {-- TMMMixerChange --------------------------------------------------}
    TMMMixerChange = class(TMMObject)
    end;

    {-- TMMLineChange ---------------------------------------------------}
    TMMLineChange = class(TMMMixerChange)
    public
       LineId: TMMLineId;
    end;

    {-- TMMControlChange ------------------------------------------------}
    TMMControlChange = class(TMMMixerChange)
    public
       LineId   : TMMLineId;
       ControlId: TMMControlId;
    end;

    {-- TMMMixerDeviceError ---------------------------------------------}
    EMMMixerDeviceError = class(EMMDeviceError)
    end;

    {-- TMMAudioLine ----------------------------------------------------}
    TMMLineSetup    = (lsLineId,lsCompType,lsTarget);

    { D3: This lines rely on current Win32 API}
    TMMLineFlag     = (cfActive,cfDisconnected,cfSource);
    TMMLineFlags    = set of TMMLineFlag;

    {-- TMMLineInfo -----------------------------------------------------}
    TMMLineInfo     = class(TPersistent)
    private
       FFlags      : TMMLineFlags;
       FChannels   : Integer;
       FConnections: Integer;
       FControls   : Integer;
       FShortName  : string;
       FName       : string;

       FLDummy     : Integer;
       FFDummy     : TMMLineFlags;

       procedure SetDummyStr(const Value: string);
    public
       procedure Clear;
    published
       property  Flags: TMMLineFlags read FFlags write FFDummy stored False;
       property  Channels: TMMChannelIndex read FChannels write FLDummy stored False;
       property  Connections: TMMConnectionIndex read FConnections write FLDummy stored False;
       property  Controls: TMMControlIndex read FControls write FLDummy stored False;
       property  ShortName: string read FShortName write SetDummyStr stored False;
       property  Name: string read FName write SetDummyStr stored False;
    end;

    {-- TMMAudioLine ----------------------------------------------------}
    TMMAudioLine = class(TMMNonVisualComponent)
    private
       FLineId         : TMMLineId;
       FDestinationId  : TMMLineIndex;
       FDestLine       : TMMAudioLine;
       FDestObserver   : TMMObserver;
       FLineInfo       : TMMLineInfo;
       FComponentType  : TMMComponentType;
       FMixer          : TMMMixerDevice;
       FObserver       : TMMObserver;
       FLineSetup      : TMMLineSetup;
       FTarget         : TMMCustomAudioDevice;
       FTargetObserver : TMMObserver;
       FObservable     : TMMObservable;
       FOnChange       : TNotifyEvent;
       FOnControlChange: TMMControlChangeEvent;

       procedure SetMixer(Value: TMMMixerDevice);
       procedure MixerNotify(Sender, Data: TObject);
       procedure TargetNotify(Sender, Data: TObject);
       procedure DestNotify(Sender, Data: TObject);
       procedure SetDestLine(Value: TMMComponent1);
       function  GetDestLine : TMMComponent1;
       procedure SetLineId(Value: TMMLineId);
       procedure SetComponentType(Value: TMMComponentType);
       procedure SetTarget(Value: TMMCustomAudioDevice);
       function  StoreLineId: Boolean;
       function  StoreComponentType: Boolean;
       function  StoreTarget: Boolean;
       procedure SetLineInfo(const Info: TMMLineInfo);
       function  GetConnections: TMMConnectionIndex;
       function  GetConnection(Index: TMMConnectionIndex): TMMLineId;
       function  GetControls: TMMControlIndex;
       function  GetControl(Index: TMMControlIndex): TMMControlId;
    protected
       procedure Notification(AComponent: TComponent; Operation: TOperation); override;
       procedure Changed; virtual;
       procedure DoChange; dynamic;
       procedure LineIdChanged; virtual;
       procedure ControlChanged(CtlId: TMMControlId); virtual;
       procedure DoControlChange(CtlId: TMMControlId); dynamic;
       procedure UpdateLine;
       procedure Loaded; override;
    public
       constructor Create(AOwner: TComponent); override;
       destructor  Destroy; override;

       procedure AddObserver(O: TMMObserver);
       procedure RemoveObserver(O: TMMObserver);
       function  GetLineInfoForSource(Source: TMMAudioLine; var Info : TMixerLine): Boolean;
       function  ValidMixer: Boolean;

       property Connections: TMMConnectionIndex read GetConnections;
       property Connection[Index:TMMConnectionIndex]: TMMLineId read GetConnection;
       property Controls: TMMControlIndex read GetControls;
       property Control[Index:TMMControlIndex]: TMMControlId read GetControl;
    published
       property Mixer: TMMMixerDevice read FMixer write SetMixer;
       property LineId: TMMLineId read FLineId write SetLineId stored StoreLineId default badLineId;
       property ComponentType: TMMComponentType read FComponentType write SetComponentType stored StoreComponentType default Low(TMMComponentType);
       property Target: TMMCustomAudioDevice read FTarget write SetTarget stored StoreTarget;
       { TMMComponent because TMMAudioLine caused GPF }
       property DestLine: TMMComponent1 read GetDestLine write SetDestLine;
       property LineInfo: TMMLineInfo read FLineInfo write SetLineInfo stored False;
       property OnChange: TNotifyEvent read FOnChange write FOnChange;
       property OnControlChange: TMMControlChangeEvent read FOnControlChange write FOnControlChange;
    end;

    {-- TMMLineIDChange -------------------------------------------------}
    TMMLineIdChange = class(TMMMixerChange)
    end;

    EMMAudioLineError   = class(Exception)
    end;

    TMMControlSetup = (csControlId, csControlType);
    { D3: This lines rely on current Win32 API}
    TMMControlFlag  = (cfDisabled,cfMultiple,cfUniform);
    TMMControlFlags = set of TMMControlFlag;

    {-- TMMControlInfo --------------------------------------------------}
    TMMControlInfo  = class(TPersistent)
{$IFNDEF BUILD_ACTIVEX}
    private
{$ELSE}
    public
{$ENDIF}
       FFlags         : TMMControlFlags;
       FMultipleItems : TMMItemIndex;
       FShortName     : string;
       FName          : string;
       FMinValue      : Integer;
       FMaxValue      : Integer;
       FSteps         : Integer;

       FLDummy        : Integer;
       FFDummy        : TMMControlFlags;
       FIDummy        : TMMItemIndex;

       procedure SetDummyStr(const Value: string);
    public
       procedure Clear;
    published
       property Flags: TMMControlFlags read FFlags write FFDummy stored False;
       property MultipleItems: TMMItemIndex read FMultipleItems write FIDummy stored False;
       property ShortName: string read FShortName write SetDummyStr stored False;
       property Name: string read FName write SetDummyStr stored False;
       property MinValue: Integer read FMinValue write FLDummy stored False;
       property MaxValue: Integer read FMaxValue write FLDummy stored False;
       property Steps: Integer read FSteps write FLDummy stored False;
    end;

    { D3: This lines rely on current Win32 API}
    TMMItemParam        = DWord;