cmpmidimixer.pas

Delphi的另一款钢琴软件

end;

(*--------------------------------------------------------------------------*
 | procedure TMidiMixer.WndProc                                             |
 |                                                                          |
 | Handle callback messages by dispatching them to the control              |
 |                                                                          |
 | Parameters:                                                              |
 |   var Msg : TMessage           The message to dispatch.                  |
 *--------------------------------------------------------------------------*)
procedure TMidiMixer.WndProc (var Msg : TMessage);
begin
  try
    Dispatch (Msg);
  except
    Application.HandleException (self)
  end
end;


(*--------------------------------------------------------------------------*
 | procedure TMidiMixer.MmMixmControlChange ()                              |
 |                                                                          |
 | Handle MM_MIXM_CONTROLCHANGE message sent to the callback window handle  |
 | by the MM subsystem.                                                     |
 |                                                                          |
 | Parameters:                                                              |
 |   var Msg : TMessage          The message received.                      |
 *--------------------------------------------------------------------------*)
procedure TMidiMixer.MmMixmControlChange (var Msg : TMessage);
var
  ctrl : TMixerControlType;
  cChannels : Integer;
begin
  for ctrl := Low (TMixerControlType) to High (TMixerControlType) do

                               // Find the control that caused the message
    if DWord (Msg.lParam) = fControl [ctrl].dwControlID then
    begin
      if ctrl in [mtAudioVolume, mtAudioMute, mtAudioTreble, mtAudioBass] then
        cChannels := fAudioLine.cChannels
      else
        cChannels := fSynthLine.cChannels;

                               // Get current channel values from the MM subsystem
                               // into the fValue member variable

      UpdateControl (ctrl, cChannels);


      if (Assigned (fOnControlChange)) and not (csDestroying in ComponentState) then
        OnControlChange (self, ctrl);

      break
    end
end;

(*--------------------------------------------------------------------------*
 | procedure TMidiMixer.Open                                                |
 |                                                                          |
 | Open the mixer, and get the Midi Volume, Midi Mute, Master Volume and    |
 | Master Mute controls from the driver.                                    |
 *--------------------------------------------------------------------------*)
procedure TMidiMixer.Open;
var
  i, err : Integer;
  synthID, audioID : Integer;

  //---------------------------------------------------------------------------
  // Helper function gets a line control for a given type (defined in MMSYSTEM.PAS)
  // eg. MIXERCONTROL_CONTROLTYPE_VOLUME; MIXERCONTROL_CONTROLTYPE_MUTE.
  // Return 'true' if a control for the specified type was found.
  function GetMixerControlByType (const line : TMixerLine; tp : Integer; var control : TMixerControl) : boolean;
  var
    mixerLineControls : TMixerLineControls;
    err : Integer;
  begin
    mixerLineControls.cbStruct := sizeof (mixerLineControls);
    mixerLineControls.dwLineID := line.dwLineID;
    mixerLineControls.dwControlType := tp;
    mixerLineControls.cControls := line.cControls;
    mixerLineControls.cbmxctrl := sizeof (control);
    mixerLineControls.pamxctrl := @control;
    err := mixerGetLineControls (fMixerHandle, @mixerLineControls, MIXER_GETLINECONTROLSF_ONEBYTYPE);

    if (err <> MIXERR_INVALCONTROL) and (err <> MMSYSERR_NOERROR) and (err <> MIXERR_INVALLINE) then
      raise EMMError.CreateMMErr (err, 'mixerGetLineControls');

    result := err = MMSYSERR_NOERROR;
  end;

