Entwickler-Ecke

Algorithmen, Optimierung und Assembler - On Screen Volume Programm - Bitte um Codeoptimierung


JacK_Silent - Do 25.10.07 21:15
Titel: On Screen Volume Programm - Bitte um Codeoptimierung
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?


Delphi-Quelltext 
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
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  HRgn: THandle;
  volume: string;
  vol,save:cardinal;

  
implementation

{$R *.DFM}


///////////////////////////////GET_SOUND/////////////////////////////////////
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;  // set all channels
      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 user profile iconNarses: Topic aus Multimedia / Grafik verschoben am Do 25.10.2007 um 21:18


Delete - Fr 26.10.07 00:44
Schönes Programm - ein bisschen verändert:


Delphi-Quelltext 
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
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  HRgn: THandle;
  volume: string;
  vol,save:cardinal;
  j : integer;
  
implementation

{$R *.DFM}


///////////////////////////////GET_SOUND/////////////////////////////////////
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;  // set all channels
      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';  // Comic Sans MS
    Canvas.Font.Size  := 32;  //64
    Canvas.Font.Style := [fsBold];
    self.width:=Canvas.TextWidth('▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐▐')+50; ///100
    self.height:=Canvas.TextHeight('▐')+5; //10

    BeginPath(Canvas.Handle);
    SetBkMode( Canvas.Handle, TRANSPARENT );
    Canvas.TextOut(50, -6, volume);// + ' '+ IntToStr(j));  //80
    Canvas.TextOut(420, -2, IntToStr(j));
    Canvas.Font.Name  := 'WebDings';
    Canvas.Font.Size  := 50;  //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);
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:


JacK_Silent - 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.


Delete - Fr 26.10.07 12:31
Habe die GetMasterVolume-Funktion geändert.


Delete - 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.


BenBE - 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 ...


JacK_Silent - 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?


Delete - So 28.10.07 13:42
Hi,

ich verwende jetzt folgende Version ohne ext. Komponente.
Speicher: 6284 Bytes "fast" gleichbleibend.


Delphi-Quelltext 
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;


JacK_Silent - Mo 29.10.07 21:11
Hier meine aktuelle Version:

Der Timer wird erst aktiviert, wenn eine Änderung der Systemlautstärke vorgenommen wird.


Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!