whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1547)

Database (90)
Files (137)
Forms (107)
Graphic (115)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

35 Visitors Online


 
...change the sound cards volume?
Autor: Charly
Homepage: http://www.charly-online.com
[ Print tip ]  

Tip Rating (11):  
     


{1.}

uses
  
MMSystem;

procedure SetVolume(const volL, volR: Word);
var
  
hWO: HWAVEOUT;
  waveF: TWAVEFORMATEX;
  vol: DWORD;
begin
  
// init TWAVEFORMATEX
  
FillChar(waveF, SizeOf(waveF), 0);
  // open WaveMapper = std output of playsound
  
waveOutOpen(@hWO, WAVE_MAPPER, @waveF, 0, 0, 0);
  vol := volL + volR shl 16;
  // set volume
  
waveOutSetVolume(hWO, vol);
  waveOutClose(hWO);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  
SetVolume(14000, 14000);
end;


{************************************************}

{2.}

{by Serhiy Perevoznyk}

uses
  
MMSystem;


function GetVolumeControl(aMixer: HMixer; componentType, ctrlType: Longint;
  var mxc: TMixerControl): Boolean;
var
  
mxl: TMixerLine;
  mxlc: TMixerLineControls;
  rc: Longint;
begin
  
Result := False;
  FillChar(mxl, SizeOf(TMixerLine), 0);
  mxl.cbStruct := SizeOf(TMixerLine);
  mxl.dwComponentType := componentType;
  {Obtain a line corresponding to the component type}
  
rc := mixerGetLineInfo(aMixer, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);
  if rc = MMSYSERR_NOERROR then
  begin
    with 
mxlc do
    begin
      
cbStruct := SizeOf(TMixerLineControls);
      dwLineID := mxl.dwLineID;
      dwControlType := ctrlType;
      cControls := 1;
      cbmxctrl := SizeOf(TMixerLine);
      pamxctrl := @mxc;
      pamxctrl^.cbStruct := SizeOf(TMixerControl);
    end;
    mixerGetLineControls(aMixer, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
    rc := mixerGetLineControls(aMixer, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);
    Result := rc = MMSYSERR_NOERROR;
  end;
end;

function SetVolumeControl(aMixer: HMixer; mxc: TMixerControl; volume: Longint): Boolean;
var
  
mxcd: TMixerControlDetails;
  vol: TMixerControlDetails_Unsigned;
  rc: MMRESULT;
begin
  
FillChar(mxcd, SizeOf(mxcd), 0);
  with mxcd do
  begin
    
cbStruct := SizeOf(TMixerControlDetails);
    dwControlID := mxc.dwControlID;
    cbDetails := SizeOf(TMixerControlDetails_Unsigned);
    paDetails := @vol;
    cMultipleItems := 0;
    cChannels := 1;
  end;
  vol.dwValue := volume;
  rc := mixerSetControlDetails(aMixer, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
  Result := rc = MMSYSERR_NOERROR;
end;

function InitMixer: HMixer;
var
  
Err: MMRESULT;
begin
  
Err := mixerOpen(@Result, 0, 0, 0, 0);
  if Err <> MMSYSERR_NOERROR then
    
Result := 0;
end;

// Example:


procedure SetMasterVolumeToZero;
var
  
MyMixerHandle: HMixer;
  MyVolCtrl: TMixerControl;
begin
  
MyMixerHandle := InitMixer;
  if MyMixerHandle <> 0 then
    try
      
FillChar(MyVolCtrl, SizeOf(MyVolCtrl), 0);
      if GetVolumeControl(MyMixerHandle, MIXERLINE_COMPONENTTYPE_DST_SPEAKERS,
        MIXERCONTROL_CONTROLTYPE_VOLUME, MyVolCtrl) then
      begin
        
{The last parameter (0) here is the volume level}
        
if SetVolumeControl(MyMixerHandle, MyVolCtrl, 0) then
          
ShowMessage('Volume should now be set to zero');
      end;
    finally
      
mixerClose(MyMixerHandle);
    end;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
 
SetMasterVolumeToZero
end;

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners