COMPOSANT TDBPTRACKBARVOLUME - JOUEZ AVEC LE SON !

{
+------------------------------------------------------------------------------+
| DBPTRACKBARVOLUME                                                            |
+------------------------------------------------------------------------------+
 dbpTrackbarVolume (cc) Julio P. 2008

 FICHIERS      : dbpTrackBarVolume.pas,.dcu,.dcr,.bmp,ReadMe.htm
 AUTEUR        : Julio P. (Diabloporc)
 SITE WEB      : http://diabloporc.free.fr
 MAIL          : juliobosk@gmail.com
 LEGAL         : Distribué sous licence CeCill v2.0 compatible GNU/GPL v3.0
 INFOS         : Retrouvez moi sur www.delphifr.com : "JulioDelphi"
                 Lisez le ReadMe.htm !

HISTORY ------------------------------------------------------------------------

 VERSION       : 0.3
 DATE          : sept. 19, 2008
 ACTIONS       : Refactoring + Fix
 BY            : f0xi
 CHANGE LOG    :
    Global :
    - Licence changing for CeCill v2.0, GNU/GPL V3.0 compliant.
    - changed TPrecision vars names
    - changed ordinal case of TMixerLineComponentType vars
    - added string array for TMixerLineComponentType (MixerLineComponentTypeNames)
    - added function for fill a TStrings with MixerLineComponentTypeNames

    TdbpTrackbarVolume :
    - removed from constructor, hard coded description of Mixer lines component type
    - removed tsDescription variable (public)
    - added fMixLinesNames variable (private)
    - added SetMixLinesNames method for fMixLinesNames (private)
    - added MixLinesNames property (protected)
    - optimized SetVolumePourcent method (private)
    - optimized SetSilence method (private)
    - fixed SetSilence bug, RealPos variable not defined in condition
    - fixed Notification method bug, Inherited method not called
    - fixed SetLabel bug, RemoveFreeNotification not managed
    - fixed SetLabel bug, FreeNotification not called
    - fixed SetCheckboxMute bug, RemoveFreeNotification not managed
    - fixed SetCheckboxMute bug, FreeNotification not called
    - corrected Notification method, massive check of aComponent
    - corrected Constructor, objects creating order
    - corrected Destructor, FreeNotification of FLabel and FCheckboxMute not called


 VERSION       : 0.2
 DATE          : sept. 05, 2008
 ACTIONS       :
 BY            : Julio P. (Diabloporc)
 CHANGE LOG    :

 VERSION       : 0.1
 DATE          : aug. 29, 2008
 ACTIONS       : creating
 BY            : Julio P. (Diabloporc)
 CHANGE LOG    :

}
unit dbpTrackbarVolume;

interface

uses
  dialogs, Windows, Messages, SysUtils, Classes, Controls, ComCtrls, StdCtrls, MMSystem, ExtCtrls;

type
  TPrecision = (
                prHigh,     //65353 ticks
                prDefault,  //100 ticks (1% le tick)
                prLow,      //10 ticks (10% le tick)
                prVeryLow,  //4 ticks (25% le tick)
                pzCustom
               ); { <v3.0> }

  TMixerLineComponentType = (
    mlct_DST_UNDEFINED   = 0,  //
    mlct_DST_DIGITAL     = 1,  //
    mlct_DST_LINE        = 2,  //
    mlct_DST_MONITOR     = 3,  //
    mlct_DST_SPEAKERS    = 4,  // Volume Principal
    mlct_DST_HEADPHONES  = 5,  //
    mlct_DST_TELEPHONE   = 6,  //
    mlct_DST_WAVEIN      = 7,  //
    mlct_DST_VOICEIN     = 8,  //

    mlct_SRC_UNDEFINED   = 9,  //
    mlct_SRC_DIGITAL     =10,  // Entree
    mlct_SRC_LINE        =11,  // Entree ligne
    mlct_SRC_MICROPHONE  =12,  // Microphone
    mlct_SRC_SYNTHESIZER =13,  // Synthé
    mlct_SRC_COMPACTDISC =14,  // Lecteur CD
    mlct_SRC_TELEPHONE   =15,  //
    mlct_SRC_PCSPEAKER   =16,  //
    mlct_SRC_WAVEOUT     =17,  // Wave
    mlct_SRC_AUXILIARY   =18,  //
    mlct_SRC_ANALOG      =19   // Auxiliaire
  );  { testé sur carte son XiFi.
        Merci de remplir les autres champs,
        en ajouter et me les renvoyer à
        juliobox@free.fr
      }

