Изменить громкость

Эта программа увеличивает громкость выбранного канала на 1000:

uses MMSystem;

procedure TForm1.Button1Click(Sender: TObject);

var

 vol: longint;

 LVol, RVol: integer;

begin

 AuxGetVolume(ListBox1.ItemIndex, @Vol);

 LVol := Vol shr 16;

 if LVol < MaxWord - 1000 then

  LVol := LVol + 1000

 else

  LVol := MaxWord;

 RVol := (Vol shl 16) shr 16;

 if RVol < MaxWord - 1000 then

  RVol := RVol + 1000

 else

  RVol := MaxWord;

 AuxSetVolume(ListBox1.ItemIndex, LVol shl 16 + RVol);

end;

procedure TForm1.FormCreate(Sender: TObject);

var

 i: integer;

 cap: TAuxCaps;

begin

 for i := 0 to auxGetNumDevs - 1 do

 begin

  auxGetDevCaps(i, Addr(cap), SizeOf(cap));

  ListBox1.Items.Add(cap.szPname)

 end;

end;

procedure SetVolume(X: Word);
var
 iErr: Integer;
 i: integer;
 a: TAuxCaps;
begin
 for i := 0 to auxGetNumDevs do
 begin
  auxGetDevCaps(i, Addr(a), SizeOf(a));
  if a.wTechnology = AUXCAPS_CDAUDIO then
  break;
 end;
 // Устанавливаем одинаковую громкость для левого и правого каналов.
 // VOLUME := LEFT*$10000 + RIGHT*1
 iErr := auxSetVolume(i, (X * $10001));
 if (iErr‹›0) then
  ShowMessage('No audio devices are available!');
end;
function GetVolume: Word;
var
 iErr: Integer;
 i: integer;
 a: TAuxCaps;
 vol: word;
begin
 for i := 0 to auxGetNumDevs do
 begin
  auxGetDevCaps(i, Addr(a), SizeOf(a));
  if a.wTechnology = AUXCAPS_CDAUDIO then
  break;
 end;
 iErr := auxGetVolume(i, addr(vol));
 GetVolume := vol;
 if (iErr‹›0) then
  ShowMessage('No audio devices are available!');
end;

unit Volumes;
interface
uses
 Windows, Messages, Classes, ExtCtrls, ComCtrls, MMSystem;
const
 CDVolume = 0;
 WaveVolume = 1;
 MidiVolume = 2;
type
 TVolumeControl = class(TComponent)
 private
  FDevices : array[0..2] of Integer;
  FTrackBars : array[0..2] of TTrackBar;
  FTimer : TTimer;
  function  GetInterval: Integer;
  procedure  SetInterval(AInterval: Integer);
  function  GetVolume(AIndex: Integer): Byte;
  procedure  SetVolume(AIndex: Integer; aVolume: Byte);
  procedure  InitVolume;
  procedure  SetTrackBar(AIndex: Integer; ATrackBar: TTrackBar);
  { Private declarations }
  procedure  Update(Sender: TObject);
  procedure  Changed(Sender: TObject);
 protected
  { Protected declarations }
  procedure  Notification(AComponent: TComponent; AOperation:
TOperation); override;
 public
  { Public declarations }
  constructor  Create(AOwner: TComponent); override;
  destructor  Destroy; override;
 published
  { Published declarations }
  property  Interval: Integer read GetInterval write SetInterval default
500;
  property  CDVolume: Byte index 0 read GetVolume write SetVolume stored
False;
  property  CDTrackBar: TTrackBar index 0 read FTrackBars[0] write
SetTrackBar;
  property  WaveVolume: Byte index 1 read GetVolume write SetVolume
stored False;
  property  WaveTrackBar: TTrackBar index 1 read FTrackBars[1] write
SetTrackBar;
  property  MidiVolume: Byte index 2 read GetVolume write SetVolume
stored False;
  property  MidiTrackBar: TTrackBar index 2 read FTrackBars[2] write
SetTrackBar;
 end;
procedure Register;
implementation
procedure Register;
begin
 RegisterComponents('Any', [TVolumeControl]);
