Subversion Repositories musikbox

Rev

Blame | Last modification | View Log | RSS feed

  1. {=====================================================|
  2. | WaveControl 1.00 - (c) 1998 by John Mogesnen, DK    |
  3. |-----------------------------------------------------|
  4. | Change the WAV-Volume settings for Delphi 3         |
  5. | (16 and 32 bits)                                    |
  6. |-----------------------------------------------------|
  7. | E-Mail:    JMogensnen@Web4you.dk                    |
  8. |=====================================================}
  9. (* Attention: To enabled componentuser to change the
  10.               Update time remove the {} from the Code!*)
  11.  
  12. unit WaveControl;
  13.  
  14. interface
  15.  
  16. uses
  17.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  18.   ExtCtrls, ComCtrls;
  19.  
  20. type
  21.   TWaveVolumeSetting = class(TTrackBar)
  22.   private
  23.      FTimer : TTimer;
  24.      FInterval : Integer;
  25.  
  26. {     procedure SetInterval(Value : integer);}
  27.      procedure FTimerOnTimer(sender:TObject);
  28.      procedure OnTrackChange(Sender : TObject);
  29.      function GetTrackBar : integer;
  30.      procedure SetVolume;
  31.   protected
  32.   public
  33.      constructor Create (AOwner : TComponent); override;
  34.      destructor Destroy; override;
  35.   published
  36. {     property WavUpdateInterval: integer read FInterval write SetInterval;}
  37.   end;
  38.  
  39. procedure Register;
  40.  
  41. var
  42.   pCurrentVolumeLevel: PDWord;
  43.   CurrentVolumeLevel: DWord;
  44.   VolumeControlHandle: hWnd;
  45.   GetCurrentVolumeLevel: LPDWORD;
  46.  
  47. implementation
  48.  
  49. Uses Wave_System_Control;
  50.  
  51. procedure Register;
  52. begin
  53.   RegisterComponents('Samples', [TWaveVolumeSetting]);
  54. end;
  55.  
  56.  
  57. constructor TWaveVolumeSetting.Create (AOwner : TComponent);
  58. begin
  59.  inherited Create(Aowner);
  60.  New(pCurrentVolumeLevel);
  61.    Orientation := trVertical;
  62.    TickStyle := tsNone;
  63.    TickMarks := tmBoth;
  64.    Width := 27;
  65.    Height := 113;
  66.    min := 0;
  67.    max := 26;
  68.  
  69.    FInterval := 1;
  70.    FTimer := TTimer.create(self);
  71.    FTimer.Enabled := TRUE;
  72.    FTimer.interval := FInterval;
  73.    FTimer.OnTimer  := FTimerOnTimer;
  74.    OnChange := OnTrackChange;
  75.    SetVolume;
  76. end;
  77.  
  78.  
  79. destructor TWaveVolumeSetting.Destroy;
  80. begin
  81.   inherited Destroy;
  82. end;
  83.  
  84. {
  85. procedure TWaveVolumeSetting.SetInterval(Value: integer);
  86. begin
  87.   if (FInterval <> Value) then
  88.   begin
  89.     FInterval := Value;
  90.     FTimer.interval := FInterval;
  91.   end;
  92. end;
  93. }
  94.  
  95. function TWaveVolumeSetting.GetTrackBar: integer;
  96. begin
  97.   result := 65535 div max;
  98. end;
  99.  
  100.  
  101. procedure TWaveVolumeSetting.OnTrackChange(Sender : TObject);
  102. Var
  103.   x : Integer;
  104.  
  105. begin
  106.   IF Orientation=trVertical then
  107.      x := max - position
  108.      ELSE
  109.      x := position;
  110.  
  111.   CurrentVolumeLevel := (x * GetTrackBar shl 16) + (x * GetTrackBar);
  112.   WaveOutSetVolume(VolumeControlHandle, CurrentVolumeLevel);
  113. end;
  114.  
  115.  
  116. procedure TWaveVolumeSetting.SetVolume;
  117. begin
  118.   VolumeControlHandle := FindWindow('Volume Control', nil);
  119.   WaveOutGetVolume(VolumeControlHandle, pCurrentVolumeLevel);
  120.   CurrentVolumeLevel := pCurrentVolumeLevel^;
  121.  
  122.   IF Orientation=trVertical then
  123.      position := max - LoWord(CurrentVolumeLevel) DIV GetTrackBar
  124.      ELSE
  125.      position := LoWord(CurrentVolumeLevel) DIV GetTrackBar;
  126. end;
  127.  
  128.  
  129. procedure TWaveVolumeSetting.FTimerOnTimer(sender:TObject);
  130. begin
  131.   SetVolume;
  132. end;
  133.  
  134. end.
  135.