Subversion Repositories musikbox

Rev

Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 daniel-mar 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.