begin  { TMidiMixer.Open }
  if fMIDIDeviceID = -2 then
                             // Open mixer 0
    err := mixerOpen (@fMixerHandle, 0, fWindowHandle, Integer (self), MIXER_OBJECTF_MIXER or CALLBACK_WINDOW)
  else                       // ... or open the mixer for MIDI device id
    err := mixerOpen (@fMixerHandle, fMIDIDeviceID, fWindowHandle, Integer (self), MIXER_OBJECTF_MIDIOUT or CALLBACK_WINDOW);

  if err <> MMSYSERR_NOERROR then
    raise EMMError.CreateMMErr (err, 'mixerOpen');

                             // Get the devcaps for the mixer.
  mixerGetDevCaps (fMixerHandle, @fMixerCaps, sizeof (fMixerCaps));

  // There will probably be two 'destinations' - Master Playback, and Master Record
  // Find the 'Master Playback' one.

  audioID := -1;
  for i := 0 to fMixerCaps.cDestinations - 1 do
  begin
    fAudioLine.cbStruct := sizeof (fAudioLine);
    fAudioLine.dwDestination := i;
    fAudioLine.dwSource := 0;
    mixerGetLineInfo (fMixerHandle, @fAudioLine, MIXER_GETLINEINFOF_DESTINATION);
    if fAudioLine.dwComponentType = MIXERLINE_COMPONENTTYPE_DST_SPEAKERS then
    begin
      audioID := i;               // Got the Master Playback destination
      break
    end
  end;

  if audioID = -1 then
    raise Exception.Create ('Can''t find audio output mixer line for ' + fMixerCaps.szPName);

                                  // Get the 'Master Volume' and 'Master Mute'
                                  // controls
  fControlSupported [mtAudioVolume] := GetMixerControlByType (fAudioLine, MIXERCONTROL_CONTROLTYPE_VOLUME, fControl [mtAudioVolume]);
  fControlSupported [mtAudioMute] := GetMixerControlByType (fAudioLine, MIXERCONTROL_CONTROLTYPE_MUTE, fControl [mtAudioMute]);
  fControlSupported [mtAudioTreble] := GetMixerControlByType (fAudioLine, MIXERCONTROL_CONTROLTYPE_TREBLE, fControl [mtAudioTreble]);
  fControlSupported [mtAudioBass] := GetMixerControlByType (fAudioLine, MIXERCONTROL_CONTROLTYPE_BASS, fControl [mtAudioBass]);

                                  // Get the 'Master Volume' and 'Master Mute'
                                  // 'Master Treble' and 'Master Bass' control values.
  UpdateControl (mtAudioVolume, fAudioLine.cChannels);
  UpdateControl (mtAudioMute, fAudioLine.cChannels);
  UpdateControl (mtAudioTreble, fAudioLine.cChannels);
  UpdateControl (mtAudioBass, fAudioLine.cChannels);

                                  // Go through the 'sources' routed through the
                                  // Master Playback destination, and find the
                                  // MIDI source.
  synthID := -1;
  for i := 0 to fAudioLine.cConnections - 1 do
  begin
    fSynthLine.cbStruct := sizeof (fSynthLine);
    fSynthLine.dwDestination := audioID;
    fSynthLine.dwSource := i;
    mixerGetLineInfo (fMixerHandle, @fSynthLine, MIXER_GETLINEINFOF_SOURCE);
    if fSynthLine.dwComponentType = MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER then
    begin
                                  // Got the MIDI source!
      synthID := fSynthLine.dwLineID;
      break;
    end
  end;

  if synthID = -1 then
    raise Exception.Create ('Can''t find MIDI output source line for ' + fMixerCaps.szPName);

                                  // Get the MIDI volume and MIDI mute controls
  fControlSupported [mtMidiVolume] := GetMixerControlByType (fSynthLine, MIXERCONTROL_CONTROLTYPE_VOLUME, fControl [mtMidiVolume]);
  fControlSupported [mtMidiMute] := GetMixerControlByType (fSynthLine, MIXERCONTROL_CONTROLTYPE_MUTE, fControl [mtMidiMute]);

                                  // Get the MIDI volume and MIDI mute control
                                  // values.
  UpdateControl (mtMidiVolume, fSynthLine.cChannels);
  UpdateControl (mtMidiMute, fSynthLine.cChannels);

  fActive := True;
end;

(*--------------------------------------------------------------------------*
 | procedure TMidiMixer.Close;                                              |
 |                                                                          |
 | Close the mixer.                                                         |
 *--------------------------------------------------------------------------*)
procedure TMidiMixer.Close;
begin
  if fActive then
    mixerClose (fMixerHandle);
  fActive := False;
end;

(*--------------------------------------------------------------------------*
 | procedure TMidiMixer.UpdateControl ()                                    |
 |                                                                          |
 | Update a TMidiMixer value by querying the MM control.                    |
 |                                                                          |
 | Parameters:                                                              |
 |   control : TMixerControlType    The value to update eg. mtMidiVolume    |
 |   channels : Number of channels supported by the mixer line (usually 2!) |
 |                                                                          |
 | The procedure updates the fValue member array.                           |
 *--------------------------------------------------------------------------*)
procedure TMidiMixer.UpdateControl (control : TMixerControlType; channels : Integer);
var
  details : TMixerControlDetails;
  data : array [0..15] of Integer;
  err : Integer;
begin
  if ControlSupported [control] then
  begin
    if (fControl [control].dwControlType and MIXERCONTROL_CONTROLTYPE_CUSTOM) > 0 then
      channels := 0                   // Not used by TMidiMixer
    else
      if (fControl [control].fdwControl and MIXERCONTROL_CONTROLF_UNIFORM) > 0 then
        channels := 1;                // nb, Mute is often a 'uniform' control -
                                      // there's only one value, which affects
                                      // all channels.

    details.cbStruct := sizeof (details);
    details.dwControlID := fControl [control].dwControlID;
    details.cChannels := channels;
    details.cMultipleItems := fControl [control].cMultipleItems;
    details.cbDetails := sizeof (integer);
    details.paDetails := @data;

                                      // Get the control details
    err := mixerGetControlDetails (fMixerHandle, @details, MIXER_GETCONTROLDETAILSF_VALUE);

    if err = MMSYSERR_NOERROR then
    begin
                                      // Copy the data into the fValue memberarray