cmpmidimixer.pas

Delphi的另一款钢琴软件

(*--------------------------------------------------------------------------*
 | Mixer Component for Larry Guy                                            |
 |                                                                          |
 | Copyright (c) Colin Wilson 1997.                                         |
 |                                                                          |
 | Version  Date      By    Description                                     |
 | -------  --------  ----  ------------------------------------------------|
 | 1.0      17/10/97  CPWW  Original                                        |
 | 1.1      21/10/97  CPWW  Treble & Bass controls added.                   |
 *--------------------------------------------------------------------------*)

unit cmpMidiMixer;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, mmsystem;

type
  TMixerChannel = (mcLeft, mcRight);
  TChannelValues = array [Low (TMixerChannel)..High (TMixerChannel)] of Integer;

  TMixerControlType = (mtMidiVolume, mtAudioVolume, mtMidiMute, mtAudioMute, mtAudioTreble, mtAudioBass);

                                     // OnControlChange event handler type
  TMixerNotifyEvent = procedure (sender : TObject; control : TMixerControlType) of object;

  //--------------------------------------------------------------------------
  // class TMidiMixer.  Encapsulates Midi Volume, MidiMute, Master  Volume and
  //                    MasterMute for a Multimedia mixer.
  TMidiMixer = class(TComponent)
  private
    fWindowHandle : HWND;               // Window handle for 'callback' messages
    fMixerHandle : HMIXER;              // Handle for the open mixer

    fMixerCaps : TMixerCaps;            // Mixer capabilities structure
    fSynthLine : TMixerLine;            // MIDI mixer line
    fAudioLine : TMixerLine;            // Master mixer line

    //------------------------------------------------------------------------
    // Property support variables

    fActive : boolean;                  // 'Control is active' flag
    fMidiDeviceID : Integer;            // The MIDI device ID

                                        // Array of mixer controls for midi volume,
                                        // midi mute, master volume & master mute
    fControl : array [Low (TMixerControlType)..High (TMixerControlType)] of TMixerControl;

                                        // Array of flags indicating if a control
                                        // is valid for a mixer.
    fControlSupported : array [Low (TMixerControlType)..High (TMixerControlType)] of boolean;


                                        // Current values of each control
    fValue : array [Low (TMixerControlType)..High (TMixerControlType)] of TChannelValues;

                                        // OnControlChange event placeholder
    fOnControlChange : TMixerNotifyEvent;

    //-------------------------------------------------------------------------
    // Private member functions.  See the indvidual function headers for details
    procedure WndProc (var Msg : TMessage);
    procedure MmMixmControlChange (var Msg : TMessage); message MM_MIXM_CONTROL_CHANGE;

    procedure Open;
    procedure Close;

    procedure UpdateControl (control : TMixerControlType; channels : Integer);
    procedure SetControl (control : TMixerControlType; channels : Integer);

    //-------------------------------------------------------------------------
    // Get/Set functions for properties
    procedure SetActive (value : boolean);
    procedure SetMidiDeviceID (value : Integer);
    function GetControlSupported (ctrl : TMixerControlType) : Boolean;
    function GetControlMin (ctrl : TMixerControlType) : Integer;
    function GetControlMax (ctrl : TMixerControlType) : Integer;
    function GetControlValue (ctrl : TMixerControlType; chan : TMixerChannel) : Integer;
    procedure SetControlValue (ctrl : TMixerControlType; chan : TMixerChannel; value : Integer);
    procedure SetControlValues (ctrl : TMixerControlType; const values : TChannelValues);

  protected
    // Loaded opens the mixer if the control is 'Active' if not in design mode.
    procedure Loaded; override;

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

    property ControlSupported [ctl : TMixerControlType] : boolean read GetControlSupported;
    property ControlMin [ctl : TMixerControlType] : integer read GetControlMin;
    property ControlMax [ctl : TMixerControlType] : integer read GetControlMax;
    property ControlValue [ctl : TMixerControlType; chan : TMixerChannel] : integer read GetControlValue write SetControlValue;
    property ControlValues [ctl : TMixerControlType] : TChannelValues write SetControlValues;

  published
    property Active : boolean read fActive write SetActive default True;
    property MidiDeviceID : Integer read fMidiDeviceID write SetMIDIDeviceID default -2;
    property OnControlChange : TMixerNotifyEvent read fOnControlChange write fOnControlChange;
  end;

  //--------------------------------------------------------------------------
  // class EMMError.  Encapsulates multimedia error handling.
  EMMError = class (Exception)
    constructor CreateMMErr (err : Integer; const fn : string);
  end;

procedure Register;

implementation

