RealICQClient/Controls/RealICQUI/RealICQMasterVolumeControl.pas

{
文件名：RealICQMasterVolumeControl.pas
功  能：主输出音量调整控件
建  立：尹进
历  史：
2006.04.10：创建文件（尹进）
}
unit RealICQMasterVolumeControl;

interface

uses
  MMSystem,
  AMixer,
  Windows,
  SysUtils, Forms, Classes, Controls, ExtCtrls, Graphics, RealICQTrackBar;

type
  TRealICQMasterVolumeControl = class(TRealICQTrackBar)
  private
    FAudioMixer: TAudioMixer;
    procedure ValueChange(Sender:TObject);
    procedure MixerChange(Sender:TObject; MixerH: HMixer; ID: Integer);
    
    function GetCopyRight: String;
  protected
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ChangeUIColor(AColor: TColor); override;
  published
    property CopyRight: String read GetCopyRight;
    property Visible;
  end;

procedure Register;

implementation

//获取音量
function GetMasterVolumeValue: Word;
var
 hMix: HMIXER;
 mxlc: MIXERLINECONTROLS;
 mxcd: TMIXERCONTROLDETAILS;
 vol: TMIXERCONTROLDETAILS_UNSIGNED;
 mxc: MIXERCONTROL;
 mxl: TMixerLine;
 intRet: Integer;
 nMixerDevs: Integer;
begin
 Result := 0;

 // Check if Mixer is available
 nMixerDevs := mixerGetNumDevs();
 if (nMixerDevs < 1) then
 begin
   Result := 0;
   Exit;
 end;

 // open the mixer
 intRet := mixerOpen(@hMix, 0, 0, 0, 0);
 if intRet = MMSYSERR_NOERROR then
 begin
   mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
   mxl.cbStruct := SizeOf(mxl);

   // get line info
   intRet := mixerGetLineInfo(hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);

   if intRet = MMSYSERR_NOERROR then
   begin
     FillChar(mxlc, SizeOf(mxlc),0);
     mxlc.cbStruct := SizeOf(mxlc);
     mxlc.dwLineID := mxl.dwLineID;
     mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
     mxlc.cControls := 1;
     mxlc.cbmxctrl := SizeOf(mxc);

     mxlc.pamxctrl := @mxc;
     intRet := mixerGetLineControls(hMix, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);

     if intRet = MMSYSERR_NOERROR then
     begin
       FillChar(mxcd, SizeOf(mxcd),0);
       mxcd.dwControlID := mxc.dwControlID;
       mxcd.cbStruct := SizeOf(mxcd);
       mxcd.cMultipleItems := 0;
       mxcd.cbDetails := SizeOf(Vol);
       mxcd.paDetails := @vol;
       mxcd.cChannels := 1;

       intRet := mixerGetControlDetails(hMix, @mxcd,MIXER_SETCONTROLDETAILSF_VALUE);

       Result := vol.dwValue ;

       if intRet <> MMSYSERR_NOERROR then
         raise Exception.Create('GetControlDetails Error');
     end
     else
       raise Exception.Create('GetLineInfo Error');
   end;
   mixerClose(hMix);
 end;
end;

//设置音量
procedure SetMasterVolumeValue(Value: Word);
var
 hMix: HMIXER;
 mxlc: MIXERLINECONTROLS;
 mxcd: TMIXERCONTROLDETAILS;
 vol: TMIXERCONTROLDETAILS_UNSIGNED;
 mxc: MIXERCONTROL;
 mxl: TMixerLine;
 intRet: Integer;
 nMixerDevs: Integer;
begin
 // Check if Mixer is available
 nMixerDevs := mixerGetNumDevs();
 if (nMixerDevs < 1) then
 begin
   Exit;
 end;

 // open the mixer
 intRet := mixerOpen(@hMix, 0, 0, 0, 0);
 if intRet = MMSYSERR_NOERROR then
 begin
   mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
   mxl.cbStruct := SizeOf(mxl);

   // get line info
   intRet := mixerGetLineInfo(hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);

   if intRet = MMSYSERR_NOERROR then
   begin
     FillChar(mxlc, SizeOf(mxlc),0);
     mxlc.cbStruct := SizeOf(mxlc);
     mxlc.dwLineID := mxl.dwLineID;
     mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
     mxlc.cControls := 1;
     mxlc.cbmxctrl := SizeOf(mxc);

     mxlc.pamxctrl := @mxc;
     intRet := mixerGetLineControls(hMix, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);

     if intRet = MMSYSERR_NOERROR then
     begin
       FillChar(mxcd, SizeOf(mxcd),0);
       mxcd.dwControlID := mxc.dwControlID;
       mxcd.cbStruct := SizeOf(mxcd);
       mxcd.cMultipleItems := 0;
       mxcd.cbDetails := SizeOf(Vol);
       mxcd.paDetails := @vol;
       mxcd.cChannels := 1;

       vol.dwValue := Value;

       intRet := mixerSetControlDetails(hMix, @mxcd,MIXER_SETCONTROLDETAILSF_VALUE);

       if intRet <> MMSYSERR_NOERROR then
         raise Exception.Create('SetControlDetails Error');
     end
     else
       raise Exception.Create('GetLineInfo Error');
   end;
   mixerClose(hMix);
 end;
end;

//------------------------------------------------------------------------------
function TRealICQMasterVolumeControl.GetCopyRight: String;
begin
  Result := '版权所有(C) 2002-2016 浙江万赛软件科技有限公司 保留所有权利。';
end;

//------------------------------------------------------------------------------
procedure TRealICQMasterVolumeControl.ValueChange(Sender:TObject);
begin
  try
    SetMasterVolumeValue(Value);
  except
    OnChanged := nil;
    Value := 0;
    OnChanged := ValueChange;
  end;
end;

//------------------------------------------------------------------------------
procedure TRealICQMasterVolumeControl.MixerChange(Sender:TObject;MixerH:HMixer;ID:Integer);
begin
  OnChanged := nil;
  try
    Value := GetMasterVolumeValue;
  finally
    OnChanged := ValueChange;
  end;
end;

//------------------------------------------------------------------------------
constructor TRealICQMasterVolumeControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  
  try
    FAudioMixer := TAudioMixer.Create(Self);
    Value := GetMasterVolumeValue;
    OnChanged := ValueChange;
    FAudioMixer.OnControlChange := MixerChange;
  except
    Enabled := False;
  end;
end;

//------------------------------------------------------------------------------
destructor TRealICQMasterVolumeControl.Destroy;
begin
  try
    FreeAndNil(FAudioMixer);
  except
  end;

  inherited Destroy;
end;

//------------------------------------------------------------------------------
procedure TRealICQMasterVolumeControl.ChangeUIColor(AColor: TColor);
begin
  inherited;
end;

procedure Register;
begin
  RegisterComponents('RealICQ UI', [TRealICQMasterVolumeControl]);
end;

end.