Login | ViewVC Help
View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing
root/musikbox/trunk/VCL_WAVECONTROL/WaveControl.pas
Revision: 2
Committed: Sat Nov 10 16:57:29 2018 UTC (23 months, 2 weeks ago) by daniel-marschall
Content type: text/x-pascal
File size: 3224 byte(s)
Log Message:
Released source code of version 1.5 (20 February 2007) into SVN

File Contents

# Content
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.