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

Эта программа увеличивает громкость выбранного канала на 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;
ID: 03610
----
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;
ID: 03611
----
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
 begin
 case AIndex of
 0: auxGetVolume(FDevices[AIndex], @Vol.LongVolume);
 1: waveOutGetVolume(FDevices[AIndex], @Vol.LongVolume);
 2: midiOutGetVolume(FDevices[AIndex], @Vol.LongVolume);
 end;
 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;
procedure TVolumeControl.Notification(AComponent: TComponent; AOperation: TOperation);
var
 I: Integer;
begin
 inherited Notification(AComponent, AOperation);
 if (AOperation = opRemove) then
 begin
 for I := 0 to 2 do
 begin
 if (AComponent = FTrackBars[I]) then
 FTrackBars[I] := Nil;
 end;
 end;
end;
procedure TVolumeControl.Update(Sender: TObject);
var
 I: Integer;
begin
 for I := 0 to 2 do
 begin
 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;
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
 begin
 if Assigned(FTrackBars[I]) then
 FTrackBars[I].OnChange := nil;
 end;
 inherited Destroy;
end;
procedure TVolumeControl.Changed(Sender: TObject);
var
 I: Integer;
begin
 for I := 0 to 2 do
 begin
 if Sender = FTrackBars[I] then
 with FTrackBars[I] do
 begin
 if Orientation = trVertical then
 SetVolume(I, 255 - Position)
 else
 SetVolume(I, Position);
 end;
 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.
ID: 03612
----
Выставь на форму 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)
Source: http://delphiworld.narod.ru
ID: 03613
Category:Звук