TAudioVolume Komponente incl. System Mixer

[TiGü]

Vom Smartphone schreiben ist schwierig, aber du kannst das machen:

Delphi-Quellcode:

TAudioVolume = class(TWinControl, IAudioSessionEvents, IMMNotificationClient, IAudioSessionNotification, IAudioEndpointVolumeCallback)

Dann halt wie gehabt die notwendigen Methoden hinzufügen.

[EWeiss]

Zitat:

Zitat von TiGü (Beitrag 1401745)

Vom Smartphone schreiben ist schwierig, aber du kannst das machen:

Delphi-Quellcode:

TAudioVolume = class(TWinControl, IAudioSessionEvents, IMMNotificationClient, IAudioSessionNotification, IAudioEndpointVolumeCallback)

Dann halt wie gehabt die notwendigen Methoden hinzufügen.

OK werde mal versuchen es umzusetzen.
Danke.

EDIT:
Schwierig.
Habe ja schon 2 x TAudioVolume

Delphi-Quellcode:

  TAudioVolume = class; // <<<<<
  TSplitStrArray = array of string;

  // ByMyAction is used to check if this event is triggered by self action, i.e., my application's
  // execution of SetMasterMute, SetMasterVolume, SetSysSoundMute or SetSysSoundVolume.
  TOnMasterVolumeEvent = procedure(ByMyAction: boolean; Volume: single; Mute: boolean) of object;
  TOnSessionVolumeEvent = procedure(ByMyAction: boolean; Volume: single; Mute: boolean) of object;
  TOnSessionStateEvent = procedure(Sender: TAudioVolume; NewState: integer) of object;
  TOnSessionDisconnected = procedure(Sender: TAudioVolume; DisconnectReason: uint) of object;
  TOnDeviceStateChange = procedure(DeviceId: string; NewDeviceState: DWORD) of object;
  TOnDefaultDeviceChange = procedure(NewDefaultDevice: TDeviceInfo) of object;
  TOnSessionCreated = procedure(NewSession: IAudioSessionControl) of object;

  TAudioVolume = class(TWinControl)// <<<<<<

Das

Delphi-Quellcode:

TAudioVolume = class(TWinControl)

zu ändern nach

Delphi-Quellcode:

TAudioVolume = class(TWinControl, IAudioSessionEvents, IMMNotificationClient, IAudioSessionNotification, IAudioEndpointVolumeCallback)

verträgt sich gar nicht.

Ich muss das MasterVolume von TAudioVolume trennen weil beim erstellen einer neuen Instanz von TAudioVolume alle Eigenschaften von MasterVolume nil sind.
Deshalb kann ich auch die Icons nicht freigeben.
Oder aber eine andere Lösung muss her ;) Hmmm...

Glaube das Konzept ist zur zeit noch sehr verworren.

gruss

[EWeiss]

@Tigü

Habe deinen Vorschlag umgesetzt aber sehe im Moment nicht wirklich irgendeinen Vorteil.
Es geht jetzt mal nur um die Events.

Beispiel:
Vorher!

Delphi-Quellcode:

TAudioEndpointEvents = class(TInterfacedObject, IAudioEndpointVolumeCallback)
  private
    MsgHandle: HWND;
    VolMute: TVolMute;
    EventContext: TGUID;
  public
    function OnNotify(pNotify: PAUDIO_VOLUME_NOTIFICATION_DATA): HResult; stdcall;
    procedure SetMsgHandle(WinHandle: HWND);
  end;

function TAudioEndpointEvents.OnNotify(pNotify: PAUDIO_VOLUME_NOTIFICATION_DATA): HResult; stdcall;
var
  VolumeData: AUDIO_VOLUME_NOTIFICATION_DATA;
begin
  VolumeData := pNotify^;
  VolMute.Volume := VolumeData.fMasterVolume;
  VolMute.Muted := VolumeData.bMuted;
  EventContext := VolumeData.guidEventContext;

  PostMessage(MsgHandle, WM_EndpointVolume, integer(@VolMute), integer(@EventContext));

  Result := S_OK;
end;

Nachher!

Delphi-Quellcode:

  TAudioVolume = class(TWinControl, IAudioSessionEvents, IMMNotificationClient,
    IAudioSessionNotification, IAudioEndpointVolumeCallback)
//...
  public
    function OnNotify(pNotify: PAUDIO_VOLUME_NOTIFICATION_DATA): HResult; stdcall;

Delphi-Quellcode:

function TAudioVolume.OnNotify(pNotify: PAUDIO_VOLUME_NOTIFICATION_DATA): HResult;
var
  VolumeData: AUDIO_VOLUME_NOTIFICATION_DATA;
begin
  VolumeData := pNotify^;
  VolMute.Volume := VolumeData.fMasterVolume;
  VolMute.Muted := VolumeData.bMuted;
  EventContext := VolumeData.guidEventContext;

  PostMessage(MsgHandle, WM_EndpointVolume, integer(@VolMute), integer(@EventContext));

  Result := S_OK;

end;

Wo ist jetzt der Vorteil von deiner <> meiner Auslegung?
Das erschließt sich mir nicht. Sorry

PS:
Hab Foobar 2000 mal installiert.
Und nein wie vorher schon gesagt es wird nie ein Event ausgelöst vom System.

Kein OnSessionCreated
Kein OnSessionDisconnected

gruss

[TiGü]

Jetzt kannst du das Postmessage weglassen und direkt reagieren.

[EWeiss]

Zitat:

Zitat von TiGü (Beitrag 1401754)

Jetzt kannst du das Postmessage weglassen und direkt reagieren.

OK nur mein bestreben ist das gerade keine unnötigen externen Funktionen ausgeführt werden müssen.
Die Komponente soll so einfach wie möglich gehalten werden.

zu dem basiert das komplette Control auf diesen Event.

Delphi-Quellcode:

    if not(csDesigning in ComponentState) then
      FEventHandle := AllocateHWnd(ProcessMsg);

Delphi-Quellcode:

procedure TAudioVolume.ProcessMsg(var Msg: TMessage);
var
  PVolMuteRec: PVolMute;
  Volume: single;
  Muted: boolean;
  Device: IMMDevice;
  DeviceId: WideString;
  DeviceInfo: TDeviceInfo;
  HR: HResult;
  NewState: DWORD;
  MyRegistry: TRegistry;
