借花献佛，这个控件能满足你的要求。
{
Component : TVolumeControl
Author : Alexey Lavnikov
e-mail : demigor@hitmail.com OR al@hsbm.belpak.minsk.by
Home Page : N/A
Delphi Ver : 3.0, 2.0 (1.0do
n't know)
Component Ver. : 1.0
Type : Freeware with sources
I know that many people want to have this component, so I've decideddo
not
publish this component as shareware. So you can see in sources, it was very
simple to build such thing. I've seen another component with same name, but
that was not so good as mine.
Use these properties:
CDVolume : Current volume of CD-out.
CDTrackbar : Linked component to set/show CD-volume.
WaveVolume : Current volume of Wave-out.
WaveTrackbar : ...
MidiVolume : Current volume of Midi-out.
Interval : Timer interval between refreshing volumes.
If some of sound-outs are not available then
the corresponding volume will
be zero. For more see the source.
}
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('Athen
a3', [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;
procedure TVolumeControl.Notification(AComponent: TComponent;
AOperation: TOperation);
var I: Integer;
begin
inherited Notification(AComponent, AOperation);
if (AOperation = opRemove) then
for I := 0 to 2do
if (AComponent = FTrackBars)
then
FTrackBars := Nil;
end;
procedure TVolumeControl.Update(Sender: TObject);
var I: Integer;
begin
for I := 0 to 2do
if Assigned(FTrackBars) then
with FTrackBarsdo
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 2do
if Assigned(FTrackBars) then
FTrackBars.OnChange := Nil;
inherited Destroy;
end;
procedure TVolumeControl.Changed(Sender: TObject);
var I: Integer;
begin
for I := 0 to 2do
if Sender = FTrackBars then
with FTrackBarsdo
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 - 1do
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 - 1do
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 - 1do
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.