end;
type
  TVolumeRec = record
  case Integer of
  0: (LongVolume: Longint);
  1: (LeftVolume,
  RightVolume : Word);
  end;
  function  TVolumeControl.GetInterval: Integer;
  begin
  Result := FTimer.Interval;
  end;
  procedure  TVolumeControl.SetInterval(AInterval: Integer);
  begin
  FTimer.Interval := AInterval;
  end;
  function  TVolumeControl.GetVolume(AIndex: Integer): Byte;
  var Vol: TVolumeRec;
  begin
  Vol.LongVolume := 0;
  if FDevices[AIndex] < > -1 then
  case AIndex of
  0: auxGetVolume(FDevices[AIndex], @Vol.LongVolume);
  1: waveOutGetVolume(FDevices[AIndex], @Vol.LongVolume);
  2: midiOutGetVolume(FDevices[AIndex], @Vol.LongVolume);
  end;
  Result := (Vol.LeftVolume + Vol.RightVolume) shr 9;
  end;
  procedure  TVolumeControl.SetVolume(aIndex: Integer; aVolume: Byte);
  var Vol: TVolumeRec;
  begin
  if FDevices[AIndex] < > -1 then
  begin
  Vol.LeftVolume := aVolume shl 8;
  Vol.RightVolume := Vol.LeftVolume;
  case AIndex of
  0: auxSetVolume(FDevices[AIndex], Vol.LongVolume);
  1: waveOutSetVolume(FDevices[AIndex], Vol.LongVolume);
  2: midiOutSetVolume(FDevices[AIndex], Vol.LongVolume);
  end;
  end;
  end;
  procedure  TVolumeControl.SetTrackBar(AIndex: Integer; ATrackBar:
TTrackBar);
  begin
  if ATrackBar < > FTrackBars[AIndex] then
  begin
  FTrackBars[AIndex] := ATrackBar;
  Update(Self);
  end;
  end;
 AOperation: TOperation);
  var I: Integer;
  begin
  inherited Notification(AComponent, AOperation);
  if (AOperation = opRemove) then
  for I := 0 to 2 do if (AComponent = FTrackBars[I])
  then FTrackBars[I] := Nil;
  end;
  procedure  TVolumeControl.Update(Sender: TObject);
  var I: Integer;
  begin
  for I := 0 to 2 do
  if Assigned(FTrackBars[I]) then
  with FTrackBars[I] do
  begin
  Min := 0;
  Max := 255;
  if Orientation = trVertical
  then Position := 255 - GetVolume(I)
  else Position := GetVolume(I);
  OnChange := Self.Changed;
  end;
  end;
  constructor  TVolumeControl.Create(AOwner: TComponent);
  begin
  inherited Create(AOwner);
  FTimer := TTimer.Create(Self);
  FTimer.OnTimer := Update;
  FTimer.Interval := 500;
  InitVolume;
  end;
  destructor  TVolumeControl.Destroy;
  var I: Integer;
  begin
  FTimer.Free;
  for I := 0 to 2 do
  if Assigned(FTrackBars[I]) then
  FTrackBars[I].OnChange := Nil;
  inherited Destroy;
  end;
  procedure  TVolumeControl.Changed(Sender: TObject);
  var I: Integer;
  begin
  for I := 0 to 2 do
  if Sender = FTrackBars[I] then
  with FTrackBars[I] do
  begin
  if Orientation = trVertical
  then SetVolume(I, 255 - Position)
  else SetVolume(I, Position);
  end;
  end;
  procedure  TVolumeControl.InitVolume;
  var AuxCaps : TAuxCaps;
  WaveOutCaps : TWaveOutCaps;
  MidiOutCaps : TMidiOutCaps;
  I,J : Integer;
  begin
  FDevices[0] := -1;
  for I := 0 to auxGetNumDevs - 1 do
  begin
  auxGetDevCaps(I, @AuxCaps, SizeOf(AuxCaps));
  if (AuxCaps.dwSupport and AUXCAPS_VOLUME) < > 0 then
  begin
  FTimer.Enabled := True;
  FDevices[0] := I;
  break;
  end;
  end;
  FDevices[1] := -1;
  for I := 0 to waveOutGetNumDevs - 1 do
  begin
  waveOutGetDevCaps(I, @WaveOutCaps, SizeOf(WaveOutCaps));
  if (WaveOutCaps.dwSupport and WAVECAPS_VOLUME) < > 0 then
  begin
  FTimer.Enabled := True;
  FDevices[1] := I;
  break;
  end;
  end;
  FDevices[2] := -1;
  for I := 0 to midiOutGetNumDevs - 1 do
  begin
  MidiOutGetDevCaps(I, @MidiOutCaps, SizeOf(MidiOutCaps));
  if (MidiOutCaps.dwSupport and MIDICAPS_VOLUME) < > 0 then
  begin
  FTimer.Enabled := True;
  FDevices[2] := I;
  break;
  end;
  end;
  end;
end.

Выставь на форму 2 тракбара и двигай их. Если у тебя звучит музыка, ты должен услышать изменения громкости правого и левого каналов.

procedure TForm1.TrackBar1Change(Sender: TObject);

var

 s: dword;

 a,b: word;

 h: hWnd;

begin

 a:=trackbar1.position;

 b:=trackbar2.position;

 s:=(a shl 16) or b;

 waveOutSetVolume(h,s);

end;

свойство Max в каждом TrackBar'e должно равняться 65535 (то есть MaxWord)

Взято с http://delphiworld.narod.ru

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...