begin
  case Msg.Msg of

    WM_EndpointVolume:
      begin
        PVolMuteRec := PVolMute(Msg.WPARAM);
        if Assigned(tbMasterVolume) then
        begin
          tbMasterVolume.Position := round((1.0 - PVolMuteRec^.Volume) * tbMasterVolume.Max);
          ckMasterMute.Checked := PVolMuteRec^.Muted;
        end;
        if Assigned(tbMasterBalance) then
          AdjustMasterBalancePos;

        if Assigned(FOnMasterVolumeEvent) then
          FOnMasterVolumeEvent(MyVolSet, PVolMuteRec^.Volume, PVolMuteRec^.Muted);
      end;

    WM_VolumeEvent:
      begin
        PVolMuteRec := PVolMute(Msg.WPARAM);

        if MySessionVolSet or Assigned(FOnSessionVolumeEvent) then
        begin
          if Assigned(tbSessionVolume) or Assigned(FOnSessionVolumeEvent) then
          begin
            tbSessionVolume.Position := round((1.0 - PVolMuteRec^.Volume) * tbSessionVolume.Max);
            ckSessionMute.Checked := PVolMuteRec^.Muted;
          end;

          if (MySessionVolSet and (abs(PVolMuteRec^.Volume - MyVolVal) < 0.0001)) then
            MySessionVolSet := false
          else if (MyMuteSet and (PVolMuteRec^.Muted = MyMuteVal)) then
            MyMuteSet := false;

          if Assigned(tbSessionBalance) then
            AdjustSessionBalancePos;
        end;
      end;

    WM_SessionStateEvent:
      begin
        if Assigned(FOnSessionStateEvent) then
          FOnSessionStateEvent(self, Msg.WPARAM);
      end;

    WM_DeviceStateChange, WM_DeviceAdded, WM_DeviceRemoved:
      begin
        DeviceId := WideString(PWideChar(Msg.WPARAM));
        NewState := Msg.LPARAM;
        // Just refresh device list to simplify the logic.
        RefreshDeviceList(DeviceEnumerator);
        //  SetupDefaultAudioEndpoint(DeviceEnumerator);
        if Assigned(FOnDeviceStateChange) then
        begin
          if Msg.Msg = WM_DeviceStateChange then
            FOnDeviceStateChange(DeviceId, NewState)
          else if Msg.Msg = WM_DeviceAdded then
            FOnDeviceStateChange(DeviceId, DEVICE_STATE_ADDED)
          else if Msg.Msg = WM_DeviceRemoved then
            FOnDeviceStateChange(DeviceId, DEVICE_STATE_REMOVED);
        end;
      end;

    WM_SessionDisconnected:
      begin
        FAudioSessionList.SessionDisconnected := cAudioSessionDisconnected
          [TAudioSessionDisconnected(Msg.WPARAM)];

        if Assigned(FOnSessionDisconnected) then
          FOnSessionDisconnected(self, Msg.WPARAM);
      end;

    WM_SessionCreate:
      begin
        if Assigned(FOnSessionCreated) then
          FOnSessionCreated(IAudioSessionControl(@Msg.WPARAM));
      end;

    WM_DefaultDeviceChange:
      begin
        HR := DeviceEnumerator.GetDefaultAudioEndpoint(eRender, eMultimedia, Device);
        if HR <> S_OK then
          raise Exception.Create('Error : Unable to get DefaultAudioEndpoint Device');
        DeviceInfo := GetDeviceInfo(Device);
        if DeviceInfo.DeviceId <> FDefaultDevice.DeviceId then
        begin
          FDefaultDevice := DeviceInfo;
          if Assigned(FOnDefaultDeviceChange) then
            FOnDefaultDeviceChange(DeviceInfo);
        end;
      end;

    MM_MIXM_LINE_CHANGE:
      begin
        // wParam = (WPARAM) hMixer lParam = (LPARAM) dwLineID

      end;

    MM_MIXM_CONTROL_CHANGE:
      begin
        // wParam = (WPARAM) hMixer    lParam = (LPARAM) dwControlID
        if (DWORD(Msg.LPARAM) <> MasterMute.dwControlID) and
          (DWORD(Msg.LPARAM) <> MasterVol.dwControlID) then
          exit;

        Muted := IsMasterMuted;
        Volume := GetMasterVolume;
        if (DWORD(Msg.LPARAM) = MasterMute.dwControlID) then
        begin
          if (MyMuteSet and (Muted = MyMuteVal)) then
            MyMuteSet := false;
        end
        else
        // for (Msg.LParam = MasterVol.dwControlID)
          if (MyVolSet and (abs(Volume - MyVolVal) < 0.0001)) then
          MyVolSet := false;

        if Assigned(tbMasterVolume) then
        begin
          tbMasterVolume.Position := round((1.0 - Volume) * tbMasterVolume.Max);
          ckMasterMute.Checked := Muted;
        end;

        if Assigned(tbMasterBalance) then
          AdjustMasterBalancePos;
      end;
  else
    if Msg.Msg = WINMM_DEVICECHANGE then
    begin
      MyRegistry := TRegistry.Create;
      MyRegistry.RootKey := HKEY_CURRENT_USER;
      if MyRegistry.KeyExists('Software\Microsoft\Multimedia\Sound Mapper') then
        if MyRegistry.OpenKey('Software\Microsoft\Multimedia\Sound Mapper', true) then
          FDefaultDevice.DeviceName := MyRegistry.ReadString('Playback');
      MyRegistry.free;
    end
    else
      Msg.Result := DefWindowProc(FEventHandle, Msg.Msg, Msg.WPARAM, Msg.LPARAM);
  end;
end;

Kannst du dir vorstellen was ich dann alles ändern müsste?
Das ist nicht mal eben, mache die Events Public in TAudioVolume da hängt noch viel mehr von ab.

gruss

[TiGü]

Der Aufwand wäre nur, die ganze processmsg-Methode wegzumachen und die einzelnen Teile rauszukopieren und anstatt den jeweiligen PostMessage-Aufrufen hinzukopieren. Dazu noch prüfen if Mainthread <> GetCurrentThreadId then Sync.
Alles in allen keine 10 min Arbeit und auch nur wenn man sich sehr viel Zeit lässt beim Drücken von Strg+C und Strg+V.
Am Ende haste viel weniger Quelltext gesamt gesehen. Außerdem gehen dann die Sachen, wo du Referenzgezählte Sachen weiterreichst.

[EWeiss]

Zitat:

Alles in allen keine 10 min Arbeit und auch nur wenn man sich sehr viel Zeit lässt beim Drücken von Strg+C und Strg+V.

