Multimidia - volume do som

DFM:

    TrackBar1: TTrackBar

      Max = 255

    end

Codigo:

uses MMSystem;

const

  CDVolume   = 0;

  WaveVolume = 1;

  MidiVolume = 2;

type

  TVolumeRec = record

  case Integer of

    0: (LongVolume: Longint);

    1: (LeftVolume, RightVolume : Word);

  end;

var

  AudioDevices: array[0..2] of Integer;

procedure CapturaAudioDevices;

var

  AuxCaps    : TAuxCaps;

  WaveOutCaps: TWaveOutCaps;

  MidiOutCaps: TMidiOutCaps;

  I,J        : Integer;

begin

  AudioDevices[0] := -1;

  for I := 0 to auxGetNumDevs - 1 do

  begin

    auxGetDevCaps(I, @AuxCaps, SizeOf(AuxCaps));

    if (AuxCaps.dwSupport and AUXCAPS_VOLUME) <> 0 then

    begin

      AudioDevices[0] := I;

      Break;

    end;

  end;

  AudioDevices[1] := -1;

  for I := 0 to waveOutGetNumDevs - 1 do

  begin

    waveOutGetDevCaps(I, @WaveOutCaps, SizeOf(WaveOutCaps));

    if (WaveOutCaps.dwSupport and WAVECAPS_VOLUME) <> 0 then

    begin

      AudioDevices[1] := I;

      Break;

    end;

  end;

  AudioDevices[2] := -1;

  for I := 0 to midiOutGetNumDevs - 1 do

  begin

    MidiOutGetDevCaps(I, @MidiOutCaps, SizeOf(MidiOutCaps));

    if (MidiOutCaps.dwSupport and MIDICAPS_VOLUME) <> 0 then

    begin

      AudioDevices[2] := I;

      Break;

    end;

  end;

end;

function GetVolume(const AIndex: Integer): Byte;

var

  Vol: TVolumeRec;

begin

  if AudioDevices[AIndex] = -1 then Exit;

  Vol.LongVolume := 0;

  case AIndex of

    0: auxGetVolume(AudioDevices[AIndex], @Vol.LongVolume);

    1: waveOutGetVolume(AudioDevices[AIndex], @Vol.LongVolume);

    2: midiOutGetVolume(AudioDevices[AIndex], @Vol.LongVolume);

  end;

  Result := (Vol.LeftVolume + Vol.RightVolume) shr 9;

end;

// 0 - 255

procedure SetVolume(const aIndex: Integer; const aVolume: Byte);

var

  Vol: TVolumeRec;

begin

  if AudioDevices[AIndex] = -1 then Exit;

  Vol.LeftVolume  := aVolume shl 8;

  Vol.RightVolume := Vol.LeftVolume;

  case AIndex of

    0: auxSetVolume(AudioDevices[AIndex], Vol.LongVolume);

    1: waveOutSetVolume(AudioDevices[AIndex], Vol.LongVolume);

    2: midiOutSetVolume(AudioDevices[AIndex], Vol.LongVolume);

  end;

end;

// 1 trackbar para cada tipo:

procedure TForm1.WaveTrackChange(Sender: TObject);

begin

  SetVolume(WaveVolume, WaveTrack.Position);

end;

procedure TForm1.CDTrackChange(Sender: TObject);

begin

  SetVolume(CDVolume, CDTrack.Position);

end;

procedure TForm1.MidiTrackChange(Sender: TObject);

begin

  SetVolume(MidiVolume, MidiTrack.Position);

end;

// o create "carrega" os audio-devices

procedure TForm1.FormCreate(Sender: TObject);

begin

  CapturaAudioDevices;

  Timer1.Enabled := True;

end;

// um timer pega os volumes do windows e coloca-os nos track

procedure TForm1.Timer1Timer(Sender: TObject);

begin

  WaveTrack.Position := GetVolume(WaveVolume);

  CDTrack.Position   := GetVolume(CDVolume  );

  MidiTrack.Position := GetVolume(MidiVolume);

end;

// -------------------- antigo, tambem funciona meia boca ------------

DFM:

    TrackBar1: TTrackBar

      Max = 100

      Orientation = trVertical

      Frequency = 10

      Position = 100

      OnChange = TrackBar1Change

    end

Codigo:

uses MMSystem;

// Volume: 0-100

procedure SetVolume(const Volume: Word);

begin

  waveOutSetVolume(0, Trunc(655.35 * Volume));

end;

// Volume: 0-100

function GetVolume: Word;

var

  Vol: Word;

begin

  waveOutGetVolume(0, Addr(Vol));

  Result := Trunc((Vol / 65535) * 100);

end;

procedure TForm1.FormActivate(Sender: TObject);

begin

  TrackBar1.Position := GetVolume;

  Label1.Caption := IntToStr( TrackBar1.Position ) + '%';

end;

procedure TForm1.TrackBar1Change(Sender: TObject);

begin

  SetVolume(TrackBar1.Position);

  Label1.Caption := IntToStr( TrackBar1.Position ) + '%';

end;

    =============================== dica 2 ============================

 Submitted by obeliks@obeliks.de

uses MMSystem;

type

  TVolumeRec = record

    case Integer of

      0: (LongVolume: Longint);

      1: (LeftVolume, RightVolume : Word);

    end;

const DeviceIndex=5

      {0:Wave

       1:MIDI

       2:CDAudio

       3:Line-In

       4:Microphone

       5:Master

       6:PC-loudspeaker}

procedure SetVolume(aVolume:Byte);

var Vol: TVolumeRec;

begin

  Vol.LeftVolume := aVolume shl 8;

  Vol.RightVolume:= Vol.LeftVolume;

  auxSetVolume(UINT(DeviceIndex), Vol.LongVolume);

end;

function GetVolume:Cardinal;

var Vol: TVolumeRec;

begin

  AuxGetVolume(UINT(DeviceIndex),@Vol.LongVolume);

  Result:=(Vol.LeftVolume + Vol.RightVolume) shr 9;

end;

================================= dica 3 ----------------------------

  procedure LeVolume; 

  var 

    lpdwVolume : Longint; 

    iCanalEsquerdo, iCanalDireito : Integer; 

    wDeviceID : Word; 

  begin 

    wDeviceID := 0; 

    WaveOutGetVolume (wDeviceID, @lpdwVolume); 

    iCanalEsquerdo := LoWord (lpwdVolume); 

    iCanalDireito := HiWord (lpwdVolume); 

  end; 

  Para alterar o volume: 

  procedure AlteraVolume; 

  var 

    lpdwVolume : Longint; 

    iCanalEsquerdo, iCanalDireito : Integer; 

    wDeviceID : Word; 

  begin 

    wDeviceID := 0; 

    iCanalEsquerdo := 65535; // Volume Máximo 

    iCanalDireito := 65535; 

    WaveOutSetVolume (wDeviceID, MakeLong(iCanalEsquerdo, iCanalDireito)); 

  end;