wavemixer.pas

一整套声音录制控件

procedure TAudioMixerLine.SetVolume(Value: Integer);
var
  Details: TMixerControlDetails;
  Val: TMixerControlDetailsUnsigned;
begin
  fLastError := MIXERR_INVALCONTROL;
  if mcVolume in fAvailableControls then
  begin
    if Value < 0 then Value := 0;
    if Value > 100 then Value := 100;
    Val.dwValue := MulDiv(fControls[mcVolume].Bounds.dwMaximum, Value, 100);
    FillChar(Details, SizeOf(Details), 0);
    Details.cbStruct := SizeOf(Details);
    Details.dwControlID := fControls[mcVolume].dwControlID;
    Details.cChannels := 1;
    Details.cMultipleItems := 0;
    Details.cbDetails := SizeOf(Val);
    Details.paDetails := @Val;
    fLastError := mixerSetControlDetails(fMixer.Handle, @Details,
      MIXER_SETCONTROLDETAILSF_VALUE or MIXER_OBJECTF_HMIXER);
  end;
end;

function TAudioMixerLine.GetMute: Boolean;
var
  Details: TMixerControlDetails;
  Val: TMixerControlDetailsBoolean;
begin
  Result := True;
  fLastError := MIXERR_INVALCONTROL;
  if mcMute in fAvailableControls then
  begin
    FillChar(Details, SizeOf(Details), 0);
    Details.cbStruct := SizeOf(Details);
    Details.dwControlID := fControls[mcMute].dwControlID;
    Details.cChannels := 1;
    Details.cMultipleItems := 0;
    Details.cbDetails := SizeOf(Val);
    Details.paDetails := @Val;
    fLastError := mixerGetControlDetails(fMixer.Handle, @Details,
      MIXER_GETCONTROLDETAILSF_VALUE or MIXER_OBJECTF_HMIXER);
    if fLastError = MMSYSERR_NOERROR then
      Result := Boolean(Val.fValue);
  end;
end;

procedure TAudioMixerLine.SetMute(Value: Boolean);
var
  Details: TMixerControlDetails;
  Val: TMixerControlDetailsBoolean;
begin
  fLastError := MIXERR_INVALCONTROL;
  if mcMute in fAvailableControls then
  begin
    Val.fValue := Ord(Value);
    FillChar(Details, SizeOf(Details), 0);
    Details.cbStruct := SizeOf(Details);
    Details.dwControlID := fControls[mcMute].dwControlID;
    Details.cChannels := 1;
    Details.cMultipleItems := 0;
    Details.cbDetails := SizeOf(Val);
    Details.paDetails := @Val;
    fLastError := mixerSetControlDetails(fMixer.Handle, @Details,
      MIXER_SETCONTROLDETAILSF_VALUE or MIXER_OBJECTF_HMIXER);
  end;
end;

function TAudioMixerLine.GetSelectedLine: Integer;
var
  ControlType: TMixerControlType;
  Details: TMixerControlDetails;
  Val: PMixerControlDetailsBooleanArray;
  ValByteCount: Integer;
  ValIndex: Integer;
begin
  Result := -1;
  if mcMix in fAvailableControls then
    ControlType := mcMix
  else if mcSelect in fAvailableControls then
    ControlType := mcSelect
  else
  begin
    fLastError := MIXERR_INVALCONTROL;
    Exit;
  end;
  if ControlType in fAvailableControls then
  begin
    ValByteCount := fControls[ControlType].cMultipleItems *
      SizeOf(TMixerControlDetailsBoolean);
    GetMem(Val, ValByteCount);
    try
      FillChar(Val^, ValByteCount, 0);
      FillChar(Details, SizeOf(Details), 0);
      Details.cbStruct := SizeOf(Details);
      Details.dwControlID := fControls[ControlType].dwControlID;
      Details.cChannels := 1;
      Details.cMultipleItems := fControls[ControlType].cMultipleItems;
      Details.cbDetails := SizeOf(TMixerControlDetailsBoolean);
      Details.paDetails := Val;
      fLastError := mixerGetControlDetails(fMixer.Handle, @Details,
        MIXER_GETCONTROLDETAILSF_VALUE or MIXER_OBJECTF_HMIXER);
      if fLastError = MMSYSERR_NOERROR then
      begin
        for ValIndex := 0 to fControls[ControlType].cMultipleItems - 1 do
          if Boolean(Val[ValIndex].fValue) then
          begin
            Result := FindLineIDByChannelIndex(ValIndex, ControlType);
            Break;
          end;
      end;
    finally
      FreeMem(Val);
    end;
  end;
end;

procedure TAudioMixerLine.SetSelectedLine(Value: Integer);
var
  ControlType: TMixerControlType;
  Details: TMixerControlDetails;
  Val: PMixerControlDetailsBooleanArray;
  ValByteCount: Integer;
  ValIndex: Integer;
begin
  if mcMix in fAvailableControls then
    ControlType := mcMix
  else if mcSelect in fAvailableControls then
    ControlType := mcSelect
  else
  begin
    fLastError := MIXERR_INVALCONTROL;
    Exit;
  end;
  ValIndex := FindChannelIndexByLineID(Value, ControlType);
  if ValIndex >= 0 then
  begin
    ValByteCount := fControls[ControlType].cMultipleItems *
      SizeOf(TMixerControlDetailsBoolean);
    GetMem(Val, ValByteCount);
    try
      FillChar(Val^, ValByteCount, 0);
      Val[ValIndex].fValue := Ord(True);
      FillChar(Details, SizeOf(Details), 0);
      Details.cbStruct := SizeOf(Details);
      Details.dwControlID := fControls[ControlType].dwControlID;
      Details.cChannels := 1;
      Details.cMultipleItems := fControls[ControlType].cMultipleItems;
      Details.cbDetails := SizeOf(Val);
      Details.paDetails := Val;
      fLastError := mixerSetControlDetails(fMixer.Handle, @Details,
        MIXER_SETCONTROLDETAILSF_VALUE or MIXER_OBJECTF_HMIXER);
    finally
      FreeMem(Val);
    end;
  end
  else
    fLastError := MMSYSERR_INVALPARAM
end;

{ TAudioMixer }

constructor TAudioMixer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  CallbackHandle := AllocateHWnd(CallbackProc);
  fMaster := TAudioMixerLine.Create(Self, -1);
  fLines := TList.Create;
  RefreshDetails(False);
end;

destructor TAudioMixer.Destroy;
begin
  DeleteMixerLines;
  fMaster.Free;
  if fHandle <> 0 then
    mixerClose(fHandle);
  if CallbackHandle <> 0 then
    DeallocateHWnd(CallbackHandle);
  inherited Destroy;
end;

procedure TAudioMixer.CallbackProc(var Message: TMessage);
var
  I: Integer;
  ControlType: TMixerControlType;
begin
  with Message do
    case msg of
      MM_MIXM_LINE_CHANGE:
      begin
        if THandle(wParam) = fHandle then
          if fMaster.LineInfo.dwLineID = DWORD(lParam) then
            DoLineChange(fMaster)
          else
            for I := 0 to fLines.Count - 1 do
              if TAudioMixerLine(fLines[I]).LineInfo.dwLineID = DWORD(lParam) then
              begin
                DoLineChange(TAudioMixerLine(fLines[I]));
                Break;
              end;
        Result := 0;
      end;
      MM_MIXM_CONTROL_CHANGE:
      begin
        if THandle(wParam) = fHandle then
          if fMaster.FindControlByID(DWORD(lParam), ControlType) then
            DoControlChange(fMaster, ControlType)
          else
            for I := 0 to fLines.Count - 1 do
              if TAudioMixerLine(fLines[I]).FindControlByID(DWORD(lParam), ControlType) then
              begin
                DoControlChange(TAudioMixerLine(fLines[I]), ControlType);
                Break;
              end;
        Result := 0;
      end;
    else
      Result := DefWindowProc(CallbackHandle, Msg, wParam, lParam);
    end;
end;

function TAudioMixer.FetchMixerNames(const Names: TStrings): DWORD;
var
  Index: Integer;
  Caps: TMixerCaps;
begin
  Result := 0;
  for Index := 0 to mixerGetNumDevs - 1 do
  begin
    mixerGetDevCaps(Index, @Caps, SizeOf(Caps));
    Names.Append(Caps.szPname);
    Inc(Result);
  end;
end;

function TAudioMixer.FetchDestinationNames(const Names: TStrings): DWORD;
var
  Index: Integer;
  LineInfo: TMixerLine;
begin
  Result := 0;
  for Index := 0 to fMixerCaps.cDestinations - 1 do
  begin
    LineInfo.cbStruct := SizeOf(LineInfo);
    LineInfo.dwDestination := Index;
    mixerGetLineInfo(fHandle, @LineInfo,
      MIXER_GETLINEINFOF_DESTINATION or MIXER_OBJECTF_HMIXER);
    Names.Append(LineInfo.szName);
    Inc(Result);
  end;
