| Autor |
Beitrag |
JacK_Silent
Beiträge: 30
|
Verfasst: Do 25.10.07 21:15
Heyaaaaa =D
ich hab ein Programm geschrieben, welches alle 100ms die Lautstärke überprüft und bei Änderung ein OSD Canvas einblendet.
Nach dem Starten ist erst mal nix zu sehen von dem Programm erst wenn man die Master Lautstärke ändert, dann wird die Änderung angezeigt.
Mir ist aufgefallen, dass das Programm ständig immer mehr Speicher frisst.. am Anfang um die 4MB was schon viel zu viel ist und nach einer halben Stunde 8 MB - etwa...
Könnt ihr mir helfen meinen Sourcecode zu optimieren?
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
| unit OSD_u;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls, MMSystem;
function GetMasterVolume : Cardinal;
type
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormDblClick(Sender: TObject);
procedure Btn_CloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
public
end;
var
Form1: TForm1;
HRgn: THandle;
volume: string;
vol,save:cardinal;
implementation
{$R *.DFM}
function InitMixer: HMixer;
var
Err: MMRESULT;
begin
Err := mixerOpen(@Result, 0, 0, 0, 0);
if Err <> MMSYSERR_NOERROR then
Result := 0;
end;
function GetMasterVolumeControl(Mixer: hMixerObj;
var Control: TMixerControl): MMResult;
var
Line : TMixerLine;
Controls : TMixerLineControls;
begin
ZeroMemory(@Line, SizeOf(Line));
Line.cbStruct := SizeOf(Line);
Line.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
Result := mixerGetLineInfo(Mixer,
@Line,
MIXER_GETLINEINFOF_COMPONENTTYPE);
if Result = MMSYSERR_NOERROR then begin
ZeroMemory(@Controls, SizeOf(Controls));
Controls.cbStruct := SizeOf(Controls);
Controls.dwLineID := Line.dwLineID;
Controls.cControls := 1;
Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
Controls.cbmxctrl := SizeOf(Control);
Controls.pamxctrl := @Control;
Result := mixerGetLineControls(Mixer,
@Controls,
MIXER_GETLINECONTROLSF_ONEBYTYPE);
end;
end;
function GetMasterVolume : Cardinal;
var
MasterVolume : TMixerControl;
Details : TMixerControlDetails;
UnsignedDetails : TMixerControlDetailsUnsigned;
Code : MMResult;
Mixer : hMixerObj;
begin
Mixer := InitMixer;
Result := 0;
Code := GetMasterVolumeControl(Mixer, MasterVolume);
if(Code = MMSYSERR_NOERROR)then begin
with Details do begin
cbStruct := SizeOf(Details);
dwControlID := MasterVolume.dwControlID;
cChannels := 1; cMultipleItems := 0;
cbDetails := SizeOf(UnsignedDetails);
paDetails := @UnsignedDetails;
end;
if(mixerGetControlDetails(Mixer,
@Details,
MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR)then
result := UnsignedDetails.dwValue;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DeleteObject(HRgn);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
ReleaseCapture;
SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
end;
procedure TForm1.FormDblClick(Sender: TObject);
begin
DeleteObject(HRgn);
Canvas.Font.Name := 'Comic Sans MS';
Canvas.Font.Size := 64;
Canvas.Font.Style := [fsBold];
self.width:=Canvas.TextWidth(')))))))))))))')+100;
self.height:=Canvas.TextHeight(')))))))))))))')+10;
BeginPath(Canvas.Handle);
SetBkMode( Canvas.Handle, TRANSPARENT );
Canvas.TextOut(80, -6, volume);
Canvas.Font.Name := 'WebDings';
Canvas.Font.Size := 100;
Canvas.TextOut(5, 0, 'X');
canvas.Brush.color:=clred;
Canvas.Rectangle(0,0,width,height);
Canvas.Rectangle(5,5,width-5,height-5);
EndPath(Canvas.Handle);
HRgn := PathToRegion(Canvas.Handle);
SetWindowRgn(Handle, HRgn, True);
SetWindowPos(Handle,HWND_TOPMOST, 0, 0, 0, 0,SWP_NOMOVE + SWP_NOSIZE);
end;
procedure TForm1.Btn_CloseClick(Sender: TObject);
begin
Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Color := clLime;
Application.ShowMainForm := false;
vol:= GetMasterVolume;
save:=vol;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
vol:= GetMasterVolume;
if save <> vol then
begin
save:=vol;
if vol = 0 then volume:='x';
if (vol > 0) AND (vol < 5244) then begin Form1.Show; Timer1.Tag:=20; volume:=')'; end;
if (vol > 5243) AND (vol < 10487) then begin Form1.Show; Timer1.Tag:=20; volume:='))'; end;
if (vol > 10486) AND (vol < 15729) then begin Form1.Show; Timer1.Tag:=20; volume:=')))'; end;
if (vol > 15729) AND (vol < 20972) then begin Form1.Show; Timer1.Tag:=20; volume:='))))'; end;
if (vol > 20971) AND (vol < 26215) then begin Form1.Show; Timer1.Tag:=20; volume:=')))))'; end;
if (vol > 26214) AND (vol < 31458) then begin Form1.Show; Timer1.Tag:=20; volume:='))))))'; end;
if (vol > 31457) AND (vol < 36701) then begin Form1.Show; Timer1.Tag:=20; volume:=')))))))'; end;
if (vol > 36700) AND (vol < 41943) then begin Form1.Show; Timer1.Tag:=20; volume:='))))))))'; end;
if (vol > 41942) AND (vol < 47186) then begin Form1.Show; Timer1.Tag:=20; volume:=')))))))))'; end;
if (vol > 47185) AND (vol < 52429) then begin Form1.Show; Timer1.Tag:=20; volume:='))))))))))'; end;
if (vol > 52428) AND (vol < 57672) then begin Form1.Show; Timer1.Tag:=20; volume:=')))))))))))'; end;
if (vol > 57671) AND (vol < 62915) then begin Form1.Show; Timer1.Tag:=20; volume:='))))))))))))'; end;
if (vol > 62914) then begin Form1.Show; Timer1.Tag:=20; volume:=')))))))))))))'; end;
FormDblClick(Sender);
end;
if Timer1.Tag > 0 then Timer1.Tag:=Timer1.Tag-1 else begin Form1.Hide; end;
end;
end. |
Danke für eure Hilfe!
Ich füge das Teil auch mal als Dateianhang hinzu.Moderiert von  Narses: Topic aus Multimedia / Grafik verschoben am Do 25.10.2007 um 21:18
Einloggen, um Attachments anzusehen!
|
|
hathor
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Fr 26.10.07 00:44
Schönes Programm - ein bisschen verändert:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
| unit OSD_u;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls, MMSystem;
function GetMasterVolume : Cardinal;
type
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormDblClick(Sender: TObject);
procedure Btn_CloseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
public
end;
var
Form1: TForm1;
HRgn: THandle;
volume: string;
vol,save:cardinal;
j : integer;
implementation
{$R *.DFM}
function InitMixer: HMixer;
var
Err: MMRESULT;
begin
Err := mixerOpen(@Result, 0, 0, 0, 0);
if Err <> MMSYSERR_NOERROR then
Result := 0;
end;
function GetMasterVolumeControl(Mixer: hMixerObj;
var Control: TMixerControl): MMResult;
var
Line : TMixerLine;
Controls : TMixerLineControls;
begin
ZeroMemory(@Line, SizeOf(Line));
Line.cbStruct := SizeOf(Line);
Line.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
Result := mixerGetLineInfo(Mixer,
@Line,
MIXER_GETLINEINFOF_COMPONENTTYPE);
if Result = MMSYSERR_NOERROR then begin
ZeroMemory(@Controls, SizeOf(Controls));
Controls.cbStruct := SizeOf(Controls);
Controls.dwLineID := Line.dwLineID;
Controls.cControls := 1;
Controls.dwControlType := MIXERCONTROL_CONTROLTYPE_VOLUME;
Controls.cbmxctrl := SizeOf(Control);
Controls.pamxctrl := @Control;
Result := mixerGetLineControls(Mixer,
@Controls,
MIXER_GETLINECONTROLSF_ONEBYTYPE);
end;
end;
function GetMasterVolume : Cardinal;
var
MasterVolume : TMixerControl;
Details : TMixerControlDetails;
UnsignedDetails : TMixerControlDetailsUnsigned;
Code : MMResult;
Mixer : hMixerObj;
begin
Mixer := InitMixer;
Result := 0;
Code := GetMasterVolumeControl(Mixer, MasterVolume);
if(Code = MMSYSERR_NOERROR)then begin
with Details do begin
cbStruct := SizeOf(Details);
dwControlID := MasterVolume.dwControlID;
cChannels := 1; cMultipleItems := 0;
cbDetails := SizeOf(UnsignedDetails);
paDetails := @UnsignedDetails;
end;
if(mixerGetControlDetails(Mixer,
@Details,
MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR)then
result := UnsignedDetails.dwValue;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DeleteObject(HRgn);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
ReleaseCapture;
SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
end;
procedure TForm1.FormDblClick(Sender: TObject);
begin
DeleteObject(HRgn);
Canvas.Font.Name := 'Arial black'; Canvas.Font.Size := 32; Canvas.Font.Style := [fsBold];
self.width:=Canvas.TextWidth('▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐')+50; self.height:=Canvas.TextHeight('▐')+5;
BeginPath(Canvas.Handle);
SetBkMode( Canvas.Handle, TRANSPARENT );
Canvas.TextOut(50, -6, volume); Canvas.TextOut(420, -2, IntToStr(j));
Canvas.Font.Name := 'WebDings';
Canvas.Font.Size := 50; Canvas.TextOut(5, 0, 'X');
canvas.Brush.color:=clred;
Canvas.Rectangle(0,0,width,height);
Canvas.Rectangle(5,5,width-5,height-5);
EndPath(Canvas.Handle);
HRgn := PathToRegion(Canvas.Handle);
SetWindowRgn(Handle, HRgn, True);
SetWindowPos(Handle,HWND_TOPMOST, 0, 0, 0, 0,SWP_NOMOVE + SWP_NOSIZE);
end;
procedure TForm1.Btn_CloseClick(Sender: TObject);
begin
Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Color := clLime;
Application.ShowMainForm := false;
vol:= GetMasterVolume;
save:=vol;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var i : integer;
begin
vol:= GetMasterVolume;
if save <> vol then
begin
save:=vol;
if vol = 0 then volume:='X';
j:= abs(vol div 2500);
volume:= '';
for I := 0 to j do volume:= volume + '▐';
Form1.Show;
Timer1.Tag:=20;
FormDblClick(Sender);
end;
if Timer1.Tag > 0 then Timer1.Tag:=Timer1.Tag-1 else begin Form1.Hide; end;
end;
end. |
Leider wird der Quelltext verstümmelt - siehe Anhang:
Einloggen, um Attachments anzusehen!
|
|
JacK_Silent 
Beiträge: 30
|
Verfasst: Fr 26.10.07 09:41
Das Speicherproblem ist immer noch nicht gelöst!
Schau mal bitte in den Taskmanger, da sieht man das sehr gut.
|
|
hathor
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Fr 26.10.07 12:31
Habe die GetMasterVolume-Funktion geändert.
Einloggen, um Attachments anzusehen!
|
|
hathor
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: Sa 27.10.07 08:59
Hi,
ich habe hier eine verbesserte Version. Sie nutzt jetzt den Timer nur noch während der Zeit der Sichtbarkeit der Form. Das Programm bekommt eine Message vom Mixer, wenn die Lautstärke sich ändert.
Benötigt wird die Komponente AMIXER.
Die Source und die Komponente sind im Anhang.
Einloggen, um Attachments anzusehen!
|
|
BenBE
 
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: Sa 27.10.07 10:54
Typischer Fall von falscher Algorithmus *G*
Windows kann einem Programm mitteilen, wann sich die Lautstärke ändert. So macht es z.B. soundvol (auch als Lautstärke-Regelung von Windows bekannt).
Wie das aber grad genau funzt, hab ich grad nicht im Kopf, weiß nur, dass es geht ...
_________________ Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
|
|
JacK_Silent
Beiträge: 30
|
Verfasst: So 28.10.07 13:31
Ich werd mir die neue Komponente mal angucken. Die Lösung ist natürlich eleganter.
Gibt es noch eine Möglichkeit den Speicherverbrauch zu senken?
|
|
hathor
Ehemaliges Mitglied
Erhaltene Danke: 1
|
Verfasst: So 28.10.07 13:42
Hi,
ich verwende jetzt folgende Version ohne ext. Komponente.
Speicher: 6284 Bytes "fast" gleichbleibend.
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
| Function TForm1.GetVolumeA(DN: TDeviceName): Word;
Begin
nMixerDevs := mixerGetNumDevs();
If ((nMixerDevs < 1)) Then Exit;
intRet := mixerOpen(@hMix, 0, 0, 0, 0);
If (intRet = MMSYSERR_NOERROR) Then
Begin
Case DN Of
Master: mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_DST_SPEAKERS;
Microphone: mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE;
WaveOut: mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_WAVEOUT;
Synth: mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_SYNTHESIZER;
End;
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;
If (intRet <> MMSYSERR_NOERROR) Then
ShowMessage('GetControlDetails Error');
End
Else
ShowMessage('GetLineInfo Error');
End;
intRet := mixerClose(hMix);
End;
End; |
Einloggen, um Attachments anzusehen!
|
|
JacK_Silent
Beiträge: 30
|
Verfasst: Mo 29.10.07 21:11
Hier meine aktuelle Version:
Der Timer wird erst aktiviert, wenn eine Änderung der Systemlautstärke vorgenommen wird.
Einloggen, um Attachments anzusehen!
|
|
|
