Media Foundation Player

User_Russian · Post by **User_Russian** » Sat Feb 22, 2025 1:40 pm

Video player using technology MediaFoundation.

; https://www.purebasic.fr/english/viewtopic.php?t=86370
DeclareModule MFP
  ; Для Player_GetEvent().
  Enumeration
    #Event_Unknown
    #Event_Play
    #Event_Pause
    #Event_Stop
    #Event_Error
    #Event_Ended
    #Event_PlayingReady
  EndEnumeration
  
  ; Для Player_GetState().
  Enumeration
    #State_Empty
    #State_Stopped
    #State_Playing
    #State_Paused
    #State_Shutdown
  EndEnumeration
  
  ; Для Player_LoadFile().
  EnumerationBinary
    #LoadFile_Flag_MirrorX
    #LoadFile_Flag_MirrorY
  EndEnumeration
  
  ; Для Player_GetAspectRatioMode() и Player_SetAspectRatioMode().
  Enumeration
    #Player_ARMode_None = 0 ; Не сохранять соотношение сторон видео.
                            ; Растянуть видео, чтобы оно вписалось в выходной прямоугольник.
    #Player_ARMode_PreservePicture = 1; Сохраняет соотношение сторон видео с помощью леттербоксинга
                                      ; или в пределах выходного прямоугольника.
    #Player_ARMode_PreservePixel = 2  ; В настоящее время EVR игнорирует этот флаг.
                                      ; Исправьте соотношение сторон, если физический размер устройства отображения
                                      ; не соответствует разрешению дисплея.
                                      ; Например, если собственное разрешение монитора составляет 1600 на 1200 (4:3),
                                      ; а разрешение дисплея составляет 1280 на 1024 (5:4),
                                      ; монитор будет отображать неквадратные пиксели.
    #Player_ARMode_NonLinearStretch = 4 ; Применить нелинейное горизонтальное растяжение, если соотношение сторон
                                        ; целевого прямоугольника не совпадает с соотношением сторон
                                        ; исходного прямоугольника.
  EndEnumeration
  
  ; Для Player_SetVideoSourceRec и Player_GetVideoSourceRect().
  Structure PlayerFloatRect
    Left.f
    Top.f
    Right.f
    Bottom.f
  EndStructure
  
  Declare Player_LoadFile(File.s, hWnd, Flags.l=0)
  Declare Player_Free(*Obj)
  Declare Player_Play(*Obj)
  Declare Player_Pause(*Obj)
  Declare Player_Stop(*Obj)
  Declare Player_FrameStep(*Obj)
  Declare.q Player_GetPosition(*Obj)
  Declare Player_SetPosition(*Obj, Pos.q)
  Declare.q Player_GetDuration(*Obj)
  Declare Player_GetState(*Obj)
  Declare Player_GetEvent(*Obj)
  Declare Player_RegWinEvent(*Obj, hWnd, Msg)
  Declare Player_SetCallbackEvent(*Obj, *Callback)
  Declare.f Player_GetVolume(*Obj)
  Declare Player_SetVolume(*Obj, Volume.f)
  Declare.f Player_GetBalance(*Obj)
  Declare Player_SetBalance(*Obj, Balance.f)
  Declare Player_GetMute(*Obj)
  Declare Player_SetMute(*Obj, Mute)
  Declare Player_GetNativeVideoSize(*Obj, *pszVideo.SIZE, *pszARVideo.SIZE)
  Declare Player_GetIdealVideoSize(*Obj, *Min.Size, *Max.Size)
  Declare Player_GetVideoSourceRect(*Obj, *Source.PlayerFloatRect)
  Declare Player_SetVideoSourceRect(*Obj, *Source.PlayerFloatRect)
  Declare Player_GetAspectRatioMode(*Obj)
  Declare Player_SetAspectRatioMode(*Obj, Mode.l)
  Declare Player_GetVideoWindow(*Obj)
  Declare Player_UpdateVideo(*Obj)
  Declare.l Player_GetBorderColor(*Obj)
  Declare Player_SetBorderColor(*Obj, Color.l)
  Declare Player_GetUserData(*Obj)
  Declare Player_SetUserData(*Obj, *Data)
EndDeclareModule

Module MFP
  EnableExplicit
  
  Enumeration ; MFP_EVENT_TYPE
    #MFP_EVENT_TYPE_PLAY
    #MFP_EVENT_TYPE_PAUSE
    #MFP_EVENT_TYPE_STOP
    #MFP_EVENT_TYPE_POSITION_SET
    #MFP_EVENT_TYPE_RATE_SET
    #MFP_EVENT_TYPE_MEDIAITEM_CREATED
    #MFP_EVENT_TYPE_MEDIAITEM_SET
    #MFP_EVENT_TYPE_FRAME_STEP
    #MFP_EVENT_TYPE_MEDIAITEM_CLEARED
    #MFP_EVENT_TYPE_MF
    #MFP_EVENT_TYPE_ERROR
    #MFP_EVENT_TYPE_PLAYBACK_ENDED
    #MFP_EVENT_TYPE_ACQUIRE_USER_CREDENTIAL
  EndEnumeration
  
  Enumeration
    #MIRROR_NONE
    #MIRROR_HORIZONTAL
    #MIRROR_VERTICAL
  EndEnumeration
  
  
  Structure _PROPVARIANT Align #PB_Structure_AlignC
    vt.u
    wReserved1.u
    wReserved2.u
    wReserved3.u
    StructureUnion
      bVal.b
      cVal.c
      aVal.a
      wVal.w
      uVal.u
      lVal.l
      iVal.i
      qVal.q
      fVal.f
      dVal.d
      *pVal
    EndStructureUnion
  EndStructure
  
  Structure PROPVARIANT Align #PB_Structure_AlignC
    StructureUnion
      pv._PROPVARIANT
      decVal.q
    EndStructureUnion
    CompilerIf #PB_Compiler_Version < 600
      CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
        x64_padding.l ; В x64 структура имеет размер 24 бйта.
      CompilerEndIf
    CompilerElse
      CompilerIf #PB_Compiler_64Bit
        x64_padding.l ; В 64-бит структура имеет размер 24 бйта.
      CompilerEndIf
    CompilerEndIf
  EndStructure
  
  Structure PROPERTYKEY Align #PB_Structure_AlignC
    fmtid.GUID
    pid.l
  EndStructure
  
  Structure MFVideoNormalizedRect Align #PB_Structure_AlignC
    Left.f
    Top.f
    Right.f
    Bottom.f
  EndStructure
  
  Structure MFP_EVENT_HEADER Align #PB_Structure_AlignC
    eEventType.l  ; MFP_EVENT_TYPE
    hrEvent.l
    *pMediaPlayer.IMFPMediaPlayer
    eState.l
    *pPropertyStore.IPropertyStore
  EndStructure
    
  Interface IMFVideoProcessorControl Extends IUnknown
    SetBorderColor(*pBorderColor) ; MFARGB
    SetSourceRectangle(*pSrcRect.RECT)
    SetDestinationRectangle(*pDstRect.RECT)
    SetMirror(eMirror)
    SetRotation(eRotation)
    SetConstrictionSize(*pConstrictionSize.SIZE)
  EndInterface
    
  Interface IMFPMediaPlayerCallback Extends IUnknown
    OnMediaPlayerEvent.l(*pEventHeader.MFP_EVENT_HEADER)
  EndInterface
  
  
  Interface IPropertyStore Extends IUnknown
    GetCount.l(*cProps.Long)
    GetAt.l(iProp.l, *pkey.PROPERTYKEY)
    GetValue.l(*key.PROPERTYKEY, *pv.PROPVARIANT)
    SetValue.l(*key.PROPERTYKEY, *propvar.PROPVARIANT)
    Commit.l()
  EndInterface
  
  Interface IMFPMediaItem Extends IUnknown
    GetMediaPlayer.l(*ppMediaPlayer) ; .IMFPMediaPlayer
    GetURL.l(*ppwszURL)
    GetObject.l(*pIUnknown.IUnknown)
    GetUserData.l(*UserData)
    SetUserData.l(*UserData)
    GetStartStopPosition.l(*pguidStartPositionType.GUID, *pvStartValue.PROPVARIANT,
                         *pguidStopPositionType.GUID, *pvStopValue.PROPVARIANT)
    SetStartStopPosition.l(*pguidStartPositionType.GUID, *pvStartValue.PROPVARIANT,
                         *pguidStopPositionType.GUID, *pvStopValue.PROPVARIANT)
    HasVideo.l(*pfHasVideo, *pfSelected)
    HasAudio.l(*pfHasAudio, *pfSelected)
    IsProtected.l(*pfProtected)
    GetDuration.l(*guidPositionType, *pvDurationValue.PROPVARIANT)
    GetNumberOfStreams.l(*pdwStreamCount.Long)
    GetStreamSelection.l(dwStreamIndex.l, *pfEnabled)
    SetStreamSelection.l(dwStreamIndex.l, pfEnabled)
    GetStreamAttribute.l(dwStreamIndex.l, *guidMFAttribute, *pvValue.PROPVARIANT)
    GetPresentationAttribute.l(*guidMFAttribute, *pvValue.PROPVARIANT)
    GetCharacteristics.l(*pCharacteristics.Integer)
    SetStreamSink.l(dwStreamIndex.l, *pMediaSink.IUnknown)
    GetMetadata.l(*ppMetadataStor.IPropertyStore)
  EndInterface
  
  
  Interface IMFPMediaPlayer Extends IUnknown
    Play.l()
    Pause.l()
    Stop.l()
    FrameStep.l()
    SetPosition.l(*guidPositionType, *pvPositionValue.PROPVARIANT)
    GetPosition.l(*guidPositionType, *pvPositionValue.PROPVARIANT)
    GetDuration.l(*guidPositionType, *pvPositionValue.PROPVARIANT)
    SetRate.l(flRate.f)
    GetRate.l(*pflRate.Float)
    GetSupportedRates.l(fForwardDirection, *pflSlowestRate.Float, *pflFastestRate.Float)
    GetState.l(*peState.Integer)
    CreateMediaItemFromURL.l(URL.s, fSync, *dwUserData,  *ppMediaItem.IMFPMediaItem)
    CreateMediaItemFromObject.l(*pIUnknownObj.IUnknown, fSync, *dwUserData, *ppMediaItem.IMFPMediaItem)
    SetMediaItem.l(*pIMFPMediaItem.IMFPMediaItem)
    ClearMediaItem.l()
    GetMediaItem.l(*ppIMFPMediaItem.IMFPMediaItem)
    GetVolume.l(*pflVolume.Float)
    SetVolume.l(pflVolume.f)
    GetBalance.l(*pflBalance.Float)
    SetBalance.l(pflBalance.f)
    GetMute.l(*pfMute.Integer)
    SetMute.l(pfMute.i)
    GetNativeVideoSize.l(*pszVideo.SIZE,  *pszARVideo.SIZE)
    GetIdealVideoSize.l(*Min.Size, *Max.Size)
    SetVideoSourceRect.l(*pnrcSource.MFVideoNormalizedRect)
    GetVideoSourceRect.l(*pnrcSource.MFVideoNormalizedRect)
    SetAspectRatioMode.l(dwAspectRatioMode.l)
    GetAspectRatioMode.l(*pdwAspectRatioMode.Long)
    GetVideoWindow.l(*hWnd.Integer)
    UpdateVideo.l()
    SetBorderColor.l(Color.l)
    GetBorderColor.l(*pClr.Long)
    InsertEffect.l(*pEffect.IUnknown, fOptional)
    RemoveEffect.l(*pEffect.IUnknown)
    RemoveAllEffects.l()
    Shutdown.l()
  EndInterface
  
  Prototype pEventCallBack(*Event.MFP_EVENT_HEADER, *hPlayer)
  
  Structure PlayerParam Align #PB_Structure_AlignC
    Player.IMFPMediaPlayer
    PlayerCallback.IMFPMediaPlayerCallback
    PlayerEvent.l
    Reg_hWnd.i ; Окно в которое нужно отправлять сообщение Reg_Msg со статусом плеера.
    Reg_Msg.i
    *EventCallBack.pEventCallBack
    *UserData
  EndStructure
  
  Import "Mfplay.lib"
    MFPCreateMediaPlayer(File.s, fStartPlayback, creationOptions, *pCallback.IMFPMediaPlayerCallback,
                         hWnd, *pMediaPlayer.IMFPMediaPlayer)
  EndImport
  
  ImportC ""
    memset(*mem, val, num)
  EndImport
  
  Macro SafeRelease(Object)
    If Object
      Object\Release()
      Object = #Null
    EndIf 
  EndMacro
  
  Macro DEFINE_GUID(name, ll, u1, u2, a1, a2, a3, a4, a5, a6, a7, a8)
    DataSection
      name:
      Data.l ll
      Data.u u1, u2
      Data.a a1, a2, a3, a4, a5, a6, a7, a8
    EndDataSection
  EndMacro
  
  DEFINE_GUID(MFP_POSITIONTYPE_100NS, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0)
  DEFINE_GUID(CLSID_VideoProcessorMFT, $88753B26, $5B24, $49BD, $B2, $E7, $0C, $44, $5C, $78, $C9, $82)
  DEFINE_GUID(IID_IMFVideoProcessorControl, $A3F675D5, $6119, $4F7F, $A1, $00, $1D, $8B, $28, $0F, $0E, $FB)
  
  ;- Реализация IMFPMediaPlayerCallback
  ;{
  
  Prototype pEventCB(*Event.MFP_EVENT_HEADER, *Obj.PlayerParam)
  
  Structure sIMFP_CB Align #PB_Structure_AlignC
    *vt.IMFPMediaPlayerCallback
    *Obj.Integer
    *CB.pEventCB
    *UserData
    Counter.l
  EndStructure
  
  Procedure.l IMFP_CB_AddRef(*This.sIMFP_CB)
    *This\Counter+1
    ProcedureReturn *This\Counter
  EndProcedure
  
  Procedure.l IMFP_CB_QueryInterface(*This.sIMFP_CB, *riid.IID, *ppv.Integer)
    Protected Res.l = #E_FAIL
    
    If *ppv And *riid
      *ppv\i=0
      If CompareMemory(*riid, ?Interface_ID, SizeOf(GUID))
        *ppv\i=*This
        Res = #S_OK
        IMFP_CB_AddRef(*This)
      Else
        Res = #E_NOINTERFACE
      EndIf
    EndIf
    ProcedureReturn Res
    
    DataSection
      Interface_ID:
      Data.l $766C8FFB
      Data.u $5FDB, $4FEA
      Data.a $A2, $8D, $B9, $12, $99, $6F, $51, $BD
    EndDataSection
  EndProcedure
  
  Procedure.l IMFP_CB_Release(*This.sIMFP_CB)
    Protected Res.l
    *This\Counter-1
    Res = *This\Counter
    If Res<=0
      Res=0
      If *This\Obj
        If *This\Obj\i = *This
          *This\Obj\i=0
        CompilerIf #PB_Compiler_Debugger
        Else
          Debug #PB_Compiler_Procedure+"     *This\Obj\i <> *This"
        CompilerEndIf
        EndIf
      EndIf
      memset(*This, 0, SizeOf(sIMFP_CB))
      FreeMemory(*This)
      *This = 0
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure.l IMFP_CB_OnMediaPlayerEvent(*This.sIMFP_CB, *pEvent.MFP_EVENT_HEADER)
    If *This\CB
      *This\CB(*pEvent, *This\UserData)
    EndIf
  EndProcedure
  
  Procedure IMFP_CB_Init(*Obj.Integer, *ProcCB, *UserData)
    Protected *p.sIMFP_CB, Res.l=#E_FAIL
    
    If *Obj
      *p = AllocateMemory(SizeOf(sIMFP_CB))
      If *p
        *p\vt = ?VT
        *p\Counter=0
        *p\CB = *ProcCB
        *p\Obj = *Obj
        *Obj\i = *p
        *p\UserData=*UserData
        Res = #S_OK
      EndIf
    EndIf
    
    ProcedureReturn Res
    
    DataSection
      VT:
      Data.i @IMFP_CB_QueryInterface(), @IMFP_CB_AddRef(), @IMFP_CB_Release(), @IMFP_CB_OnMediaPlayerEvent()
    EndDataSection
  EndProcedure
  ;}
  ;- Завршение IMFPMediaPlayerCallback
  
  Procedure EventCB(*Event.MFP_EVENT_HEADER, *Obj.PlayerParam)
    Protected NoSendMsg = #False
    
    If *Obj
      Select *Event\eEventType
        Case #MFP_EVENT_TYPE_PLAY
          *Obj\PlayerEvent = #Event_Play
        Case #MFP_EVENT_TYPE_PAUSE
          *Obj\PlayerEvent = #Event_Pause
        Case #MFP_EVENT_TYPE_STOP
          *Obj\PlayerEvent = #Event_Stop
        Case #MFP_EVENT_TYPE_ERROR
          *Obj\PlayerEvent = #Event_Error
        Case #MFP_EVENT_TYPE_PLAYBACK_ENDED
          *Obj\PlayerEvent = #Event_Ended
        Case #MFP_EVENT_TYPE_MEDIAITEM_SET
          *Obj\PlayerEvent = #Event_PlayingReady
        Default
          NoSendMsg = #True
      EndSelect
      
      If *Obj\EventCallback
        *Obj\EventCallback(*Event, *Obj)
      EndIf
      
      If NoSendMsg = #False And *Obj\Reg_hWnd And *Obj\Reg_Msg
        PostMessage_(*Obj\Reg_hWnd, *Obj\Reg_Msg, *Obj\PlayerEvent, *Obj)
      EndIf
    EndIf
  EndProcedure
  
  
  ;- Экспортируемые процедуры.
    
  Procedure Player_LoadFile(File.s, hWnd, Flags.l=0)
    Protected *Obj.PlayerParam=AllocateMemory(SizeOf(PlayerParam))
    Protected VideoProc.IMFVideoProcessorControl, mi.IMFPMediaItem
    Protected mItem_File.s=#Null$, Err=#True, OS_Vers = OSVersion()
    
    If OS_Vers<#PB_OS_Windows_8 ; Отражения не поддерживаются
      Flags & ~(#LoadFile_Flag_MirrorX | #LoadFile_Flag_MirrorY) ; Сброс флагов отражения.
    EndIf
    
    If Flags & #LoadFile_Flag_MirrorX Or Flags & #LoadFile_Flag_MirrorY
      mItem_File = File
      File = #Null$
    EndIf
    
    If *Obj
      CoInitialize_(0)
      *Obj\PlayerEvent = #Event_Unknown
      
      If IMFP_CB_Init(@*Obj\PlayerCallback, @EventCB(), *Obj) = #S_OK
        If *Obj\PlayerCallback
          If MFPCreateMediaPlayer(File, 0, 0, *Obj\PlayerCallback, hWnd, @*Obj\Player) = #S_OK
            If *Obj\Player
              Err=#False
              
              If Flags & #LoadFile_Flag_MirrorX Or Flags & #LoadFile_Flag_MirrorY
                
                If Flags & #LoadFile_Flag_MirrorX
                  If CoCreateInstance_(?CLSID_VideoProcessorMFT, #Null,
                                       #CLSCTX_INPROC_SERVER, ?IID_IMFVideoProcessorControl, @VideoProc) = #S_OK
                    If VideoProc
                      VideoProc\SetMirror(#MIRROR_HORIZONTAL)
                      *Obj\Player\InsertEffect(VideoProc, #True)
                      SafeRelease(VideoProc)
                    EndIf
                  EndIf
                EndIf
                
                If Flags & #LoadFile_Flag_MirrorY
                  If CoCreateInstance_(?CLSID_VideoProcessorMFT, #Null,
                                       #CLSCTX_INPROC_SERVER, ?IID_IMFVideoProcessorControl, @VideoProc) = #S_OK
                    If VideoProc
                      VideoProc\SetMirror(#MIRROR_VERTICAL)
                      *Obj\Player\InsertEffect(VideoProc, #True)
                      SafeRelease(VideoProc)
                    EndIf
                  EndIf
                EndIf
                
                Err=#True
                
                If *Obj\Player\CreateMediaItemFromURL(mItem_File, #True, 0, @mi) = #S_OK
                  If mi
                    If *Obj\Player\SetMediaItem(mi) = #S_OK
                      Err=#False
                    EndIf
                    SafeRelease(mi)
                  EndIf
                EndIf
                
              EndIf
              
            EndIf
          EndIf
        EndIf
      EndIf
            
      If Err=#True
        Player_Free(*Obj)
        *Obj=0
      EndIf
    EndIf
    
    ProcedureReturn *Obj
  EndProcedure
  
  Procedure Player_Free(*Obj.PlayerParam)
    Protected Res=#False
    If *Obj
      If *Obj\Player
        Player_Stop(*Obj)
        *Obj\Player\Shutdown()
        *Obj\Player\Release()
        *Obj\Player=0
      EndIf
      SafeRelease(*Obj\PlayerCallback)
      Memset(*Obj, 0, SizeOf(PlayerParam))
      FreeMemory(*Obj)
      *Obj=0
      CoUninitialize_()
      Res = #True
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_Play(*Obj.PlayerParam)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *Obj\Player\Play() = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_Pause(*Obj.PlayerParam)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *Obj\Player\Pause() = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_Stop(*Obj.PlayerParam)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *Obj\Player\Stop() = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_FrameStep(*Obj.PlayerParam)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\FrameStep() = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  ; Текущая позиция вопросизведения в миллисекундах.
  Procedure.q Player_GetPosition(*Obj.PlayerParam)
    Protected Pos.q = 0, pv.PROPVARIANT
    If *Obj And *Obj\Player
      memset(@pv, 0, SizeOf(PROPVARIANT))
      If *Obj\Player\GetPosition(?MFP_POSITIONTYPE_100NS, @pv) = #S_OK
        Pos = pv\pv\qVal / 10000 ; Длительность в миллисекундах.
      EndIf
      PropVariantClear_(@pv)
    EndIf
    ProcedureReturn Pos
  EndProcedure
  
  Procedure Player_SetPosition(*Obj.PlayerParam, Pos.q)
    Protected Res = #False, pv.PROPVARIANT
    If *Obj And *Obj\Player
      memset(@pv, 0, SizeOf(PROPVARIANT))
      pv\pv\vt = #VT_I8
      pv\pv\qVal = Pos * 10000 ; Перевод из миллисекунд в сотни наносекунд.
      If *Obj\Player\SetPosition(?MFP_POSITIONTYPE_100NS, @pv) = #S_OK
        Res = #True
      EndIf
      PropVariantClear_(@pv)
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  ; Длительность видео в миллисекундах.
  Procedure.q Player_GetDuration(*Obj.PlayerParam)
    Protected Duration.q = 0, pv.PROPVARIANT
    If *Obj And *Obj\Player
      memset(@pv, 0, SizeOf(PROPVARIANT))
      If *Obj\Player\GetDuration(?MFP_POSITIONTYPE_100NS, @pv) = #S_OK
        Duration = pv\pv\qVal / 10000 ; Длительность в миллисекундах.
      EndIf
      PropVariantClear_(@pv)
    EndIf
    ProcedureReturn Duration
  EndProcedure
  
  ; Возвращает одну из констант #State_xxxx.
  Procedure Player_GetState(*Obj.PlayerParam)
    Protected State = #State_Empty
    If *Obj And *Obj\Player
      State = 0
      If *Obj\Player\GetState(@State) <> #S_OK
        State = #State_Empty
      EndIf
    EndIf
    ProcedureReturn State
  EndProcedure
  
  ; Возвращает одну из констант #Event_xxxx.
  Procedure Player_GetEvent(*Obj.PlayerParam)
    Protected Event = #Event_Unknown
    If *Obj
      Event = *Obj\PlayerEvent
    EndIf
    ProcedureReturn Event
  EndProcedure
  
  Procedure Player_RegWinEvent(*Obj.PlayerParam, hWnd, Msg)
    Protected Res = #False
    If *Obj
      *Obj\Reg_hWnd = hWnd
      *Obj\Reg_Msg  = Msg
      Res = #True
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_SetCallbackEvent(*Obj.PlayerParam, *Callback)
    Protected Res = #False
    If *Obj
      *obj\EventCallBack = *Callback
      Res = #True
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure.f Player_GetVolume(*Obj.PlayerParam)
    Protected Volume.f = 0
    If *Obj And *Obj\Player
      If *obj\Player\GetVolume(@Volume) <> #S_OK
        Volume = 0
      EndIf
    EndIf
    ProcedureReturn Volume
  EndProcedure
  
  ; Уровень громкости. Громкость выражается как уровень затухания, где 0.0 означает тишину,
  ; а 1.0 означает полную громкость.
  Procedure Player_SetVolume(*Obj.PlayerParam, Volume.f)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\SetVolume(Volume) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure.f Player_GetBalance(*Obj.PlayerParam)
    Protected Balance.f = 0
    If *Obj And *Obj\Player
      If *obj\Player\GetBalance(@Balance) <> #S_OK
        Balance = 0
      EndIf
    EndIf
    ProcedureReturn Balance
  EndProcedure
  
  ; Баланс звука. Значение может быть любым числом в следующем диапазоне (включительно).
  ; -1.0  - Левый канал на полной громкости, правый канал молчит.
  ; +1.0  - Правый канал на полной громкости, левый канал молчит.
  ; 0     - Оба канала с одинаковой громкостью.
  Procedure Player_SetBalance(*Obj.PlayerParam, Balance.f)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\SetBalance(Balance) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_GetMute(*Obj.PlayerParam)
    Protected Mute = #False, m=0
    If *Obj And *Obj\Player
      If *obj\Player\GetMute(@m) = #S_OK
        Mute = Bool(m)
      EndIf
    EndIf
    ProcedureReturn Mute
  EndProcedure
  
  Procedure Player_SetMute(*Obj.PlayerParam, Mute)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\SetMute(Bool(Mute = #True)) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  ; Получает размер и соотношение сторон видео.
  ; Эти значения вычисляются до того, как будет выполнено какое-либо масштабирование,
  ; чтобы вписать видео в целевое окно.
  ; *pszVideo - Получает размер видео в пикселях. Этот параметр может быть 0.
  ; *pszARVideo - Получает соотношение сторон изображения видео. Этот параметр может быть 0.
  Procedure Player_GetNativeVideoSize(*Obj.PlayerParam, *pszVideo.SIZE, *pszARVideo.SIZE)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\GetNativeVideoSize(*pszVideo, *pszARVideo) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  ; Получает диапазон размеров видео, которые могут быть отображены без существенного
  ; ухудшения производительности или качества изображения.
  ; *Min - минимальный размер.
  ; *Max - максимальный размер.
  Procedure Player_GetIdealVideoSize(*Obj.PlayerParam, *Min.Size, *Max.Size)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\GetIdealVideoSize(*Min, *Max) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  ; Указатель на структуру PlayerFloatRect,
  ; которая определяет исходный прямоугольник.
  ; Этот прямоугольник определяет, какая часть видео отображается.
  ; Он указывается в нормализованных координатах, которые определяются следующим образом:
  ; Верхний левый угол видеоизображения — (0, 0).
  ; Правый нижний угол видеоизображения — (1, 1).
  ; Если исходный прямоугольник — {0, 0, 1, 1}, отображается все изображение. Это значение по умолчанию.
  Procedure Player_GetVideoSourceRect(*Obj.PlayerParam, *Source.PlayerFloatRect)
    Protected Res = #False, Rect.MFVideoNormalizedRect
    If *Obj And *Obj\Player And *Source
      If *obj\Player\GetVideoSourceRect(@Rect) = #S_OK
        With *Source
          \Left  = Rect\Left
          \Top   = Rect\Top
          \Right = Rect\Right
          \Bottom= Rect\Bottom
        EndWith
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_SetVideoSourceRect(*Obj.PlayerParam, *Source.PlayerFloatRect)
    Protected Res = #False, Rect.MFVideoNormalizedRect
    If *Obj And *Obj\Player And *Source
      With Rect
        \Left  = *Source\Left
        \Top   = *Source\Top
        \Right = *Source\Right
        \Bottom= *Source\Bottom
      EndWith
      If *obj\Player\SetVideoSourceRect(@Rect) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_GetAspectRatioMode(*Obj.PlayerParam)
    Protected Mode = 0
    If *Obj And *Obj\Player
      If *obj\Player\GetAspectRatioMode(@Mode) <> #S_OK
        Mode = 0
      EndIf
    EndIf
    ProcedureReturn Mode
  EndProcedure
  
  ; Указывает, сохраняется ли соотношение сторон видео во время воспроизведения.
  ; Mode - Побитовое ИЛИ одного или нескольких флагов - констант #Player_ARMode_xxxx.
  Procedure Player_SetAspectRatioMode(*Obj.PlayerParam, Mode.l)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\SetAspectRatioMode(Mode) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_GetVideoWindow(*Obj.PlayerParam)
    Protected hWnd = 0
    If *Obj And *Obj\Player
      If *obj\Player\GetVideoWindow(@hWnd) <> #S_OK
        hWnd = 0
      EndIf
    EndIf
    ProcedureReturn hWnd
  EndProcedure
  
  Procedure Player_UpdateVideo(*Obj.PlayerParam)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\UpdateVideo() = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure.l Player_GetBorderColor(*Obj.PlayerParam)
    Protected Color.l = 0
    If *Obj And *Obj\Player
      If *obj\Player\GetBorderColor(@Color) <> #S_OK
        Color = 0
      EndIf
    EndIf
    ProcedureReturn Color
  EndProcedure
  
  Procedure Player_SetBorderColor(*Obj.PlayerParam, Color.l)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\SetBorderColor(Color) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_GetUserData(*Obj.PlayerParam)
    Protected *Data = 0
    If *Obj
      *Data = *Obj\UserData
    EndIf
    ProcedureReturn *Data
  EndProcedure
  
  Procedure Player_SetUserData(*Obj.PlayerParam, *Data)
    Protected Res = #False
    If *Obj
      *Obj\UserData = *Data
    EndIf
    ProcedureReturn Res
  EndProcedure
EndModule

An example of using this module.

Code: Select all

XIncludeFile "MediaFoundationPlayer.pb"
UseModule MFP
EnableExplicit

Define Event, *p, MovieName$

Procedure WinCB(hWnd, uMsg, wParam, lParam)
  If uMsg = #PB_Event_FirstCustomValue
    Select wParam
      Case #Event_PlayingReady
        Debug "Длительность видео "+Player_GetDuration(lParam)+" миллисекунд"
      Case #Event_Ended
        Player_SetPosition(lParam, 0) ; Зацикливание видео.
        Player_Play(lParam)
    EndSelect
  EndIf
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

MovieName$ = OpenFileRequester("", "", "Видео|*.avi;*.mp4;*.mpeg|All Files|*.*", 0)
If MovieName$
  OpenWindow(0, 100, 150, 400, 400, "", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
  *p=Player_LoadFile(MovieName$, WindowID(0))
  ;*p=Player_LoadFile(MovieName$, WindowID(0), #LoadFile_Flag_MirrorX|#LoadFile_Flag_MirrorY)
  If *p
    SetWindowCallback(@WinCB(), 0)
    Player_RegWinEvent(*p, WindowID(0), #PB_Event_FirstCustomValue)
    Player_Play(*p)
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
    Player_Free(*p)
  Else
    MessageRequester("", "Не полчилось откыть "+MovieName$)
  EndIf
EndIf

Quin · Post by **Quin** » Sat Feb 22, 2025 2:20 pm

Very cool, thanks for sharing

Zapman · Post by **Zapman** » Sat Feb 22, 2025 6:24 pm

Runs perfectly here (image and sound): Window 11. Tested with PB 6.2 x64 and 6.12 x86.

Thank you very much for sharing

Here is a version of the MediaFoundationPlayer.pb with comments translated to english:

Code: Select all

; https://www.purebasic.fr/english/viewtopic.php?t=86370
DeclareModule MFP
  ; For Player_GetEvent().
  Enumeration
    #Event_Unknown
    #Event_Play
    #Event_Pause
    #Event_Stop
    #Event_Error
    #Event_Ended
    #Event_PlayingReady
  EndEnumeration
  
  ; For Player_GetState().
  Enumeration
    #State_Empty
    #State_Stopped
    #State_Playing
    #State_Paused
    #State_Shutdown
  EndEnumeration
  
  ; For Player_LoadFile().
  EnumerationBinary
    #LoadFile_Flag_MirrorX
    #LoadFile_Flag_MirrorY
  EndEnumeration
  
  ; For Player_GetAspectRatioMode() and Player_SetAspectRatioMode().
  Enumeration
    #Player_ARMode_None = 0 ; Do not maintain the aspect ratio of the video.
                            ; Stretch the video to fit the output rectangle.
    #Player_ARMode_PreservePicture = 1; Maintains the aspect ratio of the video using letterboxing
                                      ; or within the output rectangle.
    #Player_ARMode_PreservePixel = 2  ; Currently, EVR ignores this flag.
                                      ; Correct the aspect ratio if the physical size of the display device
                                      ; does not match the display resolution.
                                      ; For example, if the native resolution of the monitor is 1600 by 1200 (4:3),
                                      ; and the display resolution is 1280 by 1024 (5:4),
                                      ; the monitor will display non-square pixels.
    #Player_ARMode_NonLinearStretch = 4 ; Apply nonlinear horizontal stretching if the aspect ratio
                                        ; of the target rectangle does not match the aspect ratio
                                        ; of the source rectangle.
  EndEnumeration
  
  ; For Player_SetVideoSourceRec and Player_GetVideoSourceRect().
  Structure PlayerFloatRect
    Left.f
    Top.f
    Right.f
    Bottom.f
  EndStructure
  
  Declare Player_LoadFile(File.s, hWnd, Flags.l=0)
  Declare Player_Free(*Obj)
  Declare Player_Play(*Obj)
  Declare Player_Pause(*Obj)
  Declare Player_Stop(*Obj)
  Declare Player_FrameStep(*Obj)
  Declare.q Player_GetPosition(*Obj)
  Declare Player_SetPosition(*Obj, Pos.q)
  Declare.q Player_GetDuration(*Obj)
  Declare Player_GetState(*Obj)
  Declare Player_GetEvent(*Obj)
  Declare Player_RegWinEvent(*Obj, hWnd, Msg)
  Declare Player_SetCallbackEvent(*Obj, *Callback)
  Declare.f Player_GetVolume(*Obj)
  Declare Player_SetVolume(*Obj, Volume.f)
  Declare.f Player_GetBalance(*Obj)
  Declare Player_SetBalance(*Obj, Balance.f)
  Declare Player_GetMute(*Obj)
  Declare Player_SetMute(*Obj, Mute)
  Declare Player_GetNativeVideoSize(*Obj, *pszVideo.SIZE, *pszARVideo.SIZE)
  Declare Player_GetIdealVideoSize(*Obj, *Min.Size, *Max.Size)
  Declare Player_GetVideoSourceRect(*Obj, *Source.PlayerFloatRect)
  Declare Player_SetVideoSourceRect(*Obj, *Source.PlayerFloatRect)
  Declare Player_GetAspectRatioMode(*Obj)
  Declare Player_SetAspectRatioMode(*Obj, Mode.l)
  Declare Player_GetVideoWindow(*Obj)
  Declare Player_UpdateVideo(*Obj)
  Declare.l Player_GetBorderColor(*Obj)
  Declare Player_SetBorderColor(*Obj, Color.l)
  Declare Player_GetUserData(*Obj)
  Declare Player_SetUserData(*Obj, *Data)
EndDeclareModule

Module MFP
  EnableExplicit
  
  Enumeration ; MFP_EVENT_TYPE
    #MFP_EVENT_TYPE_PLAY
    #MFP_EVENT_TYPE_PAUSE
    #MFP_EVENT_TYPE_STOP
    #MFP_EVENT_TYPE_POSITION_SET
    #MFP_EVENT_TYPE_RATE_SET
    #MFP_EVENT_TYPE_MEDIAITEM_CREATED
    #MFP_EVENT_TYPE_MEDIAITEM_SET
    #MFP_EVENT_TYPE_FRAME_STEP
    #MFP_EVENT_TYPE_MEDIAITEM_CLEARED
    #MFP_EVENT_TYPE_MF
    #MFP_EVENT_TYPE_ERROR
    #MFP_EVENT_TYPE_PLAYBACK_ENDED
    #MFP_EVENT_TYPE_ACQUIRE_USER_CREDENTIAL
  EndEnumeration
  
  Enumeration
    #MIRROR_NONE
    #MIRROR_HORIZONTAL
    #MIRROR_VERTICAL
  EndEnumeration
  
  
  Structure _PROPVARIANT Align #PB_Structure_AlignC
    vt.u
    wReserved1.u
    wReserved2.u
    wReserved3.u
    StructureUnion
      bVal.b
      cVal.c
      aVal.a
      wVal.w
      uVal.u
      lVal.l
      iVal.i
      qVal.q
      fVal.f
      dVal.d
      *pVal
    EndStructureUnion
  EndStructure
  
  Structure PROPVARIANT Align #PB_Structure_AlignC
    StructureUnion
      pv._PROPVARIANT
      decVal.q
    EndStructureUnion
    CompilerIf #PB_Compiler_Version < 600
      CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
        x64_padding.l ; In x64, the structure has a size of 24 bytes.
      CompilerEndIf
    CompilerElse
      CompilerIf #PB_Compiler_64Bit
        x64_padding.l ; In 64-bit, the structure has a size of 24 bytes.
      CompilerEndIf
    CompilerEndIf
  EndStructure
  
  Structure PROPERTYKEY Align #PB_Structure_AlignC
    fmtid.GUID
    pid.l
  EndStructure
  
  Structure MFVideoNormalizedRect Align #PB_Structure_AlignC
    Left.f
    Top.f
    Right.f
    Bottom.f
  EndStructure
  
  Structure MFP_EVENT_HEADER Align #PB_Structure_AlignC
    eEventType.l  ; MFP_EVENT_TYPE
    hrEvent.l
    *pMediaPlayer.IMFPMediaPlayer
    eState.l
    *pPropertyStore.IPropertyStore
  EndStructure
  
  Interface IMFVideoProcessorControl Extends IUnknown
    SetBorderColor(*pBorderColor) ; MFARGB
    SetSourceRectangle(*pSrcRect.RECT)
    SetDestinationRectangle(*pDstRect.RECT)
    SetMirror(eMirror)
    SetRotation(eRotation)
    SetConstrictionSize(*pConstrictionSize.SIZE)
  EndInterface
    
  Interface IMFPMediaPlayerCallback Extends IUnknown
    OnMediaPlayerEvent.l(*pEventHeader.MFP_EVENT_HEADER)
  EndInterface
  
  
  Interface IPropertyStore Extends IUnknown
    GetCount.l(*cProps.Long)
    GetAt.l(iProp.l, *pkey.PROPERTYKEY)
    GetValue.l(*key.PROPERTYKEY, *pv.PROPVARIANT)
    SetValue.l(*key.PROPERTYKEY, *propvar.PROPVARIANT)
    Commit.l()
  EndInterface
  
  Interface IMFPMediaItem Extends IUnknown
    GetMediaPlayer.l(*ppMediaPlayer) ; .IMFPMediaPlayer
    GetURL.l(*ppwszURL)
    GetObject.l(*pIUnknown.IUnknown)
    GetUserData.l(*UserData)
    SetUserData.l(*UserData)
    GetStartStopPosition.l(*pguidStartPositionType.GUID, *pvStartValue.PROPVARIANT,
                         *pguidStopPositionType.GUID, *pvStopValue.PROPVARIANT)
    SetStartStopPosition.l(*pguidStartPositionType.GUID, *pvStartValue.PROPVARIANT,
                         *pguidStopPositionType.GUID, *pvStopValue.PROPVARIANT)
    HasVideo.l(*pfHasVideo, *pfSelected)
    HasAudio.l(*pfHasAudio, *pfSelected)
    IsProtected.l(*pfProtected)
    GetDuration.l(*guidPositionType, *pvDurationValue.PROPVARIANT)
    GetNumberOfStreams.l(*pdwStreamCount.Long)
    GetStreamSelection.l(dwStreamIndex.l, *pfEnabled)
    SetStreamSelection.l(dwStreamIndex.l, pfEnabled)
    GetStreamAttribute.l(dwStreamIndex.l, *guidMFAttribute, *pvValue.PROPVARIANT)
    GetPresentationAttribute.l(*guidMFAttribute, *pvValue.PROPVARIANT)
    GetCharacteristics.l(*pCharacteristics.Integer)
    SetStreamSink.l(dwStreamIndex.l, *pMediaSink.IUnknown)
    GetMetadata.l(*ppMetadataStor.IPropertyStore)
  EndInterface
  
  
  Interface IMFPMediaPlayer Extends IUnknown
    Play.l()
    Pause.l()
    Stop.l()
    FrameStep.l()
    SetPosition.l(*guidPositionType, *pvPositionValue.PROPVARIANT)
    GetPosition.l(*guidPositionType, *pvPositionValue.PROPVARIANT)
    GetDuration.l(*guidPositionType, *pvPositionValue.PROPVARIANT)
    SetRate.l(flRate.f)
    GetRate.l(*pflRate.Float)
    GetSupportedRates.l(fForwardDirection, *pflSlowestRate.Float, *pflFastestRate.Float)
    GetState.l(*peState.Integer)
    CreateMediaItemFromURL.l(URL.s, fSync, *dwUserData,  *ppMediaItem.IMFPMediaItem)
    CreateMediaItemFromObject.l(*pIUnknownObj.IUnknown, fSync, *dwUserData, *ppMediaItem.IMFPMediaItem)
    SetMediaItem.l(*pIMFPMediaItem.IMFPMediaItem)
    ClearMediaItem.l()
    GetMediaItem.l(*ppIMFPMediaItem.IMFPMediaItem)
    GetVolume.l(*pflVolume.Float)
    SetVolume.l(pflVolume.f)
    GetBalance.l(*pflBalance.Float)
    SetBalance.l(pflBalance.f)
    GetMute.l(*pfMute.Integer)
    SetMute.l(pfMute.i)
    GetNativeVideoSize.l(*pszVideo.SIZE,  *pszARVideo.SIZE)
    GetIdealVideoSize.l(*Min.Size, *Max.Size)
    SetVideoSourceRect.l(*pnrcSource.MFVideoNormalizedRect)
    GetVideoSourceRect.l(*pnrcSource.MFVideoNormalizedRect)
    SetAspectRatioMode.l(dwAspectRatioMode.l)
    GetAspectRatioMode.l(*pdwAspectRatioMode.Long)
    GetVideoWindow.l(*hWnd.Integer)
    UpdateVideo.l()
    SetBorderColor.l(Color.l)
    GetBorderColor.l(*pClr.Long)
    InsertEffect.l(*pEffect.IUnknown, fOptional)
    RemoveEffect.l(*pEffect.IUnknown)
    RemoveAllEffects.l()
    Shutdown.l()
  EndInterface
  
  Prototype pEventCallBack(*Event.MFP_EVENT_HEADER, *hPlayer)
  
  Structure PlayerParam Align #PB_Structure_AlignC
    Player.IMFPMediaPlayer
    PlayerCallback.IMFPMediaPlayerCallback
    PlayerEvent.l
    Reg_hWnd.i ; Window to send the Reg_Msg message with the player status.
    Reg_Msg.i
    *EventCallBack.pEventCallBack
    *UserData
  EndStructure
  
  Import "Mfplay.lib"
    MFPCreateMediaPlayer(File.s, fStartPlayback, creationOptions, *pCallback.IMFPMediaPlayerCallback,
                         hWnd, *pMediaPlayer.IMFPMediaPlayer)
  EndImport
  
  ImportC ""
    memset(*mem, val, num)
  EndImport
  
  Macro SafeRelease(Object)
    If Object
      Object\Release()
      Object = #Null
    EndIf 
  EndMacro
  
  Macro DEFINE_GUID(name, ll, u1, u2, a1, a2, a3, a4, a5, a6, a7, a8)
    DataSection
      name:
      Data.l ll
      Data.u u1, u2
      Data.a a1, a2, a3, a4, a5, a6, a7, a8
    EndDataSection
  EndMacro
  
  DEFINE_GUID(MFP_POSITIONTYPE_100NS, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0, $0)
  DEFINE_GUID(CLSID_VideoProcessorMFT, $88753B26, $5B24, $49BD, $B2, $E7, $0C, $44, $5C, $78, $C9, $82)
  DEFINE_GUID(IID_IMFVideoProcessorControl, $A3F675D5, $6119, $4F7F, $A1, $00, $1D, $8B, $28, $0F, $0E, $FB)
  
  ;- Implementation of IMFPMediaPlayerCallback
  ;{
  
  Prototype pEventCB(*Event.MFP_EVENT_HEADER, *Obj.PlayerParam)
  
  Structure sIMFP_CB Align #PB_Structure_AlignC
    *vt.IMFPMediaPlayerCallback
    *Obj.Integer
    *CB.pEventCB
    *UserData
    Counter.l
  EndStructure
  
  Procedure.l IMFP_CB_AddRef(*This.sIMFP_CB)
    *This\Counter+1
    ProcedureReturn *This\Counter
  EndProcedure
  
  Procedure.l IMFP_CB_QueryInterface(*This.sIMFP_CB, *riid.IID, *ppv.Integer)
    Protected Res.l = #E_FAIL
    
    If *ppv And *riid
      *ppv\i=0
      If CompareMemory(*riid, ?Interface_ID, SizeOf(GUID))
        *ppv\i=*This
        Res = #S_OK
        IMFP_CB_AddRef(*This)
      Else
        Res = #E_NOINTERFACE
      EndIf
    EndIf
    ProcedureReturn Res
    
    DataSection
      Interface_ID:
      Data.l $766C8FFB
      Data.u $5FDB, $4FEA
      Data.a $A2, $8D, $B9, $12, $99, $6F, $51, $BD
    EndDataSection
  EndProcedure
  
    Procedure.l IMFP_CB_Release(*This.sIMFP_CB)
    Protected Res.l
    *This\Counter-1
    Res = *This\Counter
    If Res<=0
      Res=0
      If *This\Obj
        If *This\Obj\i = *This
          *This\Obj\i=0
        CompilerIf #PB_Compiler_Debugger
        Else
          Debug #PB_Compiler_Procedure+"     *This\Obj\i <> *This"
        CompilerEndIf
        EndIf
      EndIf
      memset(*This, 0, SizeOf(sIMFP_CB))
      FreeMemory(*This)
      *This = 0
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure.l IMFP_CB_OnMediaPlayerEvent(*This.sIMFP_CB, *pEvent.MFP_EVENT_HEADER)
    If *This\CB
      *This\CB(*pEvent, *This\UserData)
    EndIf
  EndProcedure
  
  Procedure IMFP_CB_Init(*Obj.Integer, *ProcCB, *UserData)
    Protected *p.sIMFP_CB, Res.l=#E_FAIL
    
    If *Obj
      *p = AllocateMemory(SizeOf(sIMFP_CB))
      If *p
        *p\vt = ?VT
        *p\Counter=0
        *p\CB = *ProcCB
        *p\Obj = *Obj
        *Obj\i = *p
        *p\UserData=*UserData
        Res = #S_OK
      EndIf
    EndIf
    
    ProcedureReturn Res
    
    DataSection
      VT:
      Data.i @IMFP_CB_QueryInterface(), @IMFP_CB_AddRef(), @IMFP_CB_Release(), @IMFP_CB_OnMediaPlayerEvent()
    EndDataSection
  EndProcedure
  ;}
  ;- End of IMFPMediaPlayerCallback implementation
  
  Procedure EventCB(*Event.MFP_EVENT_HEADER, *Obj.PlayerParam)
    Protected NoSendMsg = #False
    
    If *Obj
      Select *Event\eEventType
        Case #MFP_EVENT_TYPE_PLAY
          *Obj\PlayerEvent = #Event_Play
        Case #MFP_EVENT_TYPE_PAUSE
          *Obj\PlayerEvent = #Event_Pause
        Case #MFP_EVENT_TYPE_STOP
          *Obj\PlayerEvent = #Event_Stop
        Case #MFP_EVENT_TYPE_ERROR
          *Obj\PlayerEvent = #Event_Error
        Case #MFP_EVENT_TYPE_PLAYBACK_ENDED
          *Obj\PlayerEvent = #Event_Ended
        Case #MFP_EVENT_TYPE_MEDIAITEM_SET
          *Obj\PlayerEvent = #Event_PlayingReady
        Default
          NoSendMsg = #True
      EndSelect
      
      If *Obj\EventCallback
        *Obj\EventCallback(*Event, *Obj)
      EndIf
      
      If NoSendMsg = #False And *Obj\Reg_hWnd And *Obj\Reg_Msg
        PostMessage_(*Obj\Reg_hWnd, *Obj\Reg_Msg, *Obj\PlayerEvent, *Obj)
      EndIf
    EndIf
  EndProcedure
  
  
  ;- Exported procedures
    
  Procedure Player_LoadFile(File.s, hWnd, Flags.l=0)
    Protected *Obj.PlayerParam=AllocateMemory(SizeOf(PlayerParam))
    Protected VideoProc.IMFVideoProcessorControl, mi.IMFPMediaItem
    Protected mItem_File.s=#Null$, Err=#True, OS_Vers = OSVersion()
    
    If OS_Vers<#PB_OS_Windows_8 ; Reflections are not supported
      Flags & ~(#LoadFile_Flag_MirrorX | #LoadFile_Flag_MirrorY) ; Reset mirror flags.
    EndIf
    
    If Flags & #LoadFile_Flag_MirrorX Or Flags & #LoadFile_Flag_MirrorY
      mItem_File = File
      File = #Null$
    EndIf
    
    If *Obj
      CoInitialize_(0)
      *Obj\PlayerEvent = #Event_Unknown
      
      If IMFP_CB_Init(@*Obj\PlayerCallback, @EventCB(), *Obj) = #S_OK
        If *Obj\PlayerCallback
          If MFPCreateMediaPlayer(File, 0, 0, *Obj\PlayerCallback, hWnd, @*Obj\Player) = #S_OK
            If *Obj\Player
              Err=#False
              
              If Flags & #LoadFile_Flag_MirrorX Or Flags & #LoadFile_Flag_MirrorY
                
                If Flags & #LoadFile_Flag_MirrorX
                  If CoCreateInstance_(?CLSID_VideoProcessorMFT, #Null,
                                       #CLSCTX_INPROC_SERVER, ?IID_IMFVideoProcessorControl, @VideoProc) = #S_OK
                    If VideoProc
                      VideoProc\SetMirror(#MIRROR_HORIZONTAL)
                      *Obj\Player\InsertEffect(VideoProc, #True)
                      SafeRelease(VideoProc)
                    EndIf
                  EndIf
                EndIf
                
                If Flags & #LoadFile_Flag_MirrorY
                  If CoCreateInstance_(?CLSID_VideoProcessorMFT, #Null,
                                       #CLSCTX_INPROC_SERVER, ?IID_IMFVideoProcessorControl, @VideoProc) = #S_OK
                    If VideoProc
                      VideoProc\SetMirror(#MIRROR_VERTICAL)
                      *Obj\Player\InsertEffect(VideoProc, #True)
                      SafeRelease(VideoProc)
                    EndIf
                  EndIf
                EndIf
                
                Err=#True
                
                If *Obj\Player\CreateMediaItemFromURL(mItem_File, #True, 0, @mi) = #S_OK
                  If mi
                    If *Obj\Player\SetMediaItem(mi) = #S_OK
                      Err=#False
                    EndIf
                    SafeRelease(mi)
                  EndIf
                EndIf
                
              EndIf
              
            EndIf
          EndIf
        EndIf
      EndIf
            
      If Err=#True
        Player_Free(*Obj)
        *Obj=0
      EndIf
    EndIf
    
    ProcedureReturn *Obj
  EndProcedure
  
    Procedure Player_Free(*Obj.PlayerParam)
    Protected Res=#False
    If *Obj
      If *Obj\Player
        Player_Stop(*Obj)
        *Obj\Player\Shutdown()
        *Obj\Player\Release()
        *Obj\Player=0
      EndIf
      SafeRelease(*Obj\PlayerCallback)
      Memset(*Obj, 0, SizeOf(PlayerParam))
      FreeMemory(*Obj)
      *Obj=0
      CoUninitialize_()
      Res = #True
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_Play(*Obj.PlayerParam)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *Obj\Player\Play() = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_Pause(*Obj.PlayerParam)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *Obj\Player\Pause() = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_Stop(*Obj.PlayerParam)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *Obj\Player\Stop() = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_FrameStep(*Obj.PlayerParam)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\FrameStep() = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  ; Current playback position in milliseconds.
  Procedure.q Player_GetPosition(*Obj.PlayerParam)
    Protected Pos.q = 0, pv.PROPVARIANT
    If *Obj And *Obj\Player
      memset(@pv, 0, SizeOf(PROPVARIANT))
      If *Obj\Player\GetPosition(?MFP_POSITIONTYPE_100NS, @pv) = #S_OK
        Pos = pv\pv\qVal / 10000 ; Duration in milliseconds.
      EndIf
      PropVariantClear_(@pv)
    EndIf
    ProcedureReturn Pos
  EndProcedure
  
  Procedure Player_SetPosition(*Obj.PlayerParam, Pos.q)
    Protected Res = #False, pv.PROPVARIANT
    If *Obj And *Obj\Player
      memset(@pv, 0, SizeOf(PROPVARIANT))
      pv\pv\vt = #VT_I8
      pv\pv\qVal = Pos * 10000 ; Convert from milliseconds to hundred nanoseconds.
      If *Obj\Player\SetPosition(?MFP_POSITIONTYPE_100NS, @pv) = #S_OK
        Res = #True
      EndIf
      PropVariantClear_(@pv)
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  ; Video duration in milliseconds.
  Procedure.q Player_GetDuration(*Obj.PlayerParam)
    Protected Duration.q = 0, pv.PROPVARIANT
    If *Obj And *Obj\Player
      memset(@pv, 0, SizeOf(PROPVARIANT))
      If *Obj\Player\GetDuration(?MFP_POSITIONTYPE_100NS, @pv) = #S_OK
        Duration = pv\pv\qVal / 10000 ; Duration in milliseconds.
      EndIf
      PropVariantClear_(@pv)
    EndIf
    ProcedureReturn Duration
  EndProcedure
  
  ; Returns one of the #State_xxxx constants.
  Procedure Player_GetState(*Obj.PlayerParam)
    Protected State = #State_Empty
    If *Obj And *Obj\Player
      State = 0
      If *Obj\Player\GetState(@State) <> #S_OK
        State = #State_Empty
      EndIf
    EndIf
    ProcedureReturn State
  EndProcedure
  
  ; Returns one of the #Event_xxxx constants.
  Procedure Player_GetEvent(*Obj.PlayerParam)
    Protected Event = #Event_Unknown
    If *Obj
      Event = *Obj\PlayerEvent
    EndIf
    ProcedureReturn Event
  EndProcedure
  
  Procedure Player_RegWinEvent(*Obj.PlayerParam, hWnd, Msg)
    Protected Res = #False
    If *Obj
      *Obj\Reg_hWnd = hWnd
      *Obj\Reg_Msg  = Msg
      Res = #True
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_SetCallbackEvent(*Obj.PlayerParam, *Callback)
    Protected Res = #False
    If *Obj
      *obj\EventCallBack = *Callback
      Res = #True
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure.f Player_GetVolume(*Obj.PlayerParam)
    Protected Volume.f = 0
    If *Obj And *Obj\Player
      If *obj\Player\GetVolume(@Volume) <> #S_OK
        Volume = 0
      EndIf
    EndIf
    ProcedureReturn Volume
  EndProcedure
  
  ; Volume level. The volume is expressed as an attenuation level, where 0.0 means silence,
  ; and 1.0 means full volume.
  Procedure Player_SetVolume(*Obj.PlayerParam, Volume.f)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\SetVolume(Volume) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure.f Player_GetBalance(*Obj.PlayerParam)
    Protected Balance.f = 0
    If *Obj And *Obj\Player
      If *obj\Player\GetBalance(@Balance) <> #S_OK
        Balance = 0
      EndIf
    EndIf
    ProcedureReturn Balance
  EndProcedure
  
    ; Sound balance. The value can be any number in the following range (inclusive).
  ; -1.0  - Left channel at full volume, right channel silent.
  ; +1.0  - Right channel at full volume, left channel silent.
  ; 0     - Both channels at the same volume.
  Procedure Player_SetBalance(*Obj.PlayerParam, Balance.f)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\SetBalance(Balance) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_GetMute(*Obj.PlayerParam)
    Protected Mute = #False, m=0
    If *Obj And *Obj\Player
      If *obj\Player\GetMute(@m) = #S_OK
        Mute = Bool(m)
      EndIf
    EndIf
    ProcedureReturn Mute
  EndProcedure
  
  Procedure Player_SetMute(*Obj.PlayerParam, Mute)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\SetMute(Bool(Mute = #True)) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  ; Gets the size and aspect ratio of the video.
  ; These values are computed before any scaling is performed
  ; to fit the video into the target window.
  ; *pszVideo - Receives the video size in pixels. This parameter can be 0.
  ; *pszARVideo - Receives the aspect ratio of the video image. This parameter can be 0.
  Procedure Player_GetNativeVideoSize(*Obj.PlayerParam, *pszVideo.SIZE, *pszARVideo.SIZE)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\GetNativeVideoSize(*pszVideo, *pszARVideo) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  ; Gets the range of video sizes that can be displayed without significant
  ; performance degradation or image quality loss.
  ; *Min - minimum size.
  ; *Max - maximum size.
  Procedure Player_GetIdealVideoSize(*Obj.PlayerParam, *Min.Size, *Max.Size)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\GetIdealVideoSize(*Min, *Max) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  ; Pointer to the PlayerFloatRect structure,
  ; which defines the source rectangle.
  ; This rectangle defines which part of the video is displayed.
  ; It is specified in normalized coordinates, which are defined as follows:
  ; The top-left corner of the video image is (0, 0).
  ; The bottom-right corner of the video image is (1, 1).
  ; If the source rectangle is {0, 0, 1, 1}, the entire image is displayed. This is the default value.
  Procedure Player_GetVideoSourceRect(*Obj.PlayerParam, *Source.PlayerFloatRect)
    Protected Res = #False, Rect.MFVideoNormalizedRect
    If *Obj And *Obj\Player And *Source
      If *obj\Player\GetVideoSourceRect(@Rect) = #S_OK
        With *Source
          \Left  = Rect\Left
          \Top   = Rect\Top
          \Right = Rect\Right
          \Bottom= Rect\Bottom
        EndWith
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_SetVideoSourceRect(*Obj.PlayerParam, *Source.PlayerFloatRect)
    Protected Res = #False, Rect.MFVideoNormalizedRect
    If *Obj And *Obj\Player And *Source
      With Rect
        \Left  = *Source\Left
        \Top   = *Source\Top
        \Right = *Source\Right
        \Bottom= *Source\Bottom
      EndWith
      If *obj\Player\SetVideoSourceRect(@Rect) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_GetAspectRatioMode(*Obj.PlayerParam)
    Protected Mode = 0
    If *Obj And *Obj\Player
      If *obj\Player\GetAspectRatioMode(@Mode) <> #S_OK
        Mode = 0
      EndIf
    EndIf
    ProcedureReturn Mode
  EndProcedure
  
  ; Indicates whether the video aspect ratio is maintained during playback.
  ; Mode - A bitwise OR of one or more flags - constants #Player_ARMode_xxxx.
  Procedure Player_SetAspectRatioMode(*Obj.PlayerParam, Mode.l)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\SetAspectRatioMode(Mode) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_GetVideoWindow(*Obj.PlayerParam)
    Protected hWnd = 0
    If *Obj And *Obj\Player
      If *obj\Player\GetVideoWindow(@hWnd) <> #S_OK
        hWnd = 0
      EndIf
    EndIf
    ProcedureReturn hWnd
  EndProcedure
  
  Procedure Player_UpdateVideo(*Obj.PlayerParam)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\UpdateVideo() = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure.l Player_GetBorderColor(*Obj.PlayerParam)
    Protected Color.l = 0
    If *Obj And *Obj\Player
      If *obj\Player\GetBorderColor(@Color) <> #S_OK
        Color = 0
      EndIf
    EndIf
    ProcedureReturn Color
  EndProcedure
  
  Procedure Player_SetBorderColor(*Obj.PlayerParam, Color.l)
    Protected Res = #False
    If *Obj And *Obj\Player
      If *obj\Player\SetBorderColor(Color) = #S_OK
        Res = #True
      EndIf
    EndIf
    ProcedureReturn Res
  EndProcedure
  
  Procedure Player_GetUserData(*Obj.PlayerParam)
    Protected *Data = 0
    If *Obj
      *Data = *Obj\UserData
    EndIf
    ProcedureReturn *Data
  EndProcedure
  
  Procedure Player_SetUserData(*Obj.PlayerParam, *Data)
    Protected Res = #False
    If *Obj
      *Obj\UserData = *Data
    EndIf
    ProcedureReturn Res
  EndProcedure
EndModule

pjay · Post by **pjay** » Sun Feb 23, 2025 12:22 am

I tried to get some webcam functionality out of PB by using the Media Foundation functionality a couple of years ago and failed to get anywhere with it, I just couldn't wrap my head around the processes.

This is great - thanks for posting.

Post by **idle** » Sun Feb 23, 2025 6:36 am

Thanks for sharing

PureBasic Forums - English

Media Foundation Player

Media Foundation Player

Re: Media Foundation Player

Re: Media Foundation Player

Re: Media Foundation Player

Re: Media Foundation Player