const
  MixerLineComponentTypeNames : array[TMixerLineComponentType] of string = (
    'DST_UNDEFINED',
    'DST_DIGITAL',
    'DST_LINE',
    'DST_MONITOR',
    'DST_SPEAKERS',
    'DST_HEADPHONES',
    'DST_TELEPHONE',
    'DST_WAVEIN',
    'DST_VOICEIN',
    'SRC_UNDEFINED',
    'SRC_DIGITAL',
    'SRC_LINE',
    'SRC_MICRO',
    'SRC_SYNTHETIZER',
    'SRC_COMPACTDISC',
    'SRC_TELEPHONE',
    'SRC_PCSPEAKER',
    'SRC_WAVEOUT',
    'SRC_AUXILIARY',
    'SRC_ANALOG'
  ); { <v3.0> }

procedure MixerLineComponentTypeNamesToStrings(Strings: TStrings); { <v3.0> }

type
  TdbpTrackbarVolume = class(TTrackBar)
  private
    hMix: HMIXER;
    mxlc: MIXERLINECONTROLS;
    mxcd: TMIXERCONTROLDETAILS;
    vol: TMIXERCONTROLDETAILS_UNSIGNED;
    mcdMute: MIXERCONTROLDETAILS_BOOLEAN;
    mxc: MIXERCONTROL;
    mxl: TMIXERLINE;
    intRet, nMixerDevs: Integer;
    FMute: Boolean;
    FMlct: TMixerLineComponentType;
    FTimer: TTimer;
    FSilence: Boolean;
    FOldOnClickMute: TNotifyEvent;
    FCheckboxMute : TCheckbox;
    FLabel: TLabel;
    FCBState, FPourcent, FMin, FMax: Integer;
    FPrecision: TPrecision;
    FDesc, FAbout: string;
    fMixLinesNames : TStrings; { <v3.0> }
    procedure SetMixLinesNames(Value: TStrings); { <v3.0> }
    procedure SetCheckboxMute(Value: TCheckbox);
    procedure SetVolumeF(Value: Integer);
    procedure SetVolumePourcent(Value: Integer; Recalcul: Boolean); Overload;
    procedure SetLabel(Value: TLabel);
    procedure SetMlct(Value: TMixerLineComponentType);
    procedure SetPrecision(Value: TPrecision);
    procedure ProcOnCheckboxMute(Sender: TObject);
    procedure ProcOnTimer(Sender: TObject);
    function GetDescription: string;
    function GetVolume: Integer;
    function GetVolumeF(Value: Integer): Integer;
    function GetVolumeM(Value: Integer): Integer;
    function GetVolumeMute: Boolean;
  protected
    property MixLinesNames: TStrings read fMixLinesNames write SetMixLinesNames; { <v3.0> }
    procedure Changed; override;
  public
    constructor Create(AOwner: TComponent); override; { <v3.0> }
    destructor  Destroy; override; { <v3.0> }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override; { <v3.0> }
  published
    procedure SetVolumePourcent(Value: Integer); Overload;
    procedure SetVolumeMute(Value: Boolean);
    procedure SetSilence(Value: Boolean);
    property About         : string read FAbout write FAbout;
    property Description   : string read GetDescription;
    property Pourcent      : Integer read FPourcent;
    property Min           : Integer read FMin;
    property MixerLineType : TMixerLineComponentType read FMlct write SetMlct;
    property Mute          : Boolean read GetVolumeMute write SetVolumeMute;
    property Precision     : TPrecision read FPrecision write SetPrecision default prHigh;
    property TCheckboxMute : TCheckbox read FCheckboxMute write SetCheckboxMute;
    property TLabel        : TLabel read FLabel write SetLabel;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Diabloporc', [TdbpTrackbarVolume]);
end;

procedure MixerLineComponentTypeNamesToStrings(Strings: TStrings);
var N : TMixerLineComponentType;
begin
  Strings.BeginUpdate;
  try
    Strings.Clear;
    for N := Low(TMixerLineComponentType) to High(TMixerLineComponentType) do
      Strings.Add(MixerLineComponentTypeNames[N]);
  finally
    Strings.EndUpdate;
  end;
end;

const
  __dbpTrackbarVolumeAbout = 'v0.3 par Julio P. (Diabloporc) // f0xi'; // ;)

procedure TdbpTrackbarVolume.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (aComponent = FLabel) and (Operation = opRemove) then
    FLabel := nil
  else
  if (aComponent = FCheckboxMute) and (Operation = opRemove) then
    FCheckboxMute := nil
  else
    inherited Notification(AComponent, Operation);
end; { <v3.0> }

