Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Programmproblem unter Windows 10 (https://www.delphipraxis.net/189834-programmproblem-unter-windows-10-a.html)

dino112 27. Jul 2016 19:16

Delphi-Version: 7

Programmproblem unter Windows 10
 
Liste der Anhänge anzeigen (Anzahl: 1)
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



Delphi-Quellcode:
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 < 1) then
  begin
    Exit;
  end;

  // open the mixer
  // Mixer öffnen
  intRet := mixerOpen(@hMix, 0, 0, 0, 0);
  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'), nil, nil, 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'), nil, nil, 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.

Luckie 27. Jul 2016 19:20

AW: Programmproblem unter Windows 10
 
Seit Vista hat sich da bei Windwos bezüglich der Multimediafunktionen viel geändert. Da wird man wohl einiges ändern müssen, wenn nicht sogar komplett neu schreiben.

dino112 27. Jul 2016 19:34

AW: Programmproblem unter Windows 10
 
Oh Mann - also schlechte Aussichten! Ich hatte gehofft, dass es eher unproblematisch sei
und nur einige Bezeichnungen geändert werden müssen. :(

Erdbär 27. Jul 2016 21:01

AW: Programmproblem unter Windows 10
 
Erstelle eine Desktop-Verknüpfung zur EXE, darauf Rechtsklicken und unter Eigenschaften/Kompatibilität den Kompatibilitätsmodus für XP einschalten.

Vielleicht hast Du ja Glück damit?

t.roller 27. Jul 2016 23:11

AW: Programmproblem unter Windows 10
 
Was mal für WIN2000 entwickelt wurde läuft schon lange nicht mehr:
MIXERLINE structure

jaenicke 28. Jul 2016 07:43

AW: Programmproblem unter Windows 10
 
Zitat:

Zitat von dino112 (Beitrag 1343631)
Oh Mann - also schlechte Aussichten! Ich hatte gehofft, dass es eher unproblematisch sei
und nur einige Bezeichnungen geändert werden müssen. :(

Mit Vista wurden die API und das zugrunde liegende Audiomodell komplett neu designed.

Die alten Funktionen sind zumindest teilweise noch da, auch die oben benutzten, und diese sprechen auch weiter den Mixer an. Das siehst du daran, dass während des Aufrufs im Debugger der Windows-Mixer, wenn du ihn offen hast, nicht mehr reagiert.

Allerdings steuerst du damit nur noch die anwendungsbezogenen Soundeinstellungen, so dass die globale Mikrofon-Funktion dadurch nicht berührt wird. Deshalb nutzt dir die alte API nichts mehr. Du musst die neue Sound API nutzen:
http://www.delphipraxis.net/117645-w...udio-apis.html


Alle Zeitangaben in WEZ +1. Es ist jetzt 01:48 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz