Mega Code Archive
Volume control component
<![CDATA[
//www.dronymc.cjb.net
//drony@mynet.com
//icq:266148308
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('Plus', [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 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.
]]>