Thema: Delphi Haupt Lautstärke Regeln

Einzelnen Beitrag anzeigen

Benutzerbild von bitsetter
bitsetter

Registriert seit: 17. Jan 2007
1.169 Beiträge
 
Turbo Delphi für Win32
 
#13

Re: Haupt Lautstärke Regeln

  Alt 21. Mär 2007, 17:54
Hallo,

also beim Microfoneingang habe ich es jetzt hinbekommen, das lag an mxcd.cChannels = 2 bei mir ging es nur mit mxcd.cChannels = 1 .
Den Code habe ich jetzt so abgeändert, dass man den linken und rechten Kanal einzeln ansteuern kann, sofern es unterstützt wird.
Die beiden anderen Konstanten MIXERLINE_COMPONENTTYPE_DST_WAVEIN und
MIXERLINE_COMPONENTTYPE_DST_VOICEIN sehen ja etwas anders aus, kann sein dass es deswegen nicht funktioniert.

Delphi-Quellcode:
uses mmsystem;

function GetMixerControlID(CompType: DWORD): DWORD;
var
  mxl: MIXERLINE;
  mxc: MIXERCONTROL;
  mxlc: MIXERLINECONTROLS;
begin
  Result := 0;
  mxl.cbStruct := SizeOf(mxl);
  mxl.dwComponentType := CompType;
  if (mixerGetLineInfo(0, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE) = MMSYSERR_NOERROR) then
  begin
    mxlc.cbStruct := SizeOf(mxlc);
    mxlc.dwLineID := mxl.dwLineID;
    mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
    mxlc.cControls := mxl.cControls;
    mxlc.cbmxctrl := sizeof(mxc);
    mxlc.pamxctrl := @mxc;
    if (mixerGetLineControls(0, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE) = MMSYSERR_NOERROR)
      then Result := mxc.dwControlID;
  end;
end;

type
  TVolume = record
    Left, Right: DWord;
    Channels: byte;
end;

function GetVolume(ID: DWORD; Channels: byte = 2) : TVolume;
var
  Volume : Array[0..1] Of TMixerControlDetails_Unsigned;
  mxcd: TMixerControlDetails;
  NoError: boolean;
begin
  if Channels > 2 then
    Channels := 2;
  mxcd.cbStruct := sizeof(mxcd);
  mxcd.dwControlID := ID;
  mxcd.cChannels := Channels;
  mxcd.cMultipleItems := 0;
  mxcd.cbDetails := sizeof(MIXERCONTROLDETAILS_UNSIGNED) * 2;
  mxcd.paDetails := @Volume;
  Result.Left := 0;
  Result.Right := 0;
  Result.Channels:= Channels;
  try
    NoError:= mixerGetControlDetails(0, @mxcd, MIXER_GETCONTROLDETAILSF_VALUE)= MMSYSERR_NOERROR;
    if NoError then
    begin
      Result.Left := Volume[0].dwValue;
      if Channels = 2 then
        Result.Right := Volume[1].dwValue;
    end
    else
    begin
      if Channels= 2 then
        Result := GetVolume(ID, 1);
      if Channels= 1 then
         Result.Channels:= 0;
    end;
  except
    Result.Channels:= 0;
  end;
end;

function SetVolume(ID, Left, Right: DWord; Channels: byte = 2): byte;
var Volume : Array[0..1] Of TMixerControlDetails_Unsigned;
    mxcd: TMixerControlDetails;
    NoError: boolean;
begin
  if Channels> 2 then
    Channels := 2;
  Result := Channels;
  Volume[0].dwValue := Left;
  Volume[1].dwValue := Right;
  with mxcd Do
  begin
    cbStruct := SizeOf(mxcd);
    dwControlID := ID;
    cChannels := Channels;
    cMultipleItems := 0;
    cbDetails := SizeOf(TMixerControlDetails_Unsigned) * 2;
    paDetails := @Volume;
    try
      NoError:= (mixerSetControlDetails(0, @mxcd,MIXER_SETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR);
      if not NoError then
      begin
        if Channels= 2 then
          Result := SetVolume(ID, Left, Right,1);
        if Channels= 1 then
          Result:= 0;
      end;
    except
      Result := 0;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  MixerCtrlID: DWord;
begin
  MixerCtrlID := GetMixerControlID(MIXERLINE_COMPONENTTYPE_SRC_LINE);// MIXERLINE_COMPONENTTYPE_SRC_LINE);
  //SetVolume(MixerCtrlID, 65535, 65535);//100 %
  //SetVolume(MixerCtrlID, 32768, 0);//50 % rechts= 0%
  SetVolume(MixerCtrlID, 32768, 32768);//50 % links und rechts gleich laut
  caption:= inttostr(GetVolume(MixerCtrlID).Left);
end;
Gruß bitsetter
"Viele Wege führen nach Rom"
Wolfgang Mocker (geb. 1954), dt. Satiriker und Aphoristiker
  Mit Zitat antworten Zitat