Autor Beitrag
dino112
Hält's aus hier
Beiträge: 2



BeitragVerfasst: Mi 27.07.16 19:05 
Hallo Leute,

ich hab mich im Forum angemeldet, weil ich die Hilfe von Euch Profis benötige.
Vor gut 10 Jahren hat mir ein Bekannter ein kleines Programm mittels Delphi 7 erstellt, das
für Hausdurchsagen verwendet werden kann.
Das Programm wurde damals unter XP betrieben. Nun will ich das Programm wieder auf einem Windows 10
Rechner laufen lassen, jedoch funktioniert es nicht mehr so wie damals.

Es gibt insg. 3 Buttons "Hauptalarm" , "Kleinalarm" und "Hausdurchsage"
Bei allen Buttons wird jeweils eine MP3-Datei (Gong) abgespielt -> das funkioniert auch unter WIN10 problemlos.

Jedoch sollte dann das stummgeschaltete Mikrofon aktiviert werden, solange der Button gedrückt ist, damit dann
eben eine Durchsage gemacht werden kann - das geht aber leider nicht mehr!

Kann es sein, dass der Mixer und das Mikrofon unter Windows 10 andere Bezeichnungen haben?
Könnt Ihr mir hier bitte weiterhelfen? Für Euch Profis wird dies wohl eine Leichtigkeit sein :-)
Ich wäre Euch für Eure Hilfe sehr dankbar. Ich hab das gesammte Programm als ZIP angehängt.
Der Quelltext ist unten aufgeführt.

Viele Grüße
Dino

ausblenden volle Höhe 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:
unit fuego;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, mmSystem, ShellAPI;



type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    mic_an: TImage;
    mic_aus: TImage;
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);


  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function SetMicrophoneVolumeMute(bMute: Boolean): Boolean;
var
  hMix: HMIXER;
  mxlc: MIXERLINECONTROLS;
  mxcd: TMIXERCONTROLDETAILS;
  vol: TMIXERCONTROLDETAILS_UNSIGNED;
  mxc: MIXERCONTROL;
  mxl: TMixerLine;
  intRet: Integer;
  nMixerDevs: Integer;
  mcdMute: MIXERCONTROLDETAILS_BOOLEAN;
begin
  // Check if Mixer is available
  // Überprüfen, ob ein Mixer vorhanden ist
  nMixerDevs := mixerGetNumDevs();
  if (nMixerDevs < 1then
  begin
    Exit;
  end;

  // open the mixer
  // Mixer öffnen
  intRet := mixerOpen(@hMix, 0000);
  if intRet = MMSYSERR_NOERROR then
  begin
    mxl.dwComponentType := MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE;
    mxl.cbStruct        := SizeOf(mxl);

    // mixerline info
    intRet := mixerGetLineInfo(hMix, @mxl, MIXER_GETLINEINFOF_COMPONENTTYPE);

    if intRet = MMSYSERR_NOERROR then
    begin
      ZeroMemory(@mxlc, SizeOf(mxlc));
      mxlc.cbStruct := SizeOf(mxlc);
      mxlc.dwLineID := mxl.dwLineID;
      mxlc.dwControlType := MIXERCONTROL_CONTROLTYPE_MUTE;
      mxlc.cControls := 1;
      mxlc.cbmxctrl := SizeOf(mxc);
      mxlc.pamxctrl := @mxc;

      // Get the mute control
      // Mute control ermitteln
      intRet := mixerGetLineControls(hMix, @mxlc, MIXER_GETLINECONTROLSF_ONEBYTYPE);

      if intRet = MMSYSERR_NOERROR then
      begin
        ZeroMemory(@mxcd, SizeOf(mxcd));
        mxcd.cbStruct := SizeOf(TMIXERCONTROLDETAILS);
        mxcd.dwControlID := mxc.dwControlID;
        mxcd.cChannels := 1;
        mxcd.cbDetails := SizeOf(MIXERCONTROLDETAILS_BOOLEAN);
        mxcd.paDetails := @mcdMute;

        mcdMute.fValue := Ord(bMute);

        // set, unset mute
        // Stumsschalten ein/aus
        intRet := mixerSetControlDetails(hMix, @mxcd,
          MIXER_SETCONTROLDETAILSF_VALUE);
          {
          mixerGetControlDetails(hMix, @mxcd,
                                 MIXER_GETCONTROLDETAILSF_VALUE);
          Result := Boolean(mcdMute.fValue);
          }

        Result := intRet = MMSYSERR_NOERROR;

        if intRet <> MMSYSERR_NOERROR then
          ShowMessage('SetControlDetails Error');
      end
      else
        ShowMessage('GetLineInfo Error');
    end;

    intRet := mixerClose(hMix);
  end;
end;

procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ShellExecute(Application.Handle, 'open', PChar('c:\programme\fms\alarm\ALARMLICHT.EXE'), nilnil, sw_ShowNormal);
  PlaySOUND(PChar('hauptalarm.wav'),hInstance,snd_ASync );
  SetMicrophoneVolumeMute(False);
  mic_aus.Visible:=false;
end;

procedure TForm1.Button2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ShellExecute(Application.Handle, 'open', PChar('c:\programme\fms\alarm\ALARMLICHT.EXE'), nilnil, sw_ShowNormal);
  PlaySOUND(PChar('kleinalarm.wav'),hInstance,snd_ASync );
  SetMicrophoneVolumeMute(False);
  mic_aus.Visible:=false;
end;

procedure TForm1.Button3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  PlaySOUND(PChar('hausdurchsage.wav'),hInstance,snd_ASync );
  SetMicrophoneVolumeMute(False);
  mic_aus.Visible:=false;
end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 SetMicrophoneVolumeMute(True);
 mic_aus.Visible:=true;
end;

procedure TForm1.Button2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 SetMicrophoneVolumeMute(True);
 mic_aus.Visible:=true;
end;

procedure TForm1.Button3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 SetMicrophoneVolumeMute(True);
 mic_aus.Visible:=true;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 SetMicrophoneVolumeMute(True);
 mic_aus.Visible:=true;
end;

end.


Moderiert von user profile iconNarses: Delphi-Tags hinzugefügt
Moderiert von user profile iconNarses: Topic aus Delphi Language (Object-Pascal) / CLX verschoben am Mi 27.07.2016 um 21:07
Einloggen, um Attachments anzusehen!
t.roller
ontopic starontopic starontopic starontopic starontopic starofftopic starofftopic starofftopic star
Beiträge: 44
Erhaltene Danke: 10



BeitragVerfasst: Mi 27.07.16 19:18 
Es fehlen:
ALARMLICHT.EXE
hauptalarm.wav
kleinalarm.wav
hausdurchsage.wav
Solche Pfade sind in neueren WINDOWS-Versionen NICHT zulässig:
c:\programme\fms\alarm\ALARMLICHT.EXE

Besser z.B. so:
ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
function SpecialDirectory(const iID: Integer): string;  //uses ShlObj
var aPath  : array[0..MAX_PATH] of Char; pilTemp: PItemIDList;
begin
   try
      if SHGetSpecialFolderLocation(0, iID, pilTemp)=S_OK then begin
         if SHGetPathFromIDList(pilTemp, aPath) then begin
            Result := string(aPath);
         end else Result := ''; CoTaskMemFree(pilTemp);
      end else Result := '';
   except Result := '';
   end;
end;

function GetConfigPath: String;
var AppDir: String;
begin                       
  AppDir := SpecialDirectory(CSIDL_APPDATA)+'\MeinProgrammname';
  if DirectoryExists(AppDir) = false then mkdir(AppDir);
    result := AppDir+'\';
end;
dino112 Threadstarter
Hält's aus hier
Beiträge: 2



BeitragVerfasst: Mi 27.07.16 19:29 
Danke für die schnelle Antwort - jedoch ist die Datei ALARMLICHT.EXE nicht mein Problem.
Die Zeilen hierzu könnte ich auch auch rauslöschen - eine alte Funktion die nicht mehr genutzt wird.

Die Sounds werden auch beim Tastendruck problemlos abgespielt.
Das Problem ist nur, dass die "Mute"-Schaltung vom Mikrofon nicht mehr deaktiviert wird,
solange einer der drei Button gedrückt ist.

Ich möchte nämlich, dass das PC-Mikrofon stummgeschaltet bleibt, nur wenn eine Durchsage
gemacht werden soll und einer der drei Button gedrückt ist, soll das Mikrofon funktionieren.
jaenicke
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 18377
Erhaltene Danke: 1525

W10 x64 (Chrome, IE11)
Delphi 10.1 Ent, Oxygene, C# (VS 2015), JS/HTML, Java (NB), PHP, Lazarus
BeitragVerfasst: Do 28.07.16 07:58 
Antworten (Hinweis auf neue Sound API ab Vista) finden sich im Crosspost:
www.delphipraxis.net...er-windows-10-a.html

_________________
Alle eigenen Projekte sind eingestellt, ebenso meine Homepage, Downloadlinks usw. im Forum bleiben aktiv!