Hi, I already posted in another thread, hopefully this gets seen by more people in here.
http://www.purebasic.fr/english/viewtop ... 03#p498403
Need help making code x64 compatible
Re: Need help making code x64 compatible
Looks like a Bug with p-unicode.
I replaced these calls with normal string address and it works here in x64
However this means it's unicode only!
I replaced these calls with normal string address and it works here in x64
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)
CompilerEndIfRe: Need help making code x64 compatible
Thank you very much, should this be reported as a bug?
Re: Need help making code x64 compatible
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 ...
If you trim down the old code, it might also stop crashing ...
Re: Need help making code x64 compatible
Since PB6.11B1 there is a 'Syntax error' @ line 364
Does anyone knows, what the problem could be?
Code: Select all
OleCreatePropertyFrame_(*object\hwnd, 0, 0, @FilterInfo\achName, 1, @*pFilterUnk, caGUID\cElems, caGUID\pElems, 0, 0, #Null) : Debug "7"
"Daddy, I'll run faster, then it is not so far..."
Re: Need help making code x64 compatible
I'm not 100% sure and mayb this is 100% crap, but: It should work this way:
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!!!
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)
CompilerEndIfGood morning, that's a nice tnetennba!
PureBasic 6.21/Windows 11 x64/Ryzen 7900X/32GB RAM/3TB SSD
Synology DS1821+/DX517, 130.9TB+50.8TB+2TB SSD
PureBasic 6.21/Windows 11 x64/Ryzen 7900X/32GB RAM/3TB SSD
Synology DS1821+/DX517, 130.9TB+50.8TB+2TB SSD
Re: Need help making code x64 compatible
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...
Been seeing that one a lot...