PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Need help making code x64 compatible

https://www.purebasic.fr/english/viewtopic.php?t=67252

Page 1 of 1

Need help making code x64 compatible

Posted: Tue Dec 20, 2016 1:39 am
by novablue
Hi, I already posted in another thread, hopefully this gets seen by more people in here.

http://www.purebasic.fr/english/viewtop ... 03#p498403

Re: Need help making code x64 compatible

Posted: Thu Dec 22, 2016 4:19 pm
by fryquez
Looks like a Bug with p-unicode.

I replaced these calls with normal string address and it works here in x64 :D

However this means it's unicode only!

Code: Select all

EnableExplicit

DeclareModule DshowMedia
  #VMR9_Windowed       = 1 << 0
  #VMR9_Windowless     = 1 << 1
  #VMR7_Windowed       = 1 << 2
  #VMR7_Windowless     = 1 << 3
  #OldVideoRenderer    = 1 << 4
  #OverlayMixer        = 1 << 5
  
  #WaveOutRenderer     = 1 << 6
  #DirectSoundRenderer = 1 << 7
  
  #VMR7_ForceOverlays  = 1 << 8
  #VMR7_ForceOffscreen = 1 << 9
  #DontKeepAR          = 1 << 10
  
  Enumeration ; MediaState
    #State_Stopped
    #State_Paused
    #State_Running
  EndEnumeration
  
  Enumeration ; MediaInfo
    #MEDIA_LENGTH
    #MEDIA_FPS
    #MEDIA_WIDTH
    #MEDIA_HEIGHT
    #MEDIA_POSITION
    #MEDIA_ASPECTRATIO_NUM
    #MEDIA_ASPECTRATIO_DEN
    #MEDIA_ASPECTRATIO
    #MEDIA_STATE
    #MEDIA_TIME_FRAMES
    #MEDIA_TIME_MSECS
  EndEnumeration
  
  Enumeration ; MediaSeeking
    #AM_SEEKING_NoPositioning
    #AM_SEEKING_AbsolutePositioning
  EndEnumeration
  
  Declare.i Resize(Object.i, x.i = #PB_Default, y.i = #PB_Default, width.i = #PB_Default, height.i = #PB_Default, keepAR.i = #True)
  Declare.i Load(Object.i, filename.s, Parent=0, flags.i = #VMR7_Windowed)
  Declare.i Play(Object.i)
  Declare.i Pause(Object.i)
  Declare.i Seek(Object.i, pos.q, SeekByFrame.i=#False)
  Declare.i Stop(Object.i)
  Declare.i Lenght(Object.i, mode.i = #MEDIA_TIME_MSECS)
  Declare.i Width(Object.i)
  Declare.i Height(Object.i)
  Declare.i ToggleFullscreen(Object.i)
  Declare.i Position(Object.i, mode.i = #MEDIA_TIME_MSECS)
  Declare.i State(Object.i)
  Declare.f FPS(Object.i) ; return .f cause we just need float precision
  Declare.i CaptureCurrMediaImage(Object.i, ResultingImgNo.i)
  Declare.i OnMediaEvent(Object.i)
  Declare.s Time2String(time.i)
  Declare.i GetVolume(Object.i) ; from -100db to 0db
  Declare.i PutVolume(Object.i, db.i) ; from -100db to 0db
  Declare.i PutBalance(Object.i, bal.i) ; -100 to +100
  Declare.i GetBalance(Object.i)        ; from -100 to +100
  Declare.i Close(Object.i)
  Declare.i IsMedia(Object.i)
  
  Declare.i CreateInstance()
  Declare.i FreeInstance(Object.i)
EndDeclareModule

Module DshowMedia 
  
  EnableExplicit
  
  #VMRMode_Windowed   = $1
  #VMRMode_Windowless = $2
  #VMRMode_Renderless = $4
  #VMRMode_Mask       = $7
  
  #S_OK  = 0
  #OATRUE = -1
  #OAFALSE = 0
  
  #CLSCTX_INPROC_SERVER  = $01
  #CLSCTX_INPROC_HANDLER = $02
  #CLSCTX_LOCAL_SERVER   = $04
  #CLSCTX_REMOTE_SERVER  = $10
  
  #CLSCTX_ALL    = #CLSCTX_INPROC_SERVER|#CLSCTX_INPROC_HANDLER|#CLSCTX_LOCAL_SERVER|#CLSCTX_REMOTE_SERVER
  #CLSCTX_INPROC = #CLSCTX_INPROC_SERVER|#CLSCTX_INPROC_HANDLER
  #CLSCTX_SERVER = #CLSCTX_INPROC_SERVER|#CLSCTX_LOCAL_SERVER|#CLSCTX_REMOTE_SERVER
  
  #MAX_FILTER_NAME = 128
  
  #WM_GRAPHEVENT = #WM_USER+1
  
  #EC_COMPLETE  = 1
  
  #RenderPrefs_ForceOffscreen               = $00000001
  #RenderPrefs_ForceOverlays                = $00000002
  #RenderPrefs_AllowOverlays                = $00000000
  #RenderPrefs_AllowOffscreen               = $00000000
  #RenderPrefs_DoNotRenderColorKeyAndBorder = $00000008
  #RenderPrefs_RestrictToInitialMonitor     = $00000010
  #RenderPrefs_PreferAGPMemWhenMixing       = $00000020
  #RenderPrefs_Mask                         = $0000003F
  
  #Default = 0
  
  Interface IGraphBuilder_forceUnicode
    QueryInterface(a, b)
    AddRef()
    Release()
    AddFilter(a, b)
    RemoveFilter(a)
    EnumFilters(a)
    FindFilterByName(a, b)
    ConnectDirect(a, b, c)
    Reconnect(a)
    Disconnect(a)
    SetDefaultSyncSource()
    Connect(a, b)
    Render(a)
    ;RenderFile(a, b)
    RenderFile(a, b)
    AddSourceFilter(a, b, c)
    SetLogFile(a)
    Abort()
    ShouldOperationContinue()
  EndInterface
  
  Structure Dshow_Interfaces
    Object.i
    pGraphBuilder.IGraphBuilder_forceUnicode
    pControl.IMediaControl
    pEvent.IMediaEventEx
    pWindow.IVideoWindow
    pAudio.IBasicAudio
    pVideo.IBasicVideo2
    pSeeking.IMediaSeeking
    thread.i
    fullscreen.i
    hwnd.i
    drain.i
    aspectRatio.f
    width.i
    widthPAR.i
    height.i
    renderer.i
  EndStructure
  
  CompilerIf Defined(FILTER_INFO, #PB_Structure) = #False
    Structure FILTER_INFO ; an official Dshow structure - actually missing in PB
      achName.w[#MAX_FILTER_NAME]
      *pGraph.IFilterGraph
    EndStructure
  CompilerEndIf
  
  CompilerIf Defined(CAUUID, #PB_Structure) = #False
    Structure CAUUID
      cElems.i
      *pElems 
    EndStructure
  CompilerEndIf
  
  CompilerIf Defined(IEnumFilters, #PB_Interface) = #False
    Interface IEnumFilters
      QueryInterface(a, b)
      AddRef()
      Release()
    Next(a, b, c) ;{
    Skip(a)
    Reset()
    Clone(a)
  EndInterface
CompilerEndIf

Macro SUCCEEDED(HRESULT)
  HRESULT & $80000000 = 0
EndMacro

Macro FAILED(HRESULT)
  HRESULT & $80000000
EndMacro

Macro _SafeRelease(__Object)
  If __Object
    __Object\Release()
    __Object = #Null
  EndIf
EndMacro

Macro _GetMediaObject(_Object_)
  Protected _Object_#.Dshow_Interfaces = Object_GetObject(g_DshowObjects, Object)
  If Not _Object_#
    Debug "Fatal Error: The given media no. hasn't been initialized!"
    CallDebugger
    ProcedureReturn #False
  EndIf
EndMacro

Macro CHECK_(in)
  CompilerIf #PB_Compiler_Debugger
    If Not SUCCEEDED(in#)
      Debug "Not succeeded at line " + Str(#PB_Compiler_Line)
      CallDebugger
    EndIf
  CompilerElse
    in#
  CompilerEndIf
EndMacro

Macro DEFINE_GUID(name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  Global name.GUID
  name\Data1 = l
  name\Data2 = w1
  name\Data3 = w2
  name\Data4[0] = b1
  name\Data4[1] = b2
  name\Data4[2] = b3
  name\Data4[3] = b4
  name\Data4[4] = b5
  name\Data4[5] = b6
  name\Data4[6] = b7
  name\Data4[7] = b8
EndMacro

;{ GUIDS
DEFINE_GUID(IID_IGraphBuilder,          $56A868A9, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaControl,          $56A868B1, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaEventEx,          $56A868C0, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaSeeking,          $36B73880, $C2C8, $11CF, $8B, $46, $00, $80, $5F, $6C, $EF, $60)
DEFINE_GUID(IID_IVideoWindow,           $56A868B4, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IBasicAudio,            $56A868B3, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IBasicVideo,            $56A868B5, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaSeeking,          $36B73880, $C2C8, $11CF, $8B, $46, $00, $80, $5F, $6C, $EF, $60)
DEFINE_GUID(IID_IBaseFilter,            $56A86895, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IVMRFilterConfig9,      $5A804648, $4F66, $4867, $9C, $43, $4F, $5C, $82, $2C, $F1, $B8)
DEFINE_GUID(IID_IVMRWindowlessControl9, $8F537D09, $F85E, $4414, $B2, $3B, $50, $2E, $54, $C7, $99, $27)
DEFINE_GUID(IID_IVMRFilterConfig,       $9E5530C5, $7034, $48B4, $BB, $46, $0B, $8A, $6E, $FC, $8E, $36)
DEFINE_GUID(IID_IVMRWindowlessControl,  $0EB1088C, $4DCD, $46F0, $87, $8F, $39, $DA, $E8, $6A, $51, $B7)
DEFINE_GUID(IID_IVMRAspectRatioControl, $EDE80B5C, $BAD6, $4623, $B5, $37, $65, $58, $6C, $9F, $8D, $FD)
DEFINE_GUID(IID_IVMRAspectRatioControl9,$00D96C29, $BBDE, $4EFC, $99, $01, $BB, $50, $36, $39, $21, $46)
DEFINE_GUID(IID_ISpecifyPropertyPages,  $B196B28B, $BAB4, $101A, $B6, $9C, $00, $AA, $00, $34, $1D, $07)
DEFINE_GUID(IID_IUnknown,               $00000000, $0000, $0000, $C0, $00, $00, $00, $00, $00, $00, $46)

DEFINE_GUID(IID_IDvdGraphBuilder,       $FCC152B6, $F372, $11D0, $8E, $00, $00, $C0, $4F, $D7, $C0, $8B)
DEFINE_GUID(IID_IDvdControl2,           $33BC7430, $EEC0, $11D2, $82, $01, $00, $A0, $C9, $D7, $48, $42)
DEFINE_GUID(IID_IDvdInfo2,              $34151510, $EEC0, $11D2, $82, $01, $00, $A0, $C9, $D7, $48, $42)

DEFINE_GUID(CLSID_FilterGraph,          $E436EBB3, $524F, $11CE, $9F, $53, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(CLSID_VideoMixingRenderer,  $B87BEB7B, $8D29, $423F, $AE, $4D, $65, $82, $C1, $01, $75, $AC)
DEFINE_GUID(CLSID_VideoMixingRenderer9, $51B4ABF3, $748F, $4E3B, $A2, $76, $C8, $28, $33, $0E, $92, $6A)
DEFINE_GUID(CLSID_OverlayMixer,         $CD8743A1, $3736, $11D0, $9E, $69, $00, $C0, $4F, $D7, $C1, $5B)
DEFINE_GUID(CLSID_VideoRenderer,        $70E102B0, $5556, $11CE, $97, $C0, $00, $AA, $00, $55, $59, $5A)
DEFINE_GUID(CLSID_AudioRender,          $E30629D1, $27E5, $11CE, $87, $5D, $00, $60, $8C, $B7, $80, $66)
DEFINE_GUID(CLSID_DSoundRender,         $79376820, $07D0, $11CF, $A2, $4D, $00, $20, $AF, $D7, $97, $67)
DEFINE_GUID(TIME_FORMAT_MEDIA_TIME,     $7B785574, $8C82, $11CF, $BC, $0C, $00, $AA, $00, $AC, $74, $F6)
DEFINE_GUID(TIME_FORMAT_FRAME,          $7B785570, $8C82, $11CF, $BC, $0C, $00, $AA, $00, $AC, $74, $F6)
;}

Import "ObjectManager.lib"
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
    Object_GetOrAllocateID(*Objects, Object.i) As "_PB_Object_GetOrAllocateID@8"
    Object_GetObject(*Objects, Object.i) As "_PB_Object_GetObject@8"
    Object_IsObject(*Objects, Object.i) As "_PB_Object_IsObject@8"
    Object_FreeID(*Objects, Object.i) As "_PB_Object_FreeID@8"
    Object_Init(structuresize.i, IncrementStep.i, *ObjectFreeFunction) As "_PB_Object_Init@12"
  CompilerElse
    Object_GetOrAllocateID(*Objects, Object.i) As "PB_Object_GetOrAllocateID"
    Object_GetObject(*Objects, Object.i) As "PB_Object_GetObject"
    Object_IsObject(*Objects, Object.i) As "PB_Object_IsObject"
    Object_FreeID(*Objects, Object.i) As "PB_Object_FreeID"
    Object_Init(structuresize.i, IncrementStep.i, *ObjectFreeFunction) As "PB_Object_Init"
  CompilerEndIf
EndImport:IsWindow(#PB_Any)

Global g_DshowObjects.i
Global g_MediaFullscreen.b
Global NewList filters.s()

; Private Procedures

Procedure _DeleteInterfaces(Object.i)
  _GetMediaObject(*object)
  _SafeRelease(*object\pControl)
  _SafeRelease(*object\pEvent)
  _SafeRelease(*object\pWindow)
  _SafeRelease(*object\pAudio)
  _SafeRelease(*object\pVideo)
  _SafeRelease(*object\pSeeking)
  _SafeRelease(*object\pGraphBuilder)
  ProcedureReturn #True
EndProcedure

Procedure _BuildInterfaces(Object.i)
  _GetMediaObject(*object)
  Protected a.i, b.i, c.i, d.i, e.i, f.i
  If Not CoCreateInstance_(@CLSID_FilterGraph, #Null, #CLSCTX_INPROC_SERVER, @IID_IGraphBuilder, @*object\pGraphBuilder) = #S_OK
    Debug "Error: Couldn't initialize the GraphBuilder Interface"
    CallDebugger
    ProcedureReturn #False
  Else
    *object\Object = #True
    a = *object\pGraphBuilder\QueryInterface(@IID_IMediaControl, @*object\pControl)
    b = *object\pGraphBuilder\QueryInterface(@IID_IMediaEventEx, @*object\pEvent)
    c = *object\pGraphBuilder\QueryInterface(@IID_IVideoWindow,  @*object\pWindow)
    d = *object\pGraphBuilder\QueryInterface(@IID_IBasicAudio,   @*object\pAudio)
    e = *object\pGraphBuilder\QueryInterface(@IID_IBasicVideo,   @*object\pVideo)
    f = *object\pGraphBuilder\QueryInterface(@IID_IMediaSeeking, @*object\pSeeking)
    If SUCCEEDED(a) And SUCCEEDED(b) And SUCCEEDED(c) And SUCCEEDED(d) And SUCCEEDED(e) And SUCCEEDED(f) ; Quick check
      ProcedureReturn #True
    Else
      _DeleteInterfaces(Object)
      Debug "Error: Query of at least one of the needed Interfaces failed"
      CallDebugger
      ProcedureReturn #False
    EndIf
  EndIf
EndProcedure

Procedure MoveWindow()
  If Not g_MediaFullscreen
    ReleaseCapture_()
    SendMessage_(GetForegroundWindow_(), #WM_SYSCOMMAND, #SC_MOVE + #HTCAPTION, 0)
  EndIf
EndProcedure

Procedure ToggleCursorFullscreen(*object.Dshow_Interfaces)
  Protected res.i, x.i = WindowMouseX(0), y.i = WindowMouseY(0), button.i, cursor.i = #True, reset.i = ElapsedMilliseconds(), KeyStroke.INPUT
  Repeat
    Delay(100)
    If g_MediaFullscreen
      If cursor
        If ElapsedMilliseconds() - reset > 2 * 1000 ; 2 Secs.
          *object\pWindow\HideCursor(#OATRUE)
          KeyStroke\type = #INPUT_MOUSE
          KeyStroke\mi\dwFlags = #MOUSEEVENTF_LEFTDOWN
          SendInput_(1, @KeyStroke, SizeOf(INPUT))
          cursor = #False
        EndIf
      EndIf
      If WindowMouseX(0) <> x Or WindowMouseY(0) <> y
        x = WindowMouseX(0)
        y = WindowMouseY(0)
        reset = ElapsedMilliseconds()
        If Not cursor
          *object\pWindow\HideCursor(#OAFALSE)
          cursor = #True
        EndIf
      EndIf
    EndIf
  ForEver
EndProcedure

Procedure GetFilterProperties(Object.i, filterName.s)
  _GetMediaObject(*object) 
  Protected *pFilter.IBaseFilter, *pProp.ISpecifyPropertyPages, FilterInfo.FILTER_INFO, *pFilterUnk.IUnknown, caGUID.CAUUID
  If *object\pGraphBuilder\FindFilterByName(@filterName,  @*pFilter) = #S_OK : Debug "1"
    If *pFilter\QueryInterface(@IID_ISpecifyPropertyPages, @*pProp) = #S_OK : Debug "2"
      *pFilter\QueryFilterInfo(@FilterInfo) : Debug "3"
      *pFilter\QueryInterface(@IID_IUnknown, @*pFilterUnk) : Debug "4"
      *pProp\GetPages(@caGUID) : Debug "5"
      *pProp\Release() : Debug "6"
      OleCreatePropertyFrame_(*object\hwnd, 0, 0, @FilterInfo\achName, 1, @*pFilterUnk, caGUID\cElems, caGUID\pElems, 0, 0, #Null) : Debug "7"
      If g_MediaFullscreen
        *object\pWindow\SetWindowForeground(#OATRUE)
      EndIf
      *pFilterUnk\Release()
      FilterInfo\pGraph\Release()
      CoTaskMemFree_(caGUID\pElems)
      ProcedureReturn #True
    EndIf
  EndIf
EndProcedure

; Public Procedures

Procedure.i Resize(Object.i, x.i = #PB_Default, y.i = #PB_Default, width.i = #PB_Default, height.i = #PB_Default, keepAR.i = #True)
  _GetMediaObject(*object)
  If x > #PB_Default
    *object\pWindow\put_Left(x)
  EndIf
  If y > #PB_Default
    *object\pWindow\put_Top(y)
  EndIf
  If width > #PB_Default
    *object\pVideo\put_DestinationWidth(width)
    *object\pWindow\put_width(width)
    *object\width = width
  EndIf
  If height > #PB_Default
    If keepAR
      *object\pVideo\put_DestinationHeight(width/*object\aspectRatio)
      *object\pVideo\put_Destinationtop((height/2)-(width/*object\aspectRatio)/2)
    Else
      *object\pVideo\put_DestinationHeight(height)
      *object\pVideo\put_Destinationtop(0)
    EndIf
    *object\pWindow\put_Height(height)
    *object\height = height
  EndIf
EndProcedure

Procedure.i Load(Object.i, filename.s, Parent=0, flags.i = #VMR7_Windowed)
  _GetMediaObject(*object)
  Protected pVmr.IBaseFilter, pVidRend.IBaseFilter, pAudR.IBaseFilter, pFilter.IBaseFilter
  Protected pEnum.IEnumFilters, pVMRCnfg.IVMRFilterConfig, pWc.IVMRWindowlessControl, PAR.IVMRAspectRatioControl
  Protected VMR.b, pIndividualRenderer, RendName.s, pFltrCnfg, pWndCntrl, pARControl, vw, vh, ax, ay, cFetched, ar.f
  Protected FilterInfo.FILTER_INFO
  
  _BuildInterfaces(Object)
  *object\renderer = 0
  
  If flags & #VMR9_Windowed Or flags & #VMR9_Windowless Or flags & #VMR7_Windowed Or flags & #VMR7_Windowless Or flags & #OldVideoRenderer Or flags & #OverlayMixer ;VidRenderer
    If flags & #VMR9_Windowed Or flags & #VMR9_Windowless
      *object\renderer | #VMR9_Windowed
      pIndividualRenderer = @CLSID_VideoMixingRenderer9 : RendName = "Video Mixing Renderer 9"
    ElseIf flags & #VMR7_Windowed Or flags & #VMR7_Windowless
      *object\renderer | #VMR7_Windowed
      pIndividualRenderer = @CLSID_VideoMixingRenderer  : RendName = "Video Mixing Renderer 7"
    ElseIf flags & #OverlayMixer
      *object\renderer | #OverlayMixer
      pIndividualRenderer = @CLSID_OverlayMixer         : RendName = "Overlay Mixer"
    ElseIf flags & #OldVideoRenderer
      *object\renderer | #OldVideoRenderer
      pIndividualRenderer = @CLSID_VideoRenderer        : RendName = "Old Video Renderer"
    EndIf
    
    If CoCreateInstance_(pIndividualRenderer, #Null, #CLSCTX_INPROC, @IID_IBaseFilter, @pVidRend) = #S_OK
      If *object\pGraphBuilder\AddFilter(pVidRend, @RendName) = #S_OK
        VMR = #False
        If flags & #VMR9_Windowed Or flags & #VMR9_Windowless
          pFltrCnfg = @IID_IVMRFilterConfig9
          pWndCntrl = @IID_IVMRWindowlessControl9
          pARControl= @IID_IVMRAspectRatioControl9
          VMR = #True
        ElseIf flags & #VMR7_Windowed Or flags & #VMR7_Windowless
          pFltrCnfg = @IID_IVMRFilterConfig
          pWndCntrl = @IID_IVMRWindowlessControl
          pARControl= @IID_IVMRAspectRatioControl
          VMR = #True
        EndIf
        If VMR
          If pVidRend\QueryInterface(pFltrCnfg, @pVMRCnfg) = #S_OK
            If flags & #VMR9_Windowed Or flags & #VMR7_Windowed
              CHECK_(pVMRCnfg\SetRenderingMode(#VMRMode_Windowed))
              If flags & #VMR7_ForceOverlays
                CHECK_(pVMRCnfg\SetRenderingPrefs(#RenderPrefs_ForceOverlays))
              ElseIf flags & #VMR7_ForceOffscreen
                CHECK_(pVMRCnfg\SetRenderingPrefs(#RenderPrefs_ForceOffscreen))
              EndIf
              If flags & #DontKeepAR
                If pVidRend\QueryInterface(pARControl, @PAR) = #S_OK
                  CHECK_(PAR\SetAspectRatioMode(0))
                  PAR\Release()
                EndIf
              EndIf
            ElseIf flags & #VMR9_Windowless Or flags & #VMR7_Windowless
              CHECK_(pVMRCnfg\SetRenderingMode(#VMRMode_Windowless))
              If pVidRend\QueryInterface(@pWndCntrl, @pWc) = #S_OK And Parent
                CHECK_(pWc\SetVideoClippingWindow(Parent))
                CHECK_(pWc\SetAspectRatioMode(0))
                pWc\Release()
              EndIf
            EndIf
            pVMRCnfg\Release()
          Else
            Debug "Error: Getting Interface for VMR Config failed"
          EndIf
        EndIf
      Else
        Debug "Error: Adding Individual video render filter failed" 
      EndIf
      pVidRend\Release()
    Else
      Debug "Error: Couldn't Create Instance of individual video renderer"
    EndIf
  EndIf
  
  RendName = ""
  If flags & #WaveOutRenderer
    RendName = "AudioWaveOut Renderer"
    pIndividualRenderer = @CLSID_AudioRender
  ElseIf flags & #DirectSoundRenderer
    RendName = "DirectSound Renderer"
    pIndividualRenderer = @CLSID_DSoundRender
  EndIf
  If RendName
    If CoCreateInstance_(pIndividualRenderer, #Null, #CLSCTX_INPROC, @IID_IBaseFilter, @pAudR) = #S_OK
      If *object\pGraphBuilder\AddFilter(pAudR, @RendName) = #S_OK
        pAudR\Release()
      Else
        Debug "Error: Adding Individual audio render filter failed"
      EndIf
    Else
      Debug "Error: Couldn't Create Instance of individual audio renderer"
    EndIf
  EndIf
  Debug filename
  If *object\pGraphBuilder\RenderFile(@filename, #Null) = #S_OK
    
    If Parent
      *object\hwnd = Parent
      *object\pVideo\get_SourceWidth(@vw)
      *object\pVideo\get_SourceHeight(@vh)
      *object\pVideo\GetPreferredAspectRatio(@ax, @ay)
      
      If ax And ay
        *object\aspectRatio = ax/ay
        *object\widthPAR = (vh * *object\aspectRatio); * 0.70
        vw = *object\widthPAR
        Debug "aspektRatio  : "+StrF(*object\aspectRatio,3)
        Debug "WidthPAR  : "+Str(vw)
      EndIf
      
      *object\width = vw
      *object\height = vh
      Resize(Object, 0, 0, vw, vh)
      CHECK_(*object\pWindow\put_Owner(*object\hwnd))
      CHECK_(*object\pWindow\put_WindowStyle(#WS_CHILD|#WS_CLIPSIBLINGS|#WS_CLIPCHILDREN))
      CHECK_(*object\pWindow\put_Visible(#OATRUE))
    EndIf
    
    If *object\pEvent\SetNotifyWindow(Parent, #WM_GRAPHEVENT, Object.i) = #S_OK
      If *object\pEvent\SetNotifyFlags(0) <> #S_OK
      EndIf
    Else
      Debug "Info: Media notification callback has not been applied"
    EndIf
    If *object\pGraphBuilder\EnumFilters(@pEnum) = #S_OK
      Debug " "
      Debug "--------- Filtergraph ---------"
      While pEnum\Next(1, @pFilter, @cFetched) = #S_OK
        pFilter\QueryFilterInfo(@FilterInfo)
        AddElement(filters())
        Debug PeekS(@FilterInfo\achName, #MAX_FILTER_NAME, #PB_Unicode)
        filters() = PeekS(@FilterInfo\achName, #MAX_FILTER_NAME, #PB_Unicode)
        If FilterInfo\pGraph <> #Null
          FilterInfo\pGraph\Release()
        EndIf
        pFilter\Release()
      Wend
      Debug "--------------------------------------"
      Debug " "
    Else
      Debug "Error: Could not enumerate filters"
    EndIf
    *object\pSeeking\SetTimeFormat(@TIME_FORMAT_MEDIA_TIME)
    *object\pGraphBuilder\Release()
    
    ProcedureReturn #True
  Else
    Debug "Error: Rendering file failed"
    ProcedureReturn #False
  EndIf
  
EndProcedure

Procedure.i Play(Object.i)
  _GetMediaObject(*object)
  ProcedureReturn *object\pControl\run()
EndProcedure

Procedure.i Pause(Object.i)
  _GetMediaObject(*object)
  ProcedureReturn *object\pControl\pause()
EndProcedure

Procedure.i Seek(Object.i, pos.q, SeekByFrame.i=#False)
  Protected Ret.i
  _GetMediaObject(*object)
  Protected duration.q
  *object\pSeeking\GetDuration(@duration)
  If SeekByFrame = #False
    pos * 10000
  Else
    *object\pSeeking\SetTimeFormat(@TIME_FORMAT_FRAME)
  EndIf
  
  Ret = *object\pSeeking\SetPositions(@pos, #AM_SEEKING_AbsolutePositioning,@duration, #AM_SEEKING_NoPositioning)
  
  *object\pSeeking\SetTimeFormat(@TIME_FORMAT_MEDIA_TIME)
  
  ProcedureReturn Ret
EndProcedure

Procedure.i Stop(Object.i)
  _GetMediaObject(*object)
  ProcedureReturn *object\pControl\stop()
EndProcedure

Procedure.i Lenght(Object.i, mode.i = #MEDIA_TIME_MSECS)
  _GetMediaObject(*object)
  Protected duration.q, avgTimePerFrame.d
  *object\pSeeking\GetDuration(@duration)
  If mode = #MEDIA_TIME_MSECS
    ProcedureReturn duration/10000 ; result in ms
  ElseIf mode = #MEDIA_TIME_FRAMES
    *object\pVideo\get_AvgTimePerFrame(@avgTimePerFrame)
    If avgTimePerFrame > 0
      ProcedureReturn (duration/10000) / (avgTimePerFrame*1000) ; result in frames
    EndIf
  EndIf
EndProcedure

Procedure.i Width(Object.i)
  _GetMediaObject(*object)
  ProcedureReturn *object\width
EndProcedure

Procedure.i Height(Object.i)
  _GetMediaObject(*object)
  ProcedureReturn *object\height
EndProcedure

Procedure.i ToggleFullscreen(Object.i)
  _GetMediaObject(*object)
  Protected res.i
  Global  g_origWidth.i, g_OrigHeigth.i
  If Not *object\renderer & #OverlayMixer
    If *object\fullscreen = #True
      SetWindowPos_(FindWindow_("Shell_traywnd", ""), 0, 0, 0, 0, 0, #SWP_SHOWWINDOW)
      Resize(Object.i, #PB_Default, #PB_Default, g_origWidth, g_OrigHeigth)
      *object\pWindow\put_Owner(*object\hwnd)
      *object\pWindow\SetWindowForeground(#OAFALSE)
      *object\pWindow\HideCursor(#OAFALSE)
      UpdateWindow_(*object\hwnd)
      SetForegroundWindow_(*object\hwnd)
      SetFocus_(*object\hwnd)
      *object\fullscreen = #False
      g_MediaFullscreen = #False
      ShowWindow_(*object\hwnd, #SW_SHOW)
      KillThread(*object\thread)
    Else
      ExamineDesktops()
      g_origWidth = Width(Object)
      g_OrigHeigth = Height(Object)
      *object\pWindow\put_Owner(GetDesktopWindow_())
      ShowWindow_(*object\hwnd, #SW_HIDE)
      *object\pWindow\SetWindowForeground(#OATRUE)
      SetWindowPos_(FindWindow_("Shell_traywnd", ""), GetDesktopWindow_(), 0, 0, 0, 0, #SWP_HIDEWINDOW)
      Resize(Object, #PB_Default, #PB_Default, DesktopWidth(0), DesktopHeight(0))
      *object\fullscreen = #True
      g_MediaFullscreen = #True
      *object\thread = CreateThread(@ToggleCursorFullscreen(), *object)
    EndIf
    
    ProcedureReturn #True
  EndIf
EndProcedure

Procedure.i Position(Object.i, mode.i = #MEDIA_TIME_MSECS)
  _GetMediaObject(*object)
  Protected pos.q, avgTimePerFrame.d
  *object\pSeeking\GetCurrentPosition(@pos)
  If mode = #MEDIA_TIME_MSECS
    ProcedureReturn pos/10000 ; result in ms
  ElseIf mode = #MEDIA_TIME_FRAMES
    *object\pVideo\get_AvgTimePerFrame(@avgTimePerFrame)
    If avgTimePerFrame > 0
      ProcedureReturn (pos/10000) / (avgTimePerFrame*1000)
    EndIf
  EndIf
EndProcedure

Procedure.i State(Object.i)
  _GetMediaObject(*object)
  Protected pfs.i
  *object\pControl\GetState(10,@pfs)
  ProcedureReturn pfs
EndProcedure

Procedure.f FPS(Object.i) ; return .f cause we just need float precision
  _GetMediaObject(*object)
  Protected avgTimePerFrame.d
  *object\pVideo\get_AvgTimePerFrame(@avgTimePerFrame)
  If avgTimePerFrame > 0
    ProcedureReturn 1/avgTimePerFrame
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure.i CaptureCurrMediaImage(Object.i, ResultingImgNo.i)
  _GetMediaObject(*object)
  Protected DataSize.i, *pImg.BITMAPINFOHEADER
  If IsImage(ResultingImgNo) = 0
    If *object\pVideo\GetCurrentImage(@DataSize, #Null) = #S_OK
      *pImg = AllocateMemory(DataSize)
      If *pImg
        If *object\pVideo\GetCurrentImage(@DataSize, *pImg) = #S_OK
          If CreateImage(ResultingImgNo, *pImg\biWidth, *pImg\biHeight, *pImg\biBitCount)
            If SetDIBits_(0, ImageID(ResultingImgNo), 0, *pImg\biHeight, *pImg+*pImg\biSize, *pImg, #DIB_RGB_COLORS)
              ProcedureReturn #True
            EndIf
          EndIf
        Else
          Debug "Info: Capturing current image not possible"
        EndIf
        FreeMemory(*pImg)
      Else
        Debug "Error: Allocating ImgBuffer memory failed"
      EndIf
    Else
      Debug "Error: Couldn't measure needed imagebuffer - or actual media contains no videostream"
    EndIf
  Else
    Debug "Error: ImageNumer already valid"
  EndIf
EndProcedure

Procedure.i OnMediaEvent(Object.i)
  _GetMediaObject(*object)
  Protected EventCode.i, Param1.i, Param2.i
  While *object\pEvent\GetEvent(@EventCode, @Param1, @Param2, 0) <> #E_ABORT
    Select EventCode
      Case #EC_COMPLETE
        *object\pControl\stop() ; If an #EC_COMPLETE notify occurs we do change the media state to stopped
        Debug "... end has been reached."
    EndSelect
    *object\pEvent\FreeEventParams(EventCode, Param1, Param2)
  Wend
EndProcedure

Procedure.s Time2String(time.i)
  Protected ti.s, SS, MM, HH, ms
  ms = time%1000
  SS = Int(time / 1000) : While SS > 59:SS-60:Wend
  MM = Int(time / 1000 / 60) : While MM > 59:MM-60:Wend
  HH = Int(time / 1000 / 60 / 60) : While HH > 59:HH-60:Wend
  ti.s =RSet(StrU(HH,#PB_Byte),2,"0")+":"+RSet(StrU(MM,#PB_Byte),2,"0")+":"+RSet(StrU(SS,#PB_Byte),2,"0")+":"+RSet(StrU(ms,#PB_Byte),3,"0")
  ProcedureReturn ti.s
EndProcedure

Procedure.i GetVolume(Object.i) ; from -100db to 0db
  _GetMediaObject(*object)
  Protected db.i
  *object\pAudio\get_Volume(@db)
  ProcedureReturn db/100
EndProcedure

Procedure.i PutVolume(Object.i, db.i) ; from -100db to 0db
  _GetMediaObject(*object)
  If db > -85 And db < 1 ; dont change -85 to -101 as it will mess up WaveOut. A bug in the API ?
    Delay(10) : *object\pAudio\put_Volume(db*100)
  EndIf
EndProcedure

Procedure.i PutBalance(Object.i, bal.i) ; -100 to +100
  _GetMediaObject(*object)
  *object\pAudio\put_balance(bal*100)
EndProcedure

Procedure.i GetBalance(Object.i) ; from -100 to +100
  _GetMediaObject(*object)
  Protected bal
  *object\pAudio\get_balance(@bal)
  ProcedureReturn Int(bal/100)
EndProcedure

Procedure.i Close(Object.i)
  _GetMediaObject(*object)
  
  Protected pfs.i
  If g_MediaFullscreen
    ToggleFullscreen(Object)
  EndIf
  *object\pControl\GetState(10,@pfs)
  If Not pfs = #State_Stopped
    *object\pControl\stop()
  EndIf
  *object\pWindow\put_Visible(#OAFALSE)
  *object\pWindow\put_Owner(#OAFALSE)
  *object\pEvent\SetNotifyWindow(#Null, 0, 0)
  _DeleteInterfaces(Object)
  ClearList(filters())
  ProcedureReturn #True
EndProcedure

Procedure.i IsMedia(Object.i)
  If g_DshowObjects
    If Object<>#PB_Any And Object_IsObject(g_DshowObjects, Object)
      ProcedureReturn #True
    EndIf
  EndIf
EndProcedure

; Special Procedures

Procedure.i CreateInstance()
  Protected *This = AllocateMemory(SizeOf(Integer))
  Protected *object.Dshow_Interfaces
  If Not g_DshowObjects
    g_DshowObjects = Object_Init(SizeOf(Dshow_Interfaces), 1, @FreeInstance())
  EndIf
  *object = Object_GetOrAllocateID(g_DshowObjects, *This)
  If *object
    *object\Object = #True
    CoInitializeEx_(0, $02); #COINIT_APARTMENTTHREADED
                           ;CoInitialize_(0)
    ProcedureReturn *This
  Else
    Debug "Fatal Error: The given media no. hasn't been initialized!"
    CallDebugger
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure.i FreeInstance(Object.i)
  If Object<>#PB_Any And Object_IsObject(g_DshowObjects, Object)
    _GetMediaObject(*object)
    Protected pfs.i
    If *object\pControl
      *object\pControl\GetState(10,@pfs)
      If Not pfs = #State_Stopped
        *object\pControl\stop()
      EndIf
      Close(Object)
    EndIf
    CoUninitialize_()
    Object_FreeID(g_DshowObjects, Object)
    *object\Object = #False
    FreeMemory(Object)
  EndIf
EndProcedure

EndModule


CompilerIf #PB_Compiler_IsMainFile
  
  Define *Media
  Define MainWindow.i
  Define File.s = OpenFileRequester("Open Media File", "", "*.*", 0)
  
  MainWindow = OpenWindow(#PB_Any,20,20,500,500,"PB native Dshow example", #PB_Window_SystemMenu |#PB_Window_ScreenCentered)   
  
  If File
    *Media = DshowMedia::CreateInstance()
    If DshowMedia::Load(*Media, File, WindowID(MainWindow))
      ResizeWindow(MainWindow, #PB_Ignore, #PB_Ignore, DshowMedia::Width(*Media), DshowMedia::Height(*Media))
      DshowMedia::Play(*Media)
      Debug DshowMedia::FPS(*Media)
    EndIf
  Else
    End
  EndIf
  
  
  Repeat
    DshowMedia::OnMediaEvent(*Media)
  Until DshowMedia::State(*Media) = DshowMedia::#State_Stopped Or WaitWindowEvent(10) = #PB_Event_CloseWindow
  
  DshowMedia::PutVolume(*Media,0) ; '0' means 0db = maxVolume --> this is necessary! Otherwise the system sound device will keep the vol state even when appl. has been closed.
  Debug DshowMedia::FreeInstance(*Media)
  
CompilerEndIf

Re: Need help making code x64 compatible

Posted: Fri Dec 23, 2016 3:59 am
by novablue
Thank you very much, should this be reported as a bug?

Re: Need help making code x64 compatible

Posted: Fri Dec 23, 2016 11:35 am
by fryquez
I am not sure that it's a bug and for a bug report this code is way to much.

If you trim down the old code, it might also stop crashing ...

Re: Need help making code x64 compatible

Posted: Mon Apr 22, 2024 3:29 pm
by dige
Since PB6.11B1 there is a 'Syntax error' @ line 364

Code: Select all

OleCreatePropertyFrame_(*object\hwnd, 0, 0, @FilterInfo\achName, 1, @*pFilterUnk, caGUID\cElems, caGUID\pElems, 0, 0, #Null) : Debug "7"
Does anyone knows, what the problem could be?

Re: Need help making code x64 compatible

Posted: Mon Apr 22, 2024 4:36 pm
by jacdelad
I'm not 100% sure and mayb this is 100% crap, but: It should work this way:

Code: Select all

EnableExplicit

DeclareModule DshowMedia
  #VMR9_Windowed       = 1 << 0
  #VMR9_Windowless     = 1 << 1
  #VMR7_Windowed       = 1 << 2
  #VMR7_Windowless     = 1 << 3
  #OldVideoRenderer    = 1 << 4
  #OverlayMixer        = 1 << 5
  
  #WaveOutRenderer     = 1 << 6
  #DirectSoundRenderer = 1 << 7
  
  #VMR7_ForceOverlays  = 1 << 8
  #VMR7_ForceOffscreen = 1 << 9
  #DontKeepAR          = 1 << 10
  
  Enumeration ; MediaState
    #State_Stopped
    #State_Paused
    #State_Running
  EndEnumeration
  
  Enumeration ; MediaInfo
    #MEDIA_LENGTH
    #MEDIA_FPS
    #MEDIA_WIDTH
    #MEDIA_HEIGHT
    #MEDIA_POSITION
    #MEDIA_ASPECTRATIO_NUM
    #MEDIA_ASPECTRATIO_DEN
    #MEDIA_ASPECTRATIO
    #MEDIA_STATE
    #MEDIA_TIME_FRAMES
    #MEDIA_TIME_MSECS
  EndEnumeration
  
  Enumeration ; MediaSeeking
    #AM_SEEKING_NoPositioning
    #AM_SEEKING_AbsolutePositioning
  EndEnumeration
  
  Declare.i Resize(Object.i, x.i = #PB_Default, y.i = #PB_Default, width.i = #PB_Default, height.i = #PB_Default, keepAR.i = #True)
  Declare.i Load(Object.i, filename.s, Parent=0, flags.i = #VMR7_Windowed)
  Declare.i Play(Object.i)
  Declare.i Pause(Object.i)
  Declare.i Seek(Object.i, pos.q, SeekByFrame.i=#False)
  Declare.i Stop(Object.i)
  Declare.i Lenght(Object.i, mode.i = #MEDIA_TIME_MSECS)
  Declare.i Width(Object.i)
  Declare.i Height(Object.i)
  Declare.i ToggleFullscreen(Object.i)
  Declare.i Position(Object.i, mode.i = #MEDIA_TIME_MSECS)
  Declare.i State(Object.i)
  Declare.f FPS(Object.i) ; return .f cause we just need float precision
  Declare.i CaptureCurrMediaImage(Object.i, ResultingImgNo.i)
  Declare.i OnMediaEvent(Object.i)
  Declare.s Time2String(time.i)
  Declare.i GetVolume(Object.i) ; from -100db to 0db
  Declare.i PutVolume(Object.i, db.i) ; from -100db to 0db
  Declare.i PutBalance(Object.i, bal.i) ; -100 to +100
  Declare.i GetBalance(Object.i)        ; from -100 to +100
  Declare.i Close(Object.i)
  Declare.i IsMedia(Object.i)
  
  Declare.i CreateInstance()
  Declare.i FreeInstance(Object.i)
EndDeclareModule

Module DshowMedia 
  
  EnableExplicit
  
  #VMRMode_Windowed   = $1
  #VMRMode_Windowless = $2
  #VMRMode_Renderless = $4
  #VMRMode_Mask       = $7
  
  #S_OK  = 0
  #OATRUE = -1
  #OAFALSE = 0
  
  #CLSCTX_INPROC_SERVER  = $01
  #CLSCTX_INPROC_HANDLER = $02
  #CLSCTX_LOCAL_SERVER   = $04
  #CLSCTX_REMOTE_SERVER  = $10
  
  #CLSCTX_ALL    = #CLSCTX_INPROC_SERVER|#CLSCTX_INPROC_HANDLER|#CLSCTX_LOCAL_SERVER|#CLSCTX_REMOTE_SERVER
  #CLSCTX_INPROC = #CLSCTX_INPROC_SERVER|#CLSCTX_INPROC_HANDLER
  #CLSCTX_SERVER = #CLSCTX_INPROC_SERVER|#CLSCTX_LOCAL_SERVER|#CLSCTX_REMOTE_SERVER
  
  #MAX_FILTER_NAME = 128
  
  #WM_GRAPHEVENT = #WM_USER+1
  
  #EC_COMPLETE  = 1
  
  #RenderPrefs_ForceOffscreen               = $00000001
  #RenderPrefs_ForceOverlays                = $00000002
  #RenderPrefs_AllowOverlays                = $00000000
  #RenderPrefs_AllowOffscreen               = $00000000
  #RenderPrefs_DoNotRenderColorKeyAndBorder = $00000008
  #RenderPrefs_RestrictToInitialMonitor     = $00000010
  #RenderPrefs_PreferAGPMemWhenMixing       = $00000020
  #RenderPrefs_Mask                         = $0000003F
  
  #Default = 0
  
  Interface IGraphBuilder_forceUnicode
    QueryInterface(a, b)
    AddRef()
    Release()
    AddFilter(a, b)
    RemoveFilter(a)
    EnumFilters(a)
    FindFilterByName(a, b)
    ConnectDirect(a, b, c)
    Reconnect(a)
    Disconnect(a)
    SetDefaultSyncSource()
    Connect(a, b)
    Render(a)
    ;RenderFile(a, b)
    RenderFile(a, b)
    AddSourceFilter(a, b, c)
    SetLogFile(a)
    Abort()
    ShouldOperationContinue()
  EndInterface
  
  Structure Dshow_Interfaces
    Object.i
    pGraphBuilder.IGraphBuilder_forceUnicode
    pControl.IMediaControl
    pEvent.IMediaEventEx
    pWindow.IVideoWindow
    pAudio.IBasicAudio
    pVideo.IBasicVideo2
    pSeeking.IMediaSeeking
    thread.i
    fullscreen.i
    hwnd.i
    drain.i
    aspectRatio.f
    width.i
    widthPAR.i
    height.i
    renderer.i
  EndStructure
  
  CompilerIf Defined(FILTER_INFO, #PB_Structure) = #False
    Structure FILTER_INFO ; an official Dshow structure - actually missing in PB
      achName.w[#MAX_FILTER_NAME]
      *pGraph.IFilterGraph
    EndStructure
  CompilerEndIf
  
  CompilerIf Defined(CAUUID, #PB_Structure) = #False
    Structure CAUUID
      cElems.i
      *pElems 
    EndStructure
  CompilerEndIf
  
  CompilerIf Defined(IEnumFilters, #PB_Interface) = #False
    Interface IEnumFilters
      QueryInterface(a, b)
      AddRef()
      Release()
    Next(a, b, c) ;{
    Skip(a)
    Reset()
    Clone(a)
  EndInterface
CompilerEndIf

Macro SUCCEEDED(HRESULT)
  HRESULT & $80000000 = 0
EndMacro

Macro FAILED(HRESULT)
  HRESULT & $80000000
EndMacro

Macro _SafeRelease(__Object)
  If __Object
    __Object\Release()
    __Object = #Null
  EndIf
EndMacro

Macro _GetMediaObject(_Object_)
  Protected _Object_#.Dshow_Interfaces = Object_GetObject(g_DshowObjects, Object)
  If Not _Object_#
    Debug "Fatal Error: The given media no. hasn't been initialized!"
    CallDebugger
    ProcedureReturn #False
  EndIf
EndMacro

Macro CHECK_(IN)
  CompilerIf #PB_Compiler_Debugger
    If Not SUCCEEDED(IN#)
      Debug "Not succeeded at line " + Str(#PB_Compiler_Line)
      CallDebugger
    EndIf
  CompilerElse
    IN#
  CompilerEndIf
EndMacro

Macro DEFINE_GUID(name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
  Global name.GUID
  name\Data1 = l
  name\Data2 = w1
  name\Data3 = w2
  name\Data4[0] = b1
  name\Data4[1] = b2
  name\Data4[2] = b3
  name\Data4[3] = b4
  name\Data4[4] = b5
  name\Data4[5] = b6
  name\Data4[6] = b7
  name\Data4[7] = b8
EndMacro

;{ GUIDS
DEFINE_GUID(IID_IGraphBuilder,          $56A868A9, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaControl,          $56A868B1, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaEventEx,          $56A868C0, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaSeeking,          $36B73880, $C2C8, $11CF, $8B, $46, $00, $80, $5F, $6C, $EF, $60)
DEFINE_GUID(IID_IVideoWindow,           $56A868B4, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IBasicAudio,            $56A868B3, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IBasicVideo,            $56A868B5, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IMediaSeeking,          $36B73880, $C2C8, $11CF, $8B, $46, $00, $80, $5F, $6C, $EF, $60)
DEFINE_GUID(IID_IBaseFilter,            $56A86895, $0AD4, $11CE, $B0, $3A, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(IID_IVMRFilterConfig9,      $5A804648, $4F66, $4867, $9C, $43, $4F, $5C, $82, $2C, $F1, $B8)
DEFINE_GUID(IID_IVMRWindowlessControl9, $8F537D09, $F85E, $4414, $B2, $3B, $50, $2E, $54, $C7, $99, $27)
DEFINE_GUID(IID_IVMRFilterConfig,       $9E5530C5, $7034, $48B4, $BB, $46, $0B, $8A, $6E, $FC, $8E, $36)
DEFINE_GUID(IID_IVMRWindowlessControl,  $0EB1088C, $4DCD, $46F0, $87, $8F, $39, $DA, $E8, $6A, $51, $B7)
DEFINE_GUID(IID_IVMRAspectRatioControl, $EDE80B5C, $BAD6, $4623, $B5, $37, $65, $58, $6C, $9F, $8D, $FD)
DEFINE_GUID(IID_IVMRAspectRatioControl9,$00D96C29, $BBDE, $4EFC, $99, $01, $BB, $50, $36, $39, $21, $46)
DEFINE_GUID(IID_ISpecifyPropertyPages,  $B196B28B, $BAB4, $101A, $B6, $9C, $00, $AA, $00, $34, $1D, $07)
DEFINE_GUID(IID_IUnknown,               $00000000, $0000, $0000, $C0, $00, $00, $00, $00, $00, $00, $46)

DEFINE_GUID(IID_IDvdGraphBuilder,       $FCC152B6, $F372, $11D0, $8E, $00, $00, $C0, $4F, $D7, $C0, $8B)
DEFINE_GUID(IID_IDvdControl2,           $33BC7430, $EEC0, $11D2, $82, $01, $00, $A0, $C9, $D7, $48, $42)
DEFINE_GUID(IID_IDvdInfo2,              $34151510, $EEC0, $11D2, $82, $01, $00, $A0, $C9, $D7, $48, $42)

DEFINE_GUID(CLSID_FilterGraph,          $E436EBB3, $524F, $11CE, $9F, $53, $00, $20, $AF, $0B, $A7, $70)
DEFINE_GUID(CLSID_VideoMixingRenderer,  $B87BEB7B, $8D29, $423F, $AE, $4D, $65, $82, $C1, $01, $75, $AC)
DEFINE_GUID(CLSID_VideoMixingRenderer9, $51B4ABF3, $748F, $4E3B, $A2, $76, $C8, $28, $33, $0E, $92, $6A)
DEFINE_GUID(CLSID_OverlayMixer,         $CD8743A1, $3736, $11D0, $9E, $69, $00, $C0, $4F, $D7, $C1, $5B)
DEFINE_GUID(CLSID_VideoRenderer,        $70E102B0, $5556, $11CE, $97, $C0, $00, $AA, $00, $55, $59, $5A)
DEFINE_GUID(CLSID_AudioRender,          $E30629D1, $27E5, $11CE, $87, $5D, $00, $60, $8C, $B7, $80, $66)
DEFINE_GUID(CLSID_DSoundRender,         $79376820, $07D0, $11CF, $A2, $4D, $00, $20, $AF, $D7, $97, $67)
DEFINE_GUID(TIME_FORMAT_MEDIA_TIME,     $7B785574, $8C82, $11CF, $BC, $0C, $00, $AA, $00, $AC, $74, $F6)
DEFINE_GUID(TIME_FORMAT_FRAME,          $7B785570, $8C82, $11CF, $BC, $0C, $00, $AA, $00, $AC, $74, $F6)
;}

Import "ObjectManager.lib"
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
    Object_GetOrAllocateID(*Objects, Object.i) As "_PB_Object_GetOrAllocateID@8"
    Object_GetObject(*Objects, Object.i) As "_PB_Object_GetObject@8"
    Object_IsObject(*Objects, Object.i) As "_PB_Object_IsObject@8"
    Object_FreeID(*Objects, Object.i) As "_PB_Object_FreeID@8"
    Object_Init(structuresize.i, IncrementStep.i, *ObjectFreeFunction) As "_PB_Object_Init@12"
  CompilerElse
    Object_GetOrAllocateID(*Objects, Object.i) As "PB_Object_GetOrAllocateID"
    Object_GetObject(*Objects, Object.i) As "PB_Object_GetObject"
    Object_IsObject(*Objects, Object.i) As "PB_Object_IsObject"
    Object_FreeID(*Objects, Object.i) As "PB_Object_FreeID"
    Object_Init(structuresize.i, IncrementStep.i, *ObjectFreeFunction) As "PB_Object_Init"
  CompilerEndIf
EndImport:IsWindow(#PB_Any)

Global g_DshowObjects.i
Global g_MediaFullscreen.b
Global NewList filters.s()

; Private Procedures

Procedure _DeleteInterfaces(Object.i)
  _GetMediaObject(*object)
  _SafeRelease(*object\pControl)
  _SafeRelease(*object\pEvent)
  _SafeRelease(*object\pWindow)
  _SafeRelease(*object\pAudio)
  _SafeRelease(*object\pVideo)
  _SafeRelease(*object\pSeeking)
  _SafeRelease(*object\pGraphBuilder)
  ProcedureReturn #True
EndProcedure

Procedure _BuildInterfaces(Object.i)
  _GetMediaObject(*object)
  Protected a.i, b.i, c.i, d.i, e.i, f.i
  If Not CoCreateInstance_(@CLSID_FilterGraph, #Null, #CLSCTX_INPROC_SERVER, @IID_IGraphBuilder, @*object\pGraphBuilder) = #S_OK
    Debug "Error: Couldn't initialize the GraphBuilder Interface"
    CallDebugger
    ProcedureReturn #False
  Else
    *object\Object = #True
    a = *object\pGraphBuilder\QueryInterface(@IID_IMediaControl, @*object\pControl)
    b = *object\pGraphBuilder\QueryInterface(@IID_IMediaEventEx, @*object\pEvent)
    c = *object\pGraphBuilder\QueryInterface(@IID_IVideoWindow,  @*object\pWindow)
    d = *object\pGraphBuilder\QueryInterface(@IID_IBasicAudio,   @*object\pAudio)
    e = *object\pGraphBuilder\QueryInterface(@IID_IBasicVideo,   @*object\pVideo)
    f = *object\pGraphBuilder\QueryInterface(@IID_IMediaSeeking, @*object\pSeeking)
    If SUCCEEDED(a) And SUCCEEDED(b) And SUCCEEDED(c) And SUCCEEDED(d) And SUCCEEDED(e) And SUCCEEDED(f) ; Quick check
      ProcedureReturn #True
    Else
      _DeleteInterfaces(Object)
      Debug "Error: Query of at least one of the needed Interfaces failed"
      CallDebugger
      ProcedureReturn #False
    EndIf
  EndIf
EndProcedure

Procedure MoveWindow()
  If Not g_MediaFullscreen
    ReleaseCapture_()
    SendMessage_(GetForegroundWindow_(), #WM_SYSCOMMAND, #SC_MOVE + #HTCAPTION, 0)
  EndIf
EndProcedure

Procedure ToggleCursorFullscreen(*object.Dshow_Interfaces)
  Protected res.i, x.i = WindowMouseX(0), y.i = WindowMouseY(0), button.i, cursor.i = #True, reset.i = ElapsedMilliseconds(), KeyStroke.INPUT
  Repeat
    Delay(100)
    If g_MediaFullscreen
      If cursor
        If ElapsedMilliseconds() - reset > 2 * 1000 ; 2 Secs.
          *object\pWindow\HideCursor(#OATRUE)
          KeyStroke\type = #INPUT_MOUSE
          KeyStroke\mi\dwFlags = #MOUSEEVENTF_LEFTDOWN
          SendInput_(1, @KeyStroke, SizeOf(INPUT))
          cursor = #False
        EndIf
      EndIf
      If WindowMouseX(0) <> x Or WindowMouseY(0) <> y
        x = WindowMouseX(0)
        y = WindowMouseY(0)
        reset = ElapsedMilliseconds()
        If Not cursor
          *object\pWindow\HideCursor(#OAFALSE)
          cursor = #True
        EndIf
      EndIf
    EndIf
  ForEver
EndProcedure

Procedure GetFilterProperties(Object.i, filterName.s)
  _GetMediaObject(*object) 
  Protected *pFilter.IBaseFilter, *pProp.ISpecifyPropertyPages, FilterInfo.FILTER_INFO, *pFilterUnk.IUnknown, caGUID.CAUUID
  If *object\pGraphBuilder\FindFilterByName(@filterName,  @*pFilter) = #S_OK : Debug "1"
    If *pFilter\QueryInterface(@IID_ISpecifyPropertyPages, @*pProp) = #S_OK : Debug "2"
      *pFilter\QueryFilterInfo(@FilterInfo) : Debug "3"
      *pFilter\QueryInterface(@IID_IUnknown, @*pFilterUnk) : Debug "4"
      *pProp\GetPages(@caGUID) : Debug "5"
      *pProp\Release() : Debug "6"
      OleCreatePropertyFrame_(*object\hwnd, 0, 0, @FilterInfo, 1, @*pFilterUnk, caGUID\cElems, caGUID\pElems, 0, 0, #Null) : Debug "7"
      If g_MediaFullscreen
        *object\pWindow\SetWindowForeground(#OATRUE)
      EndIf
      *pFilterUnk\Release()
      FilterInfo\pGraph\Release()
      CoTaskMemFree_(caGUID\pElems)
      ProcedureReturn #True
    EndIf
  EndIf
EndProcedure

; Public Procedures

Procedure.i Resize(Object.i, x.i = #PB_Default, y.i = #PB_Default, width.i = #PB_Default, height.i = #PB_Default, keepAR.i = #True)
  _GetMediaObject(*object)
  If x > #PB_Default
    *object\pWindow\put_Left(x)
  EndIf
  If y > #PB_Default
    *object\pWindow\put_Top(y)
  EndIf
  If width > #PB_Default
    *object\pVideo\put_DestinationWidth(width)
    *object\pWindow\put_width(width)
    *object\width = width
  EndIf
  If height > #PB_Default
    If keepAR
      *object\pVideo\put_DestinationHeight(width/*object\aspectRatio)
      *object\pVideo\put_Destinationtop((height/2)-(width/*object\aspectRatio)/2)
    Else
      *object\pVideo\put_DestinationHeight(height)
      *object\pVideo\put_Destinationtop(0)
    EndIf
    *object\pWindow\put_Height(height)
    *object\height = height
  EndIf
EndProcedure

Procedure.i Load(Object.i, filename.s, Parent=0, flags.i = #VMR7_Windowed)
  _GetMediaObject(*object)
  Protected pVmr.IBaseFilter, pVidRend.IBaseFilter, pAudR.IBaseFilter, pFilter.IBaseFilter
  Protected pEnum.IEnumFilters, pVMRCnfg.IVMRFilterConfig, pWc.IVMRWindowlessControl, PAR.IVMRAspectRatioControl
  Protected VMR.b, pIndividualRenderer, RendName.s, pFltrCnfg, pWndCntrl, pARControl, vw, vh, ax, ay, cFetched, ar.f
  Protected FilterInfo.FILTER_INFO
  
  _BuildInterfaces(Object)
  *object\renderer = 0
  
  If flags & #VMR9_Windowed Or flags & #VMR9_Windowless Or flags & #VMR7_Windowed Or flags & #VMR7_Windowless Or flags & #OldVideoRenderer Or flags & #OverlayMixer ;VidRenderer
    If flags & #VMR9_Windowed Or flags & #VMR9_Windowless
      *object\renderer | #VMR9_Windowed
      pIndividualRenderer = @CLSID_VideoMixingRenderer9 : RendName = "Video Mixing Renderer 9"
    ElseIf flags & #VMR7_Windowed Or flags & #VMR7_Windowless
      *object\renderer | #VMR7_Windowed
      pIndividualRenderer = @CLSID_VideoMixingRenderer  : RendName = "Video Mixing Renderer 7"
    ElseIf flags & #OverlayMixer
      *object\renderer | #OverlayMixer
      pIndividualRenderer = @CLSID_OverlayMixer         : RendName = "Overlay Mixer"
    ElseIf flags & #OldVideoRenderer
      *object\renderer | #OldVideoRenderer
      pIndividualRenderer = @CLSID_VideoRenderer        : RendName = "Old Video Renderer"
    EndIf
    
    If CoCreateInstance_(pIndividualRenderer, #Null, #CLSCTX_INPROC, @IID_IBaseFilter, @pVidRend) = #S_OK
      If *object\pGraphBuilder\AddFilter(pVidRend, @RendName) = #S_OK
        VMR = #False
        If flags & #VMR9_Windowed Or flags & #VMR9_Windowless
          pFltrCnfg = @IID_IVMRFilterConfig9
          pWndCntrl = @IID_IVMRWindowlessControl9
          pARControl= @IID_IVMRAspectRatioControl9
          VMR = #True
        ElseIf flags & #VMR7_Windowed Or flags & #VMR7_Windowless
          pFltrCnfg = @IID_IVMRFilterConfig
          pWndCntrl = @IID_IVMRWindowlessControl
          pARControl= @IID_IVMRAspectRatioControl
          VMR = #True
        EndIf
        If VMR
          If pVidRend\QueryInterface(pFltrCnfg, @pVMRCnfg) = #S_OK
            If flags & #VMR9_Windowed Or flags & #VMR7_Windowed
              CHECK_(pVMRCnfg\SetRenderingMode(#VMRMode_Windowed))
              If flags & #VMR7_ForceOverlays
                CHECK_(pVMRCnfg\SetRenderingPrefs(#RenderPrefs_ForceOverlays))
              ElseIf flags & #VMR7_ForceOffscreen
                CHECK_(pVMRCnfg\SetRenderingPrefs(#RenderPrefs_ForceOffscreen))
              EndIf
              If flags & #DontKeepAR
                If pVidRend\QueryInterface(pARControl, @PAR) = #S_OK
                  CHECK_(PAR\SetAspectRatioMode(0))
                  PAR\Release()
                EndIf
              EndIf
            ElseIf flags & #VMR9_Windowless Or flags & #VMR7_Windowless
              CHECK_(pVMRCnfg\SetRenderingMode(#VMRMode_Windowless))
              If pVidRend\QueryInterface(@pWndCntrl, @pWc) = #S_OK And Parent
                CHECK_(pWc\SetVideoClippingWindow(Parent))
                CHECK_(pWc\SetAspectRatioMode(0))
                pWc\Release()
              EndIf
            EndIf
            pVMRCnfg\Release()
          Else
            Debug "Error: Getting Interface for VMR Config failed"
          EndIf
        EndIf
      Else
        Debug "Error: Adding Individual video render filter failed" 
      EndIf
      pVidRend\Release()
    Else
      Debug "Error: Couldn't Create Instance of individual video renderer"
    EndIf
  EndIf
  
  RendName = ""
  If flags & #WaveOutRenderer
    RendName = "AudioWaveOut Renderer"
    pIndividualRenderer = @CLSID_AudioRender
  ElseIf flags & #DirectSoundRenderer
    RendName = "DirectSound Renderer"
    pIndividualRenderer = @CLSID_DSoundRender
  EndIf
  If RendName
    If CoCreateInstance_(pIndividualRenderer, #Null, #CLSCTX_INPROC, @IID_IBaseFilter, @pAudR) = #S_OK
      If *object\pGraphBuilder\AddFilter(pAudR, @RendName) = #S_OK
        pAudR\Release()
      Else
        Debug "Error: Adding Individual audio render filter failed"
      EndIf
    Else
      Debug "Error: Couldn't Create Instance of individual audio renderer"
    EndIf
  EndIf
  Debug filename
  If *object\pGraphBuilder\RenderFile(@filename, #Null) = #S_OK
    
    If Parent
      *object\hwnd = Parent
      *object\pVideo\get_SourceWidth(@vw)
      *object\pVideo\get_SourceHeight(@vh)
      *object\pVideo\GetPreferredAspectRatio(@ax, @ay)
      
      If ax And ay
        *object\aspectRatio = ax/ay
        *object\widthPAR = (vh * *object\aspectRatio); * 0.70
        vw = *object\widthPAR
        Debug "aspektRatio  : "+StrF(*object\aspectRatio,3)
        Debug "WidthPAR  : "+Str(vw)
      EndIf
      
      *object\width = vw
      *object\height = vh
      Resize(Object, 0, 0, vw, vh)
      CHECK_(*object\pWindow\put_Owner(*object\hwnd))
      CHECK_(*object\pWindow\put_WindowStyle(#WS_CHILD|#WS_CLIPSIBLINGS|#WS_CLIPCHILDREN))
      CHECK_(*object\pWindow\put_Visible(#OATRUE))
    EndIf
    
    If *object\pEvent\SetNotifyWindow(Parent, #WM_GRAPHEVENT, Object.i) = #S_OK
      If *object\pEvent\SetNotifyFlags(0) <> #S_OK
      EndIf
    Else
      Debug "Info: Media notification callback has not been applied"
    EndIf
    If *object\pGraphBuilder\EnumFilters(@pEnum) = #S_OK
      Debug " "
      Debug "--------- Filtergraph ---------"
      While pEnum\Next(1, @pFilter, @cFetched) = #S_OK
        pFilter\QueryFilterInfo(@FilterInfo)
        AddElement(filters())
        Debug PeekS(@FilterInfo, #MAX_FILTER_NAME, #PB_Unicode)
        filters() = PeekS(@FilterInfo, #MAX_FILTER_NAME, #PB_Unicode)
        If FilterInfo\pGraph <> #Null
          FilterInfo\pGraph\Release()
        EndIf
        pFilter\Release()
      Wend
      Debug "--------------------------------------"
      Debug " "
    Else
      Debug "Error: Could not enumerate filters"
    EndIf
    *object\pSeeking\SetTimeFormat(@TIME_FORMAT_MEDIA_TIME)
    *object\pGraphBuilder\Release()
    
    ProcedureReturn #True
  Else
    Debug "Error: Rendering file failed"
    ProcedureReturn #False
  EndIf
  
EndProcedure

Procedure.i Play(Object.i)
  _GetMediaObject(*object)
  ProcedureReturn *object\pControl\run()
EndProcedure

Procedure.i Pause(Object.i)
  _GetMediaObject(*object)
  ProcedureReturn *object\pControl\pause()
EndProcedure

Procedure.i Seek(Object.i, pos.q, SeekByFrame.i=#False)
  Protected RET.i
  _GetMediaObject(*object)
  Protected duration.q
  *object\pSeeking\GetDuration(@duration)
  If SeekByFrame = #False
    pos * 10000
  Else
    *object\pSeeking\SetTimeFormat(@TIME_FORMAT_FRAME)
  EndIf
  
  RET = *object\pSeeking\SetPositions(@pos, #AM_SEEKING_AbsolutePositioning,@duration, #AM_SEEKING_NoPositioning)
  
  *object\pSeeking\SetTimeFormat(@TIME_FORMAT_MEDIA_TIME)
  
  ProcedureReturn RET
EndProcedure

Procedure.i Stop(Object.i)
  _GetMediaObject(*object)
  ProcedureReturn *object\pControl\stop()
EndProcedure

Procedure.i Lenght(Object.i, mode.i = #MEDIA_TIME_MSECS)
  _GetMediaObject(*object)
  Protected duration.q, avgTimePerFrame.d
  *object\pSeeking\GetDuration(@duration)
  If mode = #MEDIA_TIME_MSECS
    ProcedureReturn duration/10000 ; result in ms
  ElseIf mode = #MEDIA_TIME_FRAMES
    *object\pVideo\get_AvgTimePerFrame(@avgTimePerFrame)
    If avgTimePerFrame > 0
      ProcedureReturn (duration/10000) / (avgTimePerFrame*1000) ; result in frames
    EndIf
  EndIf
EndProcedure

Procedure.i Width(Object.i)
  _GetMediaObject(*object)
  ProcedureReturn *object\width
EndProcedure

Procedure.i Height(Object.i)
  _GetMediaObject(*object)
  ProcedureReturn *object\height
EndProcedure

Procedure.i ToggleFullscreen(Object.i)
  _GetMediaObject(*object)
  Protected res.i
  Global  g_origWidth.i, g_OrigHeigth.i
  If Not *object\renderer & #OverlayMixer
    If *object\fullscreen = #True
      SetWindowPos_(FindWindow_("Shell_traywnd", ""), 0, 0, 0, 0, 0, #SWP_SHOWWINDOW)
      Resize(Object.i, #PB_Default, #PB_Default, g_origWidth, g_OrigHeigth)
      *object\pWindow\put_Owner(*object\hwnd)
      *object\pWindow\SetWindowForeground(#OAFALSE)
      *object\pWindow\HideCursor(#OAFALSE)
      UpdateWindow_(*object\hwnd)
      SetForegroundWindow_(*object\hwnd)
      SetFocus_(*object\hwnd)
      *object\fullscreen = #False
      g_MediaFullscreen = #False
      ShowWindow_(*object\hwnd, #SW_SHOW)
      KillThread(*object\thread)
    Else
      ExamineDesktops()
      g_origWidth = Width(Object)
      g_OrigHeigth = Height(Object)
      *object\pWindow\put_Owner(GetDesktopWindow_())
      ShowWindow_(*object\hwnd, #SW_HIDE)
      *object\pWindow\SetWindowForeground(#OATRUE)
      SetWindowPos_(FindWindow_("Shell_traywnd", ""), GetDesktopWindow_(), 0, 0, 0, 0, #SWP_HIDEWINDOW)
      Resize(Object, #PB_Default, #PB_Default, DesktopWidth(0), DesktopHeight(0))
      *object\fullscreen = #True
      g_MediaFullscreen = #True
      *object\thread = CreateThread(@ToggleCursorFullscreen(), *object)
    EndIf
    
    ProcedureReturn #True
  EndIf
EndProcedure

Procedure.i Position(Object.i, mode.i = #MEDIA_TIME_MSECS)
  _GetMediaObject(*object)
  Protected pos.q, avgTimePerFrame.d
  *object\pSeeking\GetCurrentPosition(@pos)
  If mode = #MEDIA_TIME_MSECS
    ProcedureReturn pos/10000 ; result in ms
  ElseIf mode = #MEDIA_TIME_FRAMES
    *object\pVideo\get_AvgTimePerFrame(@avgTimePerFrame)
    If avgTimePerFrame > 0
      ProcedureReturn (pos/10000) / (avgTimePerFrame*1000)
    EndIf
  EndIf
EndProcedure

Procedure.i State(Object.i)
  _GetMediaObject(*object)
  Protected pfs.i
  *object\pControl\GetState(10,@pfs)
  ProcedureReturn pfs
EndProcedure

Procedure.f FPS(Object.i) ; return .f cause we just need float precision
  _GetMediaObject(*object)
  Protected avgTimePerFrame.d
  *object\pVideo\get_AvgTimePerFrame(@avgTimePerFrame)
  If avgTimePerFrame > 0
    ProcedureReturn 1/avgTimePerFrame
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure.i CaptureCurrMediaImage(Object.i, ResultingImgNo.i)
  _GetMediaObject(*object)
  Protected DataSize.i, *pImg.BITMAPINFOHEADER
  If IsImage(ResultingImgNo) = 0
    If *object\pVideo\GetCurrentImage(@DataSize, #Null) = #S_OK
      *pImg = AllocateMemory(DataSize)
      If *pImg
        If *object\pVideo\GetCurrentImage(@DataSize, *pImg) = #S_OK
          If CreateImage(ResultingImgNo, *pImg\biWidth, *pImg\biHeight, *pImg\biBitCount)
            If SetDIBits_(0, ImageID(ResultingImgNo), 0, *pImg\biHeight, *pImg+*pImg\biSize, *pImg, #DIB_RGB_COLORS)
              ProcedureReturn #True
            EndIf
          EndIf
        Else
          Debug "Info: Capturing current image not possible"
        EndIf
        FreeMemory(*pImg)
      Else
        Debug "Error: Allocating ImgBuffer memory failed"
      EndIf
    Else
      Debug "Error: Couldn't measure needed imagebuffer - or actual media contains no videostream"
    EndIf
  Else
    Debug "Error: ImageNumer already valid"
  EndIf
EndProcedure

Procedure.i OnMediaEvent(Object.i)
  _GetMediaObject(*object)
  Protected EventCode.i, Param1.i, Param2.i
  While *object\pEvent\GetEvent(@EventCode, @Param1, @Param2, 0) <> #E_ABORT
    Select EventCode
      Case #EC_COMPLETE
        *object\pControl\stop() ; If an #EC_COMPLETE notify occurs we do change the media state to stopped
        Debug "... end has been reached."
    EndSelect
    *object\pEvent\FreeEventParams(EventCode, Param1, Param2)
  Wend
EndProcedure

Procedure.s Time2String(time.i)
  Protected ti.s, SS, MM, HH, ms
  ms = time%1000
  SS = Int(time / 1000) : While SS > 59:SS-60:Wend
  MM = Int(time / 1000 / 60) : While MM > 59:MM-60:Wend
  HH = Int(time / 1000 / 60 / 60) : While HH > 59:HH-60:Wend
  ti.s =RSet(StrU(HH,#PB_Byte),2,"0")+":"+RSet(StrU(MM,#PB_Byte),2,"0")+":"+RSet(StrU(SS,#PB_Byte),2,"0")+":"+RSet(StrU(ms,#PB_Byte),3,"0")
  ProcedureReturn ti.s
EndProcedure

Procedure.i GetVolume(Object.i) ; from -100db to 0db
  _GetMediaObject(*object)
  Protected db.i
  *object\pAudio\get_Volume(@db)
  ProcedureReturn db/100
EndProcedure

Procedure.i PutVolume(Object.i, db.i) ; from -100db to 0db
  _GetMediaObject(*object)
  If db > -85 And db < 1 ; dont change -85 to -101 as it will mess up WaveOut. A bug in the API ?
    Delay(10) : *object\pAudio\put_Volume(db*100)
  EndIf
EndProcedure

Procedure.i PutBalance(Object.i, bal.i) ; -100 to +100
  _GetMediaObject(*object)
  *object\pAudio\put_balance(bal*100)
EndProcedure

Procedure.i GetBalance(Object.i) ; from -100 to +100
  _GetMediaObject(*object)
  Protected bal
  *object\pAudio\get_balance(@bal)
  ProcedureReturn Int(bal/100)
EndProcedure

Procedure.i Close(Object.i)
  _GetMediaObject(*object)
  
  Protected pfs.i
  If g_MediaFullscreen
    ToggleFullscreen(Object)
  EndIf
  *object\pControl\GetState(10,@pfs)
  If Not pfs = #State_Stopped
    *object\pControl\stop()
  EndIf
  *object\pWindow\put_Visible(#OAFALSE)
  *object\pWindow\put_Owner(#OAFALSE)
  *object\pEvent\SetNotifyWindow(#Null, 0, 0)
  _DeleteInterfaces(Object)
  ClearList(filters())
  ProcedureReturn #True
EndProcedure

Procedure.i IsMedia(Object.i)
  If g_DshowObjects
    If Object<>#PB_Any And Object_IsObject(g_DshowObjects, Object)
      ProcedureReturn #True
    EndIf
  EndIf
EndProcedure

; Special Procedures

Procedure.i CreateInstance()
  Protected *This = AllocateMemory(SizeOf(Integer))
  Protected *object.Dshow_Interfaces
  If Not g_DshowObjects
    g_DshowObjects = Object_Init(SizeOf(Dshow_Interfaces), 1, @FreeInstance())
  EndIf
  *object = Object_GetOrAllocateID(g_DshowObjects, *This)
  If *object
    *object\Object = #True
    CoInitializeEx_(0, $02); #COINIT_APARTMENTTHREADED
                           ;CoInitialize_(0)
    ProcedureReturn *This
  Else
    Debug "Fatal Error: The given media no. hasn't been initialized!"
    CallDebugger
    ProcedureReturn #False
  EndIf
EndProcedure

Procedure.i FreeInstance(Object.i)
  If Object<>#PB_Any And Object_IsObject(g_DshowObjects, Object)
    _GetMediaObject(*object)
    Protected pfs.i
    If *object\pControl
      *object\pControl\GetState(10,@pfs)
      If Not pfs = #State_Stopped
        *object\pControl\stop()
      EndIf
      Close(Object)
    EndIf
    CoUninitialize_()
    Object_FreeID(g_DshowObjects, Object)
    *object\Object = #False
    FreeMemory(Object)
  EndIf
EndProcedure

EndModule


CompilerIf #PB_Compiler_IsMainFile
  
  Define *Media
  Define MainWindow.i
  Define File.s = OpenFileRequester("Open Media File", "", "*.*", 0)
  
  MainWindow = OpenWindow(#PB_Any,20,20,500,500,"PB native Dshow example", #PB_Window_SystemMenu |#PB_Window_ScreenCentered)   
  
  If File
    *Media = DshowMedia::CreateInstance()
    If DshowMedia::Load(*Media, File, WindowID(MainWindow))
      ResizeWindow(MainWindow, #PB_Ignore, #PB_Ignore, DshowMedia::Width(*Media), DshowMedia::Height(*Media))
      DshowMedia::Play(*Media)
      Debug DshowMedia::FPS(*Media)
    EndIf
  Else
    End
  EndIf
  
  
  Repeat
    DshowMedia::OnMediaEvent(*Media)
  Until DshowMedia::State(*Media) = DshowMedia::#State_Stopped Or WaitWindowEvent(10) = #PB_Event_CloseWindow
  
  DshowMedia::PutVolume(*Media,0) ; '0' means 0db = maxVolume --> this is necessary! Otherwise the system sound device will keep the vol state even when appl. has been closed.
  Debug DshowMedia::FreeInstance(*Media)
  
CompilerEndIf
You don't need "@FilterInfo\achName" to get the address, since it's the first element in the structure (-> both addresses are the same). Someone correct me, if this is untrue!!!

Re: Need help making code x64 compatible

Posted: Tue Apr 23, 2024 12:37 am
by Quin
Keep in mind this is being posted after a super quick glance over just the error line, but is it possibly this?
Been seeing that one a lot...
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited