|
Вопрос # 1 973/ вопрос открыт / |
|
Доброго времени суток, уважаемые эксперты!
Делаю проигрыватель. Как настраивать звук прям в проигрывателе. И можно с пояснениями, а то мне надо будет потом объяснять принцип работы. Заранее спасибо.
 |
Вопрос задал: Денис (статус: Посетитель)
Вопрос отправлен: 6 октября 2008, 21:11
Состояние вопроса: открыт, ответов: 1.
|
Ответ #1. Отвечает эксперт: Feniks
Здравствуйте, Денис!
Держите в приложении три примера по управлению громкостью.
Приложение: Переключить в обычный режим-
- 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));
-
- 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;
-
- 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.
 |
Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 7 октября 2008, 10:24
|
Мини-форум вопроса
Мини-форум пуст.
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|