end;

function TAudioMixer.FindMixerLine(ComponentType: TMixerLineComponentType;
  out ADestinationID, ALineID: Integer): Boolean;
var
  LineInfo: TMixerLine;
begin
  Result := False;
  LineInfo.cbStruct := SizeOf(LineInfo);
  LineInfo.dwComponentType := MixerLineComponentTypes[ComponentType];
  if mixerGetLineInfo(fHandle, @LineInfo, MIXER_GETLINEINFOF_COMPONENTTYPE or
    MIXER_OBJECTF_HMIXER) = MMSYSERR_NOERROR then
  begin
    ADestinationID := LineInfo.dwDestination;
    ALineID := LineInfo.dwSource;
    Result := (ALineID >= 0);
  end;
end;

procedure TAudioMixer.DoLineChange(MixerLine: TAudioMixerLine);
begin
  if Assigned(fOnLineChange) then
    fOnLineChange(Self, MixerLine);
end;

procedure TAudioMixer.DoControlChange(MixerLine: TAudioMixerLine;
  ControlType: TMixerControlType);
begin
  if Assigned(fOnControlChange) then
    fOnControlChange(Self, MixerLine, ControlType);
end;

function TAudioMixer.GetMixerCount: WORD;
begin
  Result := mixerGetNumDevs;
end;

function TAudioMixer.GetMixerName: String;
begin
  Result := fMixerCaps.szPname;
end;

procedure TAudioMixer.SetMixerName(const Value: String);
var
  Names: TStringList;
  Index: Integer;
begin
  if MixerName <> Value then
  begin
    Names := TStringList.Create;
    try
      FetchMixerNames(Names);
      Index := Names.IndexOf(Value);
      if Index <> -1 then MixerID := Index;
    finally
      Names.Free;
    end;
  end;
end;

procedure TAudioMixer.SetMixerID(Value: DWORD);
begin
  if (fMixerID <> Value) and (Value < MixerCount) then
  begin
    fMixerID := Value;
    RefreshDetails(False);
  end;
end;

procedure TAudioMixer.SetDestinationID(Value: DWORD);
begin
  if fDestinationID <> Value then
  begin
    fDestinationID := Value;
    RefreshDetails(True);
  end;
end;

function TAudioMixer.GetDestinationName: String;
begin
  Result := fMaster.Name;
end;

procedure TAudioMixer.SetDestinationName(const Value: String);
var
  Names: TStringList;
  Index: Integer;
begin
  if DestinationName <> Value then
  begin
    Names := TStringList.Create;
    try
      FetchDestinationNames(Names);
      Index := Names.IndexOf(Value);
      if Index <> -1 then DestinationID := Index;
    finally
      Names.Free;
    end;
  end;
end;

function TAudioMixer.GetDestinationCount: WORD;
begin
  Result := fMixerCaps.cDestinations;
end;

function TAudioMixer.GetLineCount: WORD;
begin
  Result := fMaster.LineInfo.cConnections;
end;

function TAudioMixer.GetLines(LineID: DWORD): TAudioMixerLine;
begin
  Result := TAudioMixerLine(fLines[LineID]);
end;

procedure TAudioMixer.CreateMixerLines;
var
  I: Integer;
begin
  for I := 0 to LineCount - 1 do
    fLines.Add(TAudioMixerLine.Create(Self, I));
end;

procedure TAudioMixer.DeleteMixerLines;
var
  I: Integer;
begin
  for I := fLines.Count - 1 downto 0 do
  begin
    TAudioMixerLine(fLines[I]).Free;
    fLines.Delete(I);
  end;
end;

procedure TAudioMixer.RefreshDetails(DestinationOnly: Boolean);
begin
  DeleteMixerLines;
  if not DestinationOnly then
  begin
    if fHandle <> 0 then
    begin
      mixerClose(fHandle);
      fHandle := 0;
    end;
    FillChar(fMixerCaps, SizeOf(fMixerCaps), 0);
    mixerGetDevCaps(fMixerID, @fMixerCaps, SizeOf(fMixerCaps));
    fLastError := mixerOpen(@fHandle, fMixerID, CallBackHandle, 0,
      MIXER_OBJECTF_MIXER or CALLBACK_WINDOW);
  end;
  if fDestinationID >= DestinationCount then
    fDestinationID := 0;
  fMaster.RefreshDetails(-1);
  CreateMixerLines;
end;

end.