- Capture Frames without pause
- Resize with respect to Aspect Ratio
- Move by no.of frames forward or backward
And many more
Part #1
Code: Select all
Global hwnd,hwnd_1,TTime.d,Frames,OldPos,im,Vol,fps,Run,Result,Media
im = 100
UseJPEGImageEncoder()
UsePNGImageEncoder()
#TBS_TOOLTIPS = $0100
#CAPTUREBLT = $40000000
#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
#VMRMode_Windowed = $1
#VMRMode_Windowless = $2
#VMRMode_Renderless = $4
#VMRMode_Mask = $7
#RenderPrefs_ForceOffscreen = $00000001
#RenderPrefs_ForceOverlays = $00000002
#RenderPrefs_AllowOverlays = $00000000
#RenderPrefs_AllowOffscreen = $00000000
#RenderPrefs_DoNotRenderColorKeyAndBorder = $00000008
#RenderPrefs_RestrictToInitialMonitor = $00000010
#RenderPrefs_PreferAGPMemWhenMixing = $00000020
#RenderPrefs_Mask = $0000003F
;{ Flag options / renderers
#Default = 0
#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
Interface IGraphBuilder_forceUnicode
QueryInterface(a, b)
AddRef()
Release()
AddFilter(a, b.p-unicode)
RemoveFilter(a)
EnumFilters(a)
FindFilterByName(a.p-unicode, b)
ConnectDirect(a, b, c)
Reconnect(a)
Disconnect(a)
SetDefaultSyncSource()
Connect(a, b)
Render(a)
RenderFile(a.p-unicode, b)
AddSourceFilter(a.p-unicode, b.p-unicode, c)
SetLogFile(a)
Abort()
ShouldOperationContinue()
EndInterface
Structure Dshow_Interfaces
Object.l
pGraphBuilder.IGraphBuilder_forceUnicode
pControl.IMediaControl
pEvent.IMediaEventEx
pWindow.IVideoWindow
pAudio.IBasicAudio
pVideo.IBasicVideo2
pSeeking.IMediaSeeking
pMediaPosition.IMediaPosition
pSampleGrabber.ISampleGrabber
thread.l
fullscreen.l
hwnd.i
drain.l
aspectRatio.f
width.l
widthPAR.l
height.l
renderer.l
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.l
*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 FAILED(Status)
Status < 0
EndMacro
Macro SUCCEEDED(Status)
Status >= 0
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_IMediaPosition, $56a868b2, $0ad4, $11ce, $b0, $3a, $00, $20, $af, $0b, $a7, $70)
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.l) As "_PB_Object_GetOrAllocateID@8"
Object_GetObject(*Objects, Object.l) As "_PB_Object_GetObject@8"
Object_IsObject(*Objects, Object.l) As "_PB_Object_IsObject@8"
Object_FreeID(*Objects, Object.l) As "_PB_Object_FreeID@8"
Object_Init(structuresize.l, IncrementStep.l, *ObjectFreeFunction) As "_PB_Object_Init@12"
CompilerElse
Object_GetOrAllocateID(*Objects, Object.l) As "PB_Object_GetOrAllocateID"
Object_GetObject(*Objects, Object.l) As "PB_Object_GetObject"
Object_IsObject(*Objects, Object.l) As "PB_Object_IsObject"
Object_FreeID(*Objects, Object.l) As "PB_Object_FreeID"
Object_Init(structuresize.l, IncrementStep.l, *ObjectFreeFunction) As "PB_Object_Init"
CompilerEndIf
EndImport:IsWindow(#PB_Any)
Global g_DshowObjects.l
Global NewList filters.s()
Procedure GetFilterProperties(Object.l, 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"
*pFilterUnk\Release()
FilterInfo\pGraph\Release()
CoTaskMemFree_(caGUID\pElems)
ProcedureReturn #True
EndIf
EndIf
EndProcedure
Procedure _DeleteInterfaces(Object.l)
_GetMediaObject(*object)
_SafeRelease(*object\pControl)
_SafeRelease(*object\pEvent)
_SafeRelease(*object\pWindow)
_SafeRelease(*object\pAudio)
_SafeRelease(*object\pVideo)
_SafeRelease(*object\pSeeking)
_SafeRelease(*object\pMediaPosition)
;_SafeRelease(*object\pSampleGrabber)
;_SafeRelease(*object\pGraphBuilder)
ProcedureReturn #True
EndProcedure
Procedure _BuildInterfaces(Object.l)
_GetMediaObject(*object)
Protected a.l, b.l, c.l, d.l, e.l, f.l ,g.l,h.l
If CoCreateInstance_(@CLSID_FilterGraph, #Null, #CLSCTX_INPROC_SERVER, @IID_IGraphBuilder, @*object\pGraphBuilder) <> #S_OK
;CoCreateInstance_(@CLSID_SampleGrabber, #Null, #CLSCTX_INPROC_SERVER, @IID_IBaseFilter, @*object\pSampleGrabber); <> #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)
g = *object\pGraphBuilder\QueryInterface(@IID_IMediaPosition, @*object\pMediaPosition)
;h = *object\pGraphBuilder\QueryInterface(@IID_ISampleGrabber, @*object\pSampleGrabber)
If SUCCEEDED(a) And SUCCEEDED(b) And SUCCEEDED(c) And SUCCEEDED(d) And SUCCEEDED(e) And SUCCEEDED(f) And SUCCEEDED(g); And SUCCEEDED(h); 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 ResizeMedia(Object.l, x.l, y.l, width.l, height.l , keepAR.l = #True)
;x = 8 : y = 8: width - 10 : height - 75
_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
;BringWindowToTop_(*object\pWindow)
EndProcedure
Procedure LoadMedia(Object.l, filename.s, Parent=0, flags.l = #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
;Debug UCase(GetFilePart(filename))
; If UCase(GetFilePart(filename)) = "VIDEO_TS.IFO"
; ;Debug "yes"
; EndIf
_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
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
ResizeMedia(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))
UpdateWindow_(*object\hwnd)
SetForegroundWindow_(*object\hwnd)
SetFocus_(*object\hwnd)
EndIf
If *object\pEvent\SetNotifyWindow(Parent, #WM_GRAPHEVENT, Object.l) = #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 PutRate(Object.l,rate.f)
_GetMediaObject(*object)
ProcedureReturn *object\pMediaPosition\put_Rate(rate)
EndProcedure
Procedure PlayMedia(Object.l)
_GetMediaObject(*object)
ProcedureReturn *object\pControl\run()
EndProcedure
Procedure PauseMedia(Object.l)
_GetMediaObject(*object)
ProcedureReturn *object\pControl\pause()
EndProcedure
Procedure MediaSeek(Object.l, pos.q)
_GetMediaObject(*object)
Protected duration.q
pos * 10000
*object\pSeeking\GetDuration(@duration)
ProcedureReturn *object\pSeeking\SetPositions(@pos, #AM_SEEKING_AbsolutePositioning,@duration, #AM_SEEKING_NoPositioning)
EndProcedure
Procedure MediaStop(Object.l)
_GetMediaObject(*object)
ProcedureReturn *object\pControl\stop()
EndProcedure
Procedure MediaLenght(Object.l, mode.l)
_GetMediaObject(*object)
Protected duration.q, avgTimePerFrame.d
*object\pSeeking\GetDuration(@duration)
If mode = #MEDIA_TIME_MSECS
ProcedureReturn duration/10000
ElseIf mode = #MEDIA_TIME_FRAMES
*object\pVideo\get_AvgTimePerFrame(@avgTimePerFrame)
If avgTimePerFrame > 0
ProcedureReturn (duration/10000) / (avgTimePerFrame*1000)
EndIf
EndIf
EndProcedure
Procedure MediaWidth(Object.l)
_GetMediaObject(*object)
ProcedureReturn *object\width
EndProcedure
Procedure MediaHeight(Object.l, height.l = #PB_Default)
_GetMediaObject(*object)
ProcedureReturn *object\height
EndProcedure
Procedure MediaPosition(Object.l, mode.l)
_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 MediaState(Object.l)
_GetMediaObject(*object)
Protected pfs.l
*object\pControl\GetState(10,@pfs)
ProcedureReturn pfs
EndProcedure
Procedure.f MediaFPS(Object.l)
_GetMediaObject(*object)
Protected avgTimePerFrame.d
*object\pVideo\get_AvgTimePerFrame(@avgTimePerFrame)
If avgTimePerFrame > 0
ProcedureReturn 1/avgTimePerFrame
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure OnMediaEvent(Object.l)
_GetMediaObject(*object)
Protected EventCode.l, Param1.l, Param2.l
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 MediaTime2String(time.l)
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,2),2,"0")+":"+RSet(StrU(MM,2),2,"0")+":"+RSet(StrU(SS,2),2,"0")+":"+RSet(StrU(ms,2),3,"0")
ProcedureReturn ti.s
EndProcedure
Procedure MediaGetVolume(Object.l) ; from -100db to 0db
_GetMediaObject(*object)
Protected db.l
*object\pAudio\get_Volume(@db)
ProcedureReturn db/100
EndProcedure
Procedure MediaPutVolume(Object.l, db.l)
_GetMediaObject(*object)
If db > -85 And db < 1
Delay(10) : *object\pAudio\put_Volume(db*100)
EndIf
EndProcedure
Procedure MediaPutBalance(Object.l, bal.l)
_GetMediaObject(*object)
*object\pAudio\put_balance(bal*100)
EndProcedure
Procedure MediaGetBalance(Object.l)
_GetMediaObject(*object)
Protected bal
*object\pAudio\get_balance(@bal)
ProcedureReturn Int(bal/100)
EndProcedure
Procedure CloseMedia(Object.l)
_GetMediaObject(*object)
Protected pfs.l
*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 FreeMedia(Object.l)
If Object<>#PB_Any And Object_IsObject(g_DshowObjects, Object)
_GetMediaObject(*object)
Protected pfs.l
If *object\pControl
*object\pControl\GetState(10,@pfs)
If Not pfs = #State_Stopped
*object\pControl\stop()
EndIf
CloseMedia(Object)
EndIf
CoUninitialize_()
Object_FreeID(g_DshowObjects, Object)
*object\Object = #False
ProcedureReturn #True
EndIf
EndProcedure
Procedure InitMedia(Object.l)
Protected *object.Dshow_Interfaces
If Not g_DshowObjects
g_DshowObjects = Object_Init(SizeOf(Dshow_Interfaces), 1, @FreeMedia())
EndIf
*object = Object_GetOrAllocateID(g_DshowObjects, Object)
If *object
*object\Object = #True
CoInitializeEx_(0, $02); #COINIT_APARTMENTTHREADED
;CoInitialize_(0)
ProcedureReturn #True
Else
;Debug "Fatal Error: The given media no. hasn't been initialized!"
;CallDebugger
ProcedureReturn #False
EndIf
EndProcedure
Procedure WndProc(hwnd, uMsg, wParam, lParam)
result = #PB_ProcessPureBasicEvents
Select uMsg
Case #WM_SIZE;,#WM_MOVE,#WM_PAINT
If Run = 1; And MediaState(#Media) = #State_Running
ResizeGadget(0,5, WindowHeight(0)-73, WindowWidth(0)-10,68)
ResizeGadget(1,0, 0, WindowWidth(0)-10,22)
ResizeWindow(1, 5, 5,WindowWidth(0)-10,WindowHeight(0)- 84)
ResizeMedia(Media, 0, 0, WindowWidth(1), WindowHeight(1),GetGadgetState(16))
Else
ResizeGadget(0,5, WindowHeight(0)-73, WindowWidth(0)-10,68)
ResizeGadget(1,0, 0, WindowWidth(0)-10,22)
ResizeWindow(1, 5, 5,WindowWidth(0)-10,WindowHeight(0)-84)
EndIf
EndSelect
ProcedureReturn result
EndProcedure
CatchImage(0 , ?Mute3)
CatchImage(1 , ?New2)
CatchImage(2 , ?Nframe)
CatchImage(3 , ?Pause2)
CatchImage(4 , ?Play2)
CatchImage(5 , ?Pframe)
CatchImage(6 , ?Save)
CatchImage(7 , ?Sound2)
CatchImage(8 , ?Stop)
CatchImage(9 , ?Max)
CatchImage(10, ?Rest)
ExamineDesktops()
hwnd = OpenWindow(0,0,0,800,600,"PB native Dshow example",#PB_Window_BorderLess|#WS_THICKFRAME|#WS_BORDER|#PB_Window_ScreenCentered)
SetWindowColor(0,$45D1FE)
WindowBounds(0,800,600,#PB_Ignore,#PB_Ignore)
ContainerGadget(0,5,527,790,68,#PB_Container_Flat)
SetGadgetColor(0, #PB_Gadget_BackColor, $E3E3E3)
TrackBarGadget (1, 0, 0, 790, 22, 0, 10000,#TBS_FIXEDLENGTH)
SendMessage_(GadgetID(1), #TBM_SETTHUMBLENGTH,20,0)
ButtonImageGadget (2 ,2 ,28,32,32,ImageID(1)) ;Load
GadgetToolTip(2,"New Media")
ButtonImageGadget (3 ,50, 32,24,24,ImageID(5)) ;Previous Frame
GadgetToolTip(3,"Step Backward")
SpinGadget (4 ,75, 34,28,20,0,100,#PB_Spin_Numeric) ;No. of Previos Frames
GadgetToolTip(4,"No.of Frames to Step Backward")
ButtonImageGadget (5 ,112, 28,46,32,ImageID(4)) ;Play
GadgetToolTip(5,"Play- Pause")
SpinGadget (6 ,165, 34,28,20,0,100,#PB_Spin_Numeric) ;No. of Next Frames
GadgetToolTip(6,"No.of Frames to Step Forward")
ButtonImageGadget (7,193, 32,24,24,ImageID(2)) ;Next Frame
GadgetToolTip(7,"Step Forward")
ButtonImageGadget (8,530, 29,30,30,ImageID(6)) ;Save As
GadgetToolTip(8,"Capture & Save Frame")
TrackBarGadget (9,300,24,70,16, 0, 25) ;Sound Volume
GadgetToolTip(9,"Sound Volume")
ButtonImageGadget (10,230, 28,32,32,ImageID(7)) ;Sound Control
GadgetToolTip(10,"Mute")
ButtonImageGadget (11,264, 28,32,32,ImageID(9)) ;Max - Min
GadgetToolTip(11,"Maximize - Restore")
ButtonImageGadget (12,750, 29,32,32,ImageID(8)) ;Quit
GadgetToolTip(12,"Quit")
TrackBarGadget (13,300,46,70,16,0, 20,#TBS_TOOLTIPS) ;PlayBack Speed
GadgetToolTip(13,"PlayBack Speed")
ComboBoxGadget(14,376,22,140,20)
GadgetToolTip(14,"Audio Mode")
AddGadgetItem(14, -1, "WaveOutRenderer")
AddGadgetItem(14, -1, "DirectSoundRenderer")
ComboBoxGadget(15,376,43,120,20)
GadgetToolTip(15,"Video Mode")
AddGadgetItem(15, -1, "VMR9_Windowed")
AddGadgetItem(15, -1, "VMR9_Windowless")
AddGadgetItem(15, -1, "VMR7_Windowed")
AddGadgetItem(15, -1, "VMR7_Windowless")
AddGadgetItem(15, -1, "OldVideoRenderer")
AddGadgetItem(15, -1, "OverlayMixer")
AddGadgetItem(15, -1, "VMR7_ForceOverlays")
AddGadgetItem(15, -1, "VMR7_ForceOffscreen")
CheckBoxGadget(16,502,45,18,18,"",#PB_CheckBox_Center)
GadgetToolTip(16,"Aspect Ratio")
ComboBoxGadget(17,565,34,145,20)
GadgetToolTip(17,"Save Image Format")
AddGadgetItem(17, -1, "Use BMP ImageEncoder")
AddGadgetItem(17, -1, "Use JPEG ImageEncoder")
AddGadgetItem(17, -1, "Use PNG ImageEncoder")
CloseGadgetList()
SetGadgetState(4,1)
SetGadgetState(6,1)
SetGadgetState(9,25)
SetGadgetState(13,10)
SetGadgetState(14, 1)
SetGadgetState(15, 2)
SetGadgetState(16, 1)
SetGadgetState(17, 2)
SetGadgetItemData(14,0,1 << 6)
SetGadgetItemData(14,1,1 << 7)
SetGadgetItemData(15, 0, 1 << 0)
SetGadgetItemData(15, 1, 1 << 1)
SetGadgetItemData(15, 2, 1 << 2)
SetGadgetItemData(15, 3, 1 << 3)
SetGadgetItemData(15, 4, 1 << 4)
SetGadgetItemData(15, 5, 1 << 5)
SetGadgetItemData(15, 6, 1 << 6)
SetGadgetItemData(15, 7, 1 << 8)
SetGadgetItemData(15, 8, 1 << 9)
SetGadgetItemData(15, 9, 1 << 10)
hwnd_1 = OpenWindow(1,5,5,790,516,"PB native Dshow example",#PB_Window_BorderLess)
SetWindowColor(1,#Black)
SetParent_(WindowID(1),WindowID(0))
SetWindowCallback(@WndProc())
SetActiveWindow(0)
AddWindowTimer(0, 125, 10)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit = 1
Case #PB_Event_Gadget
Select EventGadget()
Case 1 ;TrackBar
If Run = 1
If GetAsyncKeyState_(#VK_LBUTTON) > 0
SetGadgetAttribute(5,#PB_Button_Image,ImageID(4))
PauseMedia(Media)
MediaSeek(Media, (TTime.d/10000)*GetGadgetState(1))
ElseIf GetAsyncKeyState_(#VK_LBUTTON) = 0
SetGadgetAttribute(5,#PB_Button_Image,ImageID(3))
Play = 1
PlayMedia(Media)
EndIf
EndIf
Case 2 ;Load
Mode = GetGadgetItemData(15, GetGadgetState(15))|GetGadgetItemData(14, GetGadgetState(14))
If OSVersion() <= #PB_OS_Windows_Vista
Mode = #OldVideoRenderer|#DirectSoundRenderer ;#WaveOutRenderer ;#OverlayMixer|#DirectSoundRenderer ;
EndIf
If Run = 1
MediaSeek(Media,0)
CloseMedia(Media)
FreeMedia(Media)
SetGadgetAttribute(5,#PB_Button_Image,ImageID(4))
SetGadgetState(1,0)
Run = 0 :Play = 0 :Mute = 0 :Menu = 0
EndIf
File.s = OpenFileRequester("Choose media file","","All Files (*.*)|*.*",0)
If File <> ""
Cap$ = Left(GetFilePart(File), Len(GetFilePart(File))-Len(GetExtensionPart(File))-1)
InitMedia(Media)
If IsLibrary(0)
*func=GetFunction(0,"DwmEnableComposition")
CallFunctionFast(*func,1)
CloseLibrary(0)
EndIf
If OSVersion() >= #PB_OS_Windows_Vista And Mode & #OverlayMixer
Mode = Mode|#VMR7_Windowed &~ #OverlayMixer
OpenLibrary(0, "dwmapi.dll")
*func=GetFunction(0,"DwmEnableComposition")
CallFunctionFast(*func,0)
EndIf
If (OSVersion() = #PB_OS_Windows_XP Or OSVersion() = #PB_OS_Windows_Server_2003) And Mode & #OverlayMixer
Mode = Mode|#VMR7_Windowed &~ #OverlayMixer
EndIf
LoadMedia(Media, File, hwnd_1 ,Mode)
TTime.d = MediaLenght(Media, #MEDIA_TIME_MSECS)
Frames = MediaLenght(Media, #MEDIA_TIME_FRAMES)
fps = MediaFPS(Media) ;Frames*1000/TTime
If Frames <> 0 And fps <> 0
mWidth = MediaWidth(Media) : mHeight = MediaHeight(Media)
ResizeWindow(1, 5, 5,WindowWidth(0)-10,WindowHeight(0)- 84)
ResizeMedia(Media, 0, 0, WindowWidth(1), WindowHeight(1),#True)
Run = 1
Else
MessageRequester("Error","Can not load the movie !"+#CRLF$+"Check the Codecs",#MB_ICONERROR)
Run = 0
EndIf
EndIf
Case 3 ;Pframe
If Run = 1
PauseMedia(Media)
For i = 1 To GetGadgetState(4)
MediaSeek(Media, MediaPosition(Media,#MEDIA_TIME_MSECS)-fps)
If MediaPosition(Media,#MEDIA_TIME_FRAMES) = OldPos
MediaSeek(Media, MediaPosition(Media,#MEDIA_TIME_MSECS)-fps)
EndIf
OldPos = MediaPosition(Media,#MEDIA_TIME_MSECS)
Next
Play = 0
SetGadgetAttribute(5,#PB_Button_Image,ImageID(4))
EndIf
Case 5 ;Play\Pause
If Run = 1
PutRate(Media,GetGadgetState(13)/10)
Play ! 1
If Play = 1
SetGadgetAttribute(5,#PB_Button_Image,ImageID(3))
PlayMedia(Media)
Else
SetGadgetAttribute(5,#PB_Button_Image,ImageID(4))
PauseMedia(Media)
EndIf
EndIf
Case 7 ;Nframe
If Run =1
PauseMedia(Media)
For i = 1 To GetGadgetState(6)
MediaSeek(Media, MediaPosition(Media,#MEDIA_TIME_MSECS)+fps)
If MediaPosition(Media,#MEDIA_TIME_FRAMES) = OldPos
MediaSeek(Media, MediaPosition(Media,#MEDIA_TIME_MSECS)+fps)
EndIf
OldPos = MediaPosition(Media,#MEDIA_TIME_MSECS)
Next
Play = 0
SetGadgetAttribute(5,#PB_Button_Image,ImageID(4))
EndIf
Case 8 ;Save As
hBitmap = CreateImage(0,WindowWidth(1),WindowHeight(1))
hdc = StartDrawing(ImageOutput(0))
SelectObject_(hdc, hBitmap)
BitBlt_(hdc, 0, 0, WindowWidth(1),WindowHeight(1), GetDC_(GetDesktopWindow_()), WindowX(1),WindowY(1), #SRCCOPY | #CAPTUREBLT)
StopDrawing()
DeleteDC_(hdc)
If Run = 1
If GetGadgetState(17) = 0
SaveImage(0, GetHomeDirectory()+Cap$+" "+Right(Str(im),2)+".bmp",#PB_ImagePlugin_BMP)
ElseIf GetGadgetState(17) = 1
SaveImage(0, GetHomeDirectory()+Cap$+" "+Right(Str(im),2)+".jpg",#PB_ImagePlugin_JPEG)
Else
SaveImage(0, GetHomeDirectory()+Cap$+" "+Right(Str(im),2)+".png",#PB_ImagePlugin_PNG)
EndIf
im+1
EndIf
Case 9
If Run =1
MediaPutVolume(Media, GetGadgetState(9) - 25)
EndIf
Case 10 ;Sound \ Mute
If Run = 1
Mute ! 1
If Mute = 1
SetGadgetAttribute(10,#PB_Button_Image,ImageID(0))
MediaPutVolume(Media, MediaGetVolume(Media)-80)
Else
SetGadgetAttribute(10,#PB_Button_Image,ImageID(7))
MediaPutVolume(Media, MediaGetVolume(Media)+80)
EndIf
EndIf
Case 11 ;Max \ Restore
If Run =1
Max ! 1
If Max = 1
SetGadgetAttribute(11,#PB_Button_Image,ImageID(10))
ShowWindow_(WindowID(0),#SW_MAXIMIZE)
Else
SetGadgetAttribute(11,#PB_Button_Image,ImageID(9))
ShowWindow_(WindowID(0),#SW_RESTORE )
EndIf
EndIf
Case 12 ;Quit
If IsLibrary(0)
CloseLibrary(0)
EndIf
If Run = 1
CloseMedia(Media)
FreeMedia(Media)
EndIf
Quit = 1
Case 13
If Run = 1
PutRate(Media,GetGadgetState(13)/10)
EndIf
Case 16
ResizeGadget(0,5, WindowHeight(0)-73, WindowWidth(0)-10,68)
ResizeGadget(1,0, 0, WindowWidth(0)-10,22)
ResizeWindow(1, 5, 5,WindowWidth(0)-10,WindowHeight(0)- 84)
ResizeMedia(Media, 0, 0, WindowWidth(1), WindowHeight(1),GetGadgetState(16))
EndSelect
Case #PB_Event_MoveWindow
UpdateWindow_(WindowID(0))
Case #PB_Event_Timer
If Run = 1 And MediaState(Media) = #State_Running
Npos.f = MediaPosition(Media,#MEDIA_TIME_MSECS)
SetGadgetState(1, Int(Npos.f * 10000 / TTime ) )
EndIf
;
Case #WM_LBUTTONDOWN
GetCursorPos_ (@p.POINT)
ScreenToClient_ (WindowID(0), @p)
If ChildWindowFromPoint_ (WindowID(0), p\y<< 32+p\x) = GadgetID(0)
SetCursor_(LoadCursor_(0, #IDC_ARROW))
Else
SetCursor_(LoadCursor_(0, #IDC_SIZEALL))
SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
EndIf
;
Case #WM_RBUTTONDOWN
Menu ! 1
If Menu = 1
SetWindowColor(0,#Black)
HideGadget(0,1)
Else
SetWindowColor(0,$45D1FE)
HideGadget(0,0)
EndIf;
EndSelect
;
Until Quit = 1
If IsLibrary(0)
CloseLibrary(0)
EndIf