Ich verwende die Maus lieber als Tasten.

Wenn es bei dir < wie 10 Min dauert sollte es doch für dich kein Problem sein das eben mal umzubauen. ;)
Wäre zumindest produktiver als sich hier noch > 10 Min darüber zu unterhalten welche nun die bessere Lösung ist PostMessage oder deine Methode.
Letztendlich haben alle was davon und es wäre ein leichtes für dich.

Habe jetzt keinen Bock das alles wieder umzuschreiben zumal mein Aufwand dafür > wie 10 Min dauert geschätzt ne halbe Stunde.
In der zeit wo ich hier Editiert habe hätte es schon fertig sein können ;) sei's drum.

gruss

[EWeiss]

Ich erstelle eine neue Anwendung ohne den VCL Kram das nervt nur.
Ist fertig wenn fertig!

Werde die Bilder später wieder löschen.

gruss

[EWeiss]

Nur zur Info.
So wird das komplette Control erstellt.
Allerdings kann sich das während der Entwicklung noch leicht ändern.

Eine Kombination aus verschiedenen Bitmaps, Text und Fonts die zur Laufzeit registriert werden.
Die ID's werden inkrementiert abhängig vom Index.

ID_BVOLUME = Background-Volumen Picture. Der Rahmen der sich um die Controls legt!

Delphi-Quellcode:

ID := ID_BVOLUME + Index;

Durch das inkrementieren der ID's kann ich auf einfache weise mehrere Controls hintereinander erstellen.
Die Bedienung ist dann abhängig von der jeweiligen ID.
So kann man die Tollsten Fenster und Controls basteln das einzige Hindernis ist die eigene Kreativität.

Delphi-Quellcode:

procedure CreateVolumeCtrl(Index: Integer; UseFont: string; x1, y1, w, h: Integer; FontSize: Integer;
  Color: COLORREF; UseText: PWideChar);
var
  x, y: Integer;
  nX, nY: Integer;
  hBmp, hThumb: HBitmap;
  bmW, bmH: cardinal;
  IbmW, IbmH: Integer;
  ID: Integer;
