Composant tdbptrackbarvolume - jouez avec le son !

Télécharger le projet
Commenter

Description

Hello,
suite à cette source :
http://www.delphifr.com/codes/VOLUMESYSTRAY-OUVRIR-SNDVOL32-EXE-PLUS-RAPIDEMENT-WINDOWS_47706.aspx
J'ai créé un composant capable via windows api, de jouer avec le son de différents mixer control.
Le connaitre, le modifier, le mettre en muet, l'atténuer par exemple.
Possibilité de lui lier une checkbox pour le muet, un label pour le % du volume.
Possibilité de lui faire regler le volume via une simple methode "SetVolume(xx)" où xx est un % de volume désiré.
Une précision est réglable pour la visibilité du composant, ha, oui, c'est un dérivé de la trackbar bien sur.

Source / Exemple : 


{
+------------------------------------------------------------------------------+
| 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.

Conclusion :


Vos critiques sont les bienvenues, améliorez le s'il vous plait :)
ps : un .ex_ est présent dans le dossier demo pour les frileux. renommez le en .exe bien sur.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (JulioDelphi)