Procedure TdbpTrackbarVolume.SetVolumeMute(Value: Boolean);
var RealOrd: Integer;
Begin
  nMixerDevs := mixerGetNumDevs();
  If ((nMixerDevs < 1)) Then Exit;
  intRet := mixerOpen(@hMix, 0, 0, 0, 0);
  If (intRet = MMSYSERR_NOERROR) Then
  Begin
    RealOrd:= Ord(FMlct);
    if RealOrd>=9 then Inc(RealOrd, 4087);
    mxl.dwComponentType := RealOrd;
    mxl.cbStruct := SizeOf(mxl);
    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_MUTE;
      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.cbStruct := SizeOf(TMIXERCONTROLDETAILS);
        mxcd.dwControlID := mxc.dwControlID;
        mxcd.cChannels := 1;
        mxcd.cbDetails := SizeOf(MIXERCONTROLDETAILS_BOOLEAN);
        mxcd.paDetails := @mcdMute;
        mcdMute.fValue := Ord(Value);
        intRet := mixerSetControlDetails(hMix, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
      End;
    End;
    intRet := mixerClose(hMix);
  End;
End;

Procedure TdbpTrackbarVolume.SetVolumeF(Value: Integer);
var RealOrd: Integer;
Begin
  nMixerDevs := mixerGetNumDevs();
  If ((nMixerDevs < 1)) Then Exit;
  intRet := mixerOpen(@hMix, 0, 0, 0, 0);
  If (intRet = MMSYSERR_NOERROR) Then
  Begin
    RealOrd:= Ord(FMlct);
    if RealOrd>=9 then Inc(RealOrd, 4087);
    mxl.dwComponentType := RealOrd;
    mxl.cbStruct := SizeOf(mxl);
    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);
      End;
    End;
    intRet := mixerClose(hMix);
  End;
End;

Function TdbpTrackbarVolume.GetVolumeMute: Boolean;
var RealOrd: Integer;
Begin
  Result:= True;
  FCBState:= 1;
  nMixerDevs := mixerGetNumDevs();
  If ((nMixerDevs < 1)) Then Exit;
  intRet := mixerOpen(@hMix, 0, 0, 0, 0);
  If (intRet = MMSYSERR_NOERROR) Then
  Begin
    RealOrd:= Ord(FMlct);
    if RealOrd>=9 then Inc(RealOrd, 4087);
    mxl.dwComponentType := RealOrd;
    mxl.cbStruct := SizeOf(mxl);
    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_MUTE;
      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.cbStruct  := SizeOf(TMIXERCONTROLDETAILS);
        mxcd.dwControlID := mxc.dwControlID;
        mxcd.cChannels := 1;
        mxcd.cbDetails := SizeOf(MIXERCONTROLDETAILS_BOOLEAN);
        mxcd.paDetails := @mcdMute;
        intRet         := mixerGetControlDetails(hMix, @mxcd, MIXER_SETCONTROLDETAILSF_VALUE);
        Result         := not (mcdMute.fValue = 0);
        if Result then FCBState:= 1 else FCBState:= 0;
      End;
        End;
    if (intRet <> MMSYSERR_NOERROR) and Assigned(FCheckboxMute) then
          FCBState:= 2;
    intRet := mixerClose(hMix);
  End;
  if Assigned(FCheckboxMute) then
    FCheckboxMute.State:= TCheckboxState(FCBState);
End;

Function TdbpTrackbarVolume.GetVolume: Integer;
var RealOrd: Integer;
Begin
  Result:= 0;
  nMixerDevs := mixerGetNumDevs();
  If ((nMixerDevs < 1)) Then Exit;
  intRet := mixerOpen(@hMix, 0, 0, 0, 0);
  If (intRet = MMSYSERR_NOERROR) Then
  Begin
    RealOrd:= Ord(FMlct);
    if RealOrd>=9 then Inc(RealOrd, 4087);
    mxl.dwComponentType := RealOrd;
    mxl.cbStruct := SizeOf(mxl);
    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;
      End;
    End;
    SliderVisible:= (intRet = MMSYSERR_NOERROR);
    intRet := mixerClose(hMix);
  End;
End;

constructor TdbpTrackbarVolume.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FAbout         := __dbpTrackbarVolumeAbout;

  FPrecision     := prHigh;
  Max            := 65535;
  FMin           := 0;
  Orientation    := trVertical;
  Position       := Max;
  TickMarks      := tmBoth;
  ThumbLength    := 15;
  Width          := 33;

  FSilence       := False;

  fMixLinesNames := TStringList.Create;                { <v3.0> }
  MixerLineComponentTypeNamesToStrings(fMixLinesNames);   { <v3.0> }
  SetMlct(mlct_DST_SPEAKERS);                          { <v3.0> }

  FTimer := TTimer.Create(Self);
  FTimer.Interval:= 100;
  FTimer.Enabled:= True;
  FTimer.OnTimer:= ProcOnTimer;
end;

procedure TdbpTrackbarVolume.ProcOnTimer(Sender: TObject);
begin
  if Orientation = trVertical then
    Position:= Max - GetVolumeM(GetVolume)
  else
    Position:= GetVolumeM(GetVolume);
  FMute:= GetVolumeMute;