(*--------------------------------------------------------------------------*
 | function MMErrorString () : string                                       |
 |                                                                          |
 | Returns a descriptive string for a multimedia error code.  Supports all  |
 | MM system and mixer errors, but not MIDI, WAVE, AUX, etc. onces.         |
 |                                                                          |
 | Parameters:                                                              |
 |   err : Integer       The multimed error code                            |
 |                                                                          |
 | The function returns a descriptive string for the MM error code.         |
 *--------------------------------------------------------------------------*)
function MMErrorString (err : Integer) : string;
begin
  case err of
    MMSYSERR_ERROR        : result := 'Unspecified error';
    MMSYSERR_BADDEVICEID  : result := 'Device ID out of range';
    MMSYSERR_NOTENABLED   : result := 'Driver failed enable';
    MMSYSERR_ALLOCATED    : result := 'Device already allocated';
    MMSYSERR_INVALHANDLE  : result := 'Device handle is invalid';
    MMSYSERR_NODRIVER     : result := 'No device driver present';
    MMSYSERR_NOMEM        : result := 'Memory allocation error';
    MMSYSERR_NOTSUPPORTED : result := 'Function isn''t supported';
    MMSYSERR_BADERRNUM    : result := 'Error value out of range';
    MMSYSERR_INVALFLAG    : result := 'Invalid flag passed';
    MMSYSERR_INVALPARAM   : result := 'Invalid parameter passed';
    MMSYSERR_HANDLEBUSY   : result := 'Handle being used simultaneously on another thread (eg callback)';
    MMSYSERR_INVALIDALIAS : result := 'Specified alias not found';
    MMSYSERR_BADDB        : result := 'Bad registry database';
    MMSYSERR_KEYNOTFOUND  : result := 'Registry key not found';
    MMSYSERR_READERROR    : result := 'Registry read error';
    MMSYSERR_WRITEERROR   : result := 'Registry write error';
    MMSYSERR_DELETEERROR  : result := 'Registry delete error';
    MMSYSERR_VALNOTFOUND  : result := 'Registry value not found';
    MMSYSERR_NODRIVERCB   : result := 'Driver does not call DriverCallback';
    MIXERR_INVALLINE      : result := 'Invalid Mixer Line';
    MIXERR_INVALCONTROL   : result := 'Invalid Mixer Control';
    MIXERR_INVALVALUE     : result := 'Invalid Mixer Value';
    else result := 'Unknown error';
  end
end;

(*--------------------------------------------------------------------------*
 | constructor EMMError.CreateMMErr ()                                      |
 |                                                                          |
 | Constructor for EMMError, which handles Multimedia exceptions.           |
 |                                                                          |
 | Parameters:                                                              |
 |   err : Integer            The multimedia error code.                    |
 |   const fn : string        The name of the multimedia funcion that       |
 |                            failed.                                       |
 *--------------------------------------------------------------------------*)
constructor EMMError.CreateMMErr (err : Integer; const fn : string);
var
  errType : string;
begin
  if err in [MMSYSERR_ERROR..MMSYSERR_LASTERROR] then
    errType := 'System'           // Multimedia system error
  else
    if (err >= MIXERR_BASE) and (err <= MIXERR_LASTERROR) then
      errType := 'Mixer'          // Multimedia mixer error
    else
      errType := 'Unknown';       // Other multimedia error

                                  // Format the exception string.
  inherited CreateFmt ('Multimedia %s Error %d - %s in %s', [errType, err, MMErrorString (err), fn]);
end;

(*--------------------------------------------------------------------------*
 | constructor TMidiMixer.Create ();                                        |
 |                                                                          |
 | Initialise the mixer control                                             |
 |                                                                          |
 | Parameters:                                                              |
 |   AOwner : TComponent            The owning component (ie. the form)     |
 *--------------------------------------------------------------------------*)
constructor TMidiMixer.Create (AOwner : TComponent);
begin
  inherited Create (AOwner);
                                      // Create window handle to receive
                                      // callback messages.
  fWindowHandle := classes.AllocateHWnd (WndProc);

  fActive := True;                    // Make the control active by default
  fMidiDeviceID := -2;                // Default to mixer 0 
end;

(*--------------------------------------------------------------------------*
 | destructor TMidiMixer.Destroy                                            |
 |                                                                          |
 | Closes and destroys a mixer control                                      |
 *--------------------------------------------------------------------------*)
destructor TMidiMixer.Destroy;
begin
  Close;                              // Close the mixer if it's open.
  classes.DeallocateHWnd (fWindowHandle);     // Free the callback window handle
  inherited
end;

(*--------------------------------------------------------------------------*
 | procedure TMidiMixer.Loaded                                              |
 |                                                                          |
 | Set the real value of the Active property if not in design mode.         |
 *--------------------------------------------------------------------------*)
procedure TMidiMixer.Loaded;
begin
  inherited;
  if Active then                       // Is the control meant to be active?
  begin
    fActive := False;
    Active := True                     // Make the control *really* active
  end