begin

  // Hintergrund
  hBmp := gSprCtrl.GI_CreateBitmapFromFile(PWideChar(SpriteResPath + 'LBottom.png'), bmW, bmH);
  if (hBmp <> 0) then
  begin
    ParentWidth := bmW;
    ParentHeight := bmH;

    ID := ID_BVOLUME + Index;
    gSprCtrl.GD_DrawBitmapToCtrl(HSprCtrl, x1, y1, hBmp, gSprCtrl.GD_ColorARGB(255, 0), ID, GS_VISIBLE);
    gSprCtrl.GD_SetObjectLinked(ID, ID);
    gSprCtrl.GD_SetObjectLocked(ID, true);

    // Vordergrund
    hBmp := gSprCtrl.GI_CreateBitmapFromFile(PWideChar(SpriteResPath + 'LTop.png'), bmW, bmH);
    if (hBmp <> 0) then
    begin
      ID := ID_TVOLUME + Index;
      gSprCtrl.GD_DrawBitmapToCtrl(HSprCtrl, x1, y1, hBmp, gSprCtrl.GD_ColorARGB(255, 0),
        ID, GS_VISIBLE);
      gSprCtrl.GD_SetObjectLinked(ID, (ID_BVOLUME + Index));
      gSprCtrl.GD_SetObjectLocked(ID, true);

      // LCD vertikaler Slider Value
      x := x1 + 30;
      y := y1 + 74;

      if not Assigned(TTFLcd) then
        GDIP_LoadPrivateFontCollection(UseFont, TTFLcd, LcdFontName);

      ID := ID_SLIDER_LED + Index;
      gSprCtrl.GD_DrawTextToCtrlEx(HSprCtrl, UseText, x, y + 1, w, h, Color, PWideChar(LcdFontName)
          , TTFLcd, FontSize, ID, GS_VISIBLE, 0, Ord(StringAlignmentFar));

      gSprCtrl.GD_SetObjectLinked(ID, (ID_BVOLUME + Index));
      gSprCtrl.GD_SetObjectLocked(ID, true);

      GDIP_GetTextBound(MainClass.DeviceName, FontName, 13, bw, bh, nil, GD_TextHorzUp);

      // DeviceName
      x := x1  + ((ParentWidth - bw) div 2);
      y := 208;
      // Keinen privaten Font verwenden weil text sich zur Laufzeit ändern kann.
      ID := ID_DEVICENAME + Index;
      gSprCtrl.GD_DrawTextToCtrl(HSprCtrl, PWideChar(MainClass.DeviceName), x, y, gSprCtrl.GD_ARGB
          (255, 255, 255, 255), PWideChar(FontName), nil, 13, ID, GS_VISIBLE, 1, Ord
          (StringAlignmentNear));

      gSprCtrl.GD_SetObjectLinked(ID, (ID_BVOLUME + Index));
      gSprCtrl.GD_SetObjectLocked(ID, true);

      // vertikaler slider
      nX := x1 + 36;
      nY := y1 + 112;

      hBmp := gSprCtrl.GI_CreateBitmapFromFile(PWideChar(SpriteResPath + 'slideV.png'), bmW, bmH);
      if (hBmp <> 0) then
      begin
        hThumb := gSprCtrl.GI_CreateBitmapFromFile
          (PWideChar(SpriteResPath + 'thumbV.png'), bmW, bmH);
        if (hThumb <> 0) then
        begin
          gSprCtrl.GI_GetBitmapSize(hBmp, IbmW, IbmH);
          x := nX;
          y := nY;

          ID := ID_SLIDER_VERT + Index;
          gSprCtrl.GD_DrawBitmapToCtrl(HSprCtrl, x, y, hBmp, OPAQUEIMAGE, ID, GS_VISIBLE);
          gSprCtrl.GD_SetObjectLinked(ID, (ID_BVOLUME + Index));
          gSprCtrl.GD_SetObjectLocked(ID, true);

          y := nY + (IbmH div 2);
          gSprCtrl.GI_GetBitmapSize(hThumb, IbmW, IbmH);
          x := nX;
          y := y - (IbmH div 2 - 1);

          ID := ID_THUMB_VERT + Index;
          gSprCtrl.GD_DrawBitmapToCtrl(HSprCtrl, x, y, hThumb, OPAQUEIMAGE, ID, GS_VISIBLE);
          gSprCtrl.GD_SetObjectLinked(ID, (ID_BVOLUME + Index));
          gSprCtrl.GD_SetObjectLocked(ID, true);

          // Mute
          hBmp := gSprCtrl.GI_CreateBitmapFromFile(PWideChar(SpriteResPath + 'vSwitch.png'), bmW,
            bmH);
          x := x1 + (ParentWidth - Integer(bmW) div 2) - 23;
          y := y1 + ParentHeight - Integer(bmH);

          ID := ID_SWITCH + Index;
          gSprCtrl.GI_GetBitmapSize(hBmp, IbmW, IbmH);
          gSprCtrl.GD_DrawBitmapToCtrl(HSprCtrl, x, y, hBmp, $FFFFFFFF, ID, GS_VISIBLE);

          gSprCtrl.GD_SetObjectLinked(ID, (ID_BVOLUME + Index));
          gSprCtrl.GD_SetObjectFrameCount(ID, 2);
          gSprCtrl.GD_SetObjectFrameToUse(ID, 1);
          gSprCtrl.GD_SetObjectLocked(ID, true);

          // Anchor
          gSprCtrl.GD_SetObjectAnchorMode((ID_SLIDER_LED + Index), ANCHOR_CENTER);
          gSprCtrl.GD_SetObjectAnchorMode((ID_SLIDER_VERT + Index), ANCHOR_CENTER);
          gSprCtrl.GD_SetObjectAnchorMode((ID_THUMB_VERT + Index), ANCHOR_CENTER);
          gSprCtrl.GD_SetObjectAnchorMode((ID_SWITCH + Index), ANCHOR_CENTER);
          gSprCtrl.GD_SetObjectAnchorMode((ID_DEVICENAME + Index), ANCHOR_CENTER);
        end;
      end;
    end;
  end;
end;

Keine sorge Bilder werden später wieder gelöscht möchte nur den fortschritt dokumentieren.
Wie man sehen kann gibt es noch Probleme mit den Texten die überlagern sich.

gruss

[KodeZwerg]

Und das Grafikgenie liefert wieder eine Mona-Lisa, man bist Du gut! Auch wenn ich pers. es nicht gebrauchen kann freue ich mich darauf :)

Interessens-Frage nebenbei, kann man das ganze auch per Code steuern, also ohne Grafik?