Delphi World - Как программно изменять громкость звука
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Как программно изменять громкость звука


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.

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования