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

Эта программа увеличивает громкость выбранного канала на 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)

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