Изменить громкость |
Previous Top Next |
Эта программа увеличивает громкость выбранного канала на 1000:
Code: |
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; |
©Drkb::03610
Code: |
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; |
©Drkb::03611
Code: |
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. |
©Drkb::03612
Выставь на форму 2 тракбара и двигай их. Если у тебя звучит музыка, ты должен услышать изменения громкости правого и левого каналов.
Code: |
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)
©Drkb::03613
Взято с http://delphiworld.narod.ru