end;

destructor TdbpTrackbarVolume.Destroy;
begin
  if Assigned(FLabel) then
    FLabel.RemoveFreeNotification(Self);           { <v3.0> }

  if Assigned(FCheckboxMute) then
    FCheckboxMute.RemoveFreeNotification(Self);    { <v3.0> }

  FTimer.Enabled := false;
  FTimer.Free;

  FMixLinesNames.Free;                              { <v3.0> }
  inherited;
end;

procedure TdbpTrackbarVolume.Changed;
begin
  if Orientation = trVertical then
    SetVolumePourcent(Max - Position, True)
  else
    SetVolumePourcent(Position, True);
  if Assigned(FLabel) then
    FLabel.Caption:= IntToStr(100 - GetVolumeF(Position))+' %';
  inherited;
end;

procedure TdbpTrackbarVolume.SetVolumePourcent(Value: Integer);
begin
  SetVolumePourcent(Value, False);
end;

procedure TdbpTrackbarVolume.SetVolumePourcent(Value: Integer; Recalcul: Boolean);
begin
  if Recalcul then
    SetVolumeF(Round(GetVolumeF(Value) * 655.35))
  else
    SetVolumeF(Round(Value * 655.35));
end; { <v3.0> }

function TdbpTrackbarVolume.GetVolumeF(Value: Integer): Integer;
begin
  Result:= Round(Value / Max * 100);
  FPourcent:= Result;
end;

function TdbpTrackbarVolume.GetVolumeM(Value: Integer): Integer;
begin
  Result:= Round(Value / 65535 * Max);
end;

procedure TdbpTrackbarVolume.SetPrecision(Value: TPrecision);
var OldPourcent, RealPos: Integer;
begin
  if Value<>FPrecision then
  begin
    if Orientation=trVertical then
      Realpos:= Max - Position
    else
      Realpos:= Position;
    FPrecision:= Value;
    OldPourcent:= GetVolumeF(RealPos);
    case FPrecision of
      prHigh    : FMax:= 65535;
      prDefault : FMax:= 100;
      prLow     : FMax:= 10;
      prVeryLow : FMax:= 4;
      pzCustom  : FMax:= Max;
    end;
  Max:= FMax;
  SetVolumePourcent(OldPourcent, False);
  end;
end;

procedure TdbpTrackbarVolume.ProcOnCheckboxMute(Sender: TObject);
begin
  if Assigned(FOldOnClickMute) then
    FOldOnClickMute(Sender);
  SetVolumeMute(FCheckboxMute.Checked);
end;

procedure TdbpTrackbarVolume.SetCheckboxMute(Value: TCheckbox);
begin
  if Value <> FCheckboxMute then
  begin
    if Assigned(FCheckboxMute) then
      FCheckboxMute.RemoveFreeNotification(Self);

    FCheckboxMute:= Value;
    if Assigned(FCheckboxMute) then
    begin
      FCheckboxMute.FreeNotification(Self);
      FCheckboxMute.Checked:= FMute;
      FOldOnClickMute:= FCheckboxMute.OnClick;
      FCheckboxMute.OnClick:= ProcOnCheckboxMute;
    end;
  end;
end; { <v3.0> }

procedure TdbpTrackbarVolume.SetLabel(Value: TLabel);
begin
  if Value <> FLabel then
  begin
    if Assigned(FLabel) then
      FLabel.RemoveFreeNotification(Self);

    FLabel := Value;
    if Assigned(FLabel) then
    begin
      FLabel.FreeNotification(Self);
      FLabel.Caption:= IntToStr(100 - GetVolumeF(Position))+' %';
    end;
  end;
end; { <v3.0> }

function TdbpTrackbarVolume.GetDescription: string;
begin
  Result:= FDesc;
end;

procedure TdbpTrackbarVolume.SetMixLinesNames(Value: TStrings);
begin
  (fMixLinesNames as TStringList).Assign(Value);
end; { <v3.0> }

procedure TdbpTrackbarVolume.SetMlct(Value: TMixerLineComponentType);
begin
  if Value<>FMlct then
  begin
    FMlct := Value;
    FDesc := fMixLinesNames[Ord(FMlct)];
  end;
end;

procedure TdbpTrackbarVolume.SetSilence(Value: Boolean);
var RealPos: Integer;
begin
  if Value<>FSilence then
  begin
    if Orientation = trVertical then
    begin
      Realpos:= Max - Position;
      if Value then
        Position:= Max - Round(Realpos * 0.5)
      else
        Position:= Max - (Realpos shl 1);
    end
    else
    begin
      Realpos:= Position;
      if Value then
        Position:= Round(Realpos * 0.5)
      else
        Position:= Realpos shl 1;
    end;
  FSilence:= Value;
  end;
end; { <v3.0> }

end.