Media Player [Windows]

RASHAD · Post by **RASHAD** » Tue Jul 08, 2014 12:32 am

Removed

dige · Post by **dige** » Tue Jul 08, 2014 10:09 am

Thanks RASHAD, but now I've got an IMA @ *object\pSeeking\Release() ...
What I also have noticed, the playback of HD material is very pixelated. Is it possible to configure the renderer yet?

Ciao Dige

RASHAD · Post by **RASHAD** » Wed Jul 09, 2014 8:13 am

Hi dige
I just found the bug and to be sure next is the modified Part #1
With some add ins

- Left Mouse Button Down on the Movie to move
- Right Click on the Menu to Hide on - Hide off

Code: Select all

Global hwnd,hwnd_1,TTime.d,Frames,OldPos,im,Vol,fps,Run,Result,Media
im = 100

UseJPEGImageEncoder()
UsePNGImageEncoder()

#COINIT_APARTMENTTHREADED  = 2
#COINIT_MULTITHREADED      = 0
#COINIT_DISABLE_OLE1DDE    = 4
#COINIT_SPEED_OVER_MEMORY  = 8


#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


#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
  #State_Stopped
  #State_Paused
  #State_Running
EndEnumeration

Enumeration
  #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 
    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_#
    ProcedureReturn #False
  EndIf
EndMacro

Macro CHECK_(in)
  CompilerIf #PB_Compiler_Debugger
    If Not SUCCEEDED(in#)
    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\pGraphBuilder)
  _SafeRelease(*object\pControl)
  _SafeRelease(*object\pEvent)
  _SafeRelease(*object\pWindow)
  _SafeRelease(*object\pAudio)
  _SafeRelease(*object\pVideo)
  _SafeRelease(*object\pSeeking)
  _SafeRelease(*object\pMediaPosition)
 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
     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)
    If SUCCEEDED(a) And SUCCEEDED(b) And SUCCEEDED(c) And SUCCEEDED(d) And SUCCEEDED(e) And SUCCEEDED(f) And SUCCEEDED(g)
      ProcedureReturn #True
    Else
      _DeleteInterfaces(Object)
       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
 
 
;   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
            
          EndIf
        EndIf
      Else
        
      EndIf
      pVidRend\Release()
    Else
      
    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
        
      EndIf
    Else
      
    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 
      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
    EndIf
    If *object\pGraphBuilder\EnumFilters(@pEnum) = #S_OK
       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

  Else
 
  EndIf
  *object\pSeeking\SetTimeFormat(@TIME_FORMAT_MEDIA_TIME)
  *object\pGraphBuilder\Release()

  ProcedureReturn #True
Else
  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()
    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
      _DeleteInterfaces(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, #COINIT_APARTMENTTHREADED)
    ProcedureReturn #True
  Else
    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
                    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                      
               
                      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
                  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

dige · Post by **dige** » Wed Jul 09, 2014 7:58 pm

*thumbs up* well done RASHAD!

Thank you

RASHAD · Post by **RASHAD** » Wed Jul 16, 2014 12:19 am

New with MCI
http://www.purebasic.fr/english/viewtop ... 14&t=59923

minimy · Post by **minimy** » Thu Nov 27, 2014 10:48 pm

Hi RASHAD, and thanks for share.
Do you know how select an especific movie audio track in a multilanguaje movie?

Thanks!

dige · Post by **dige** » Fri Apr 15, 2016 8:54 pm

@RASHAD: Supports DirectShow something like CatchMedia()

Ciao Dige

RASHAD · Post by **RASHAD** » Sat Apr 16, 2016 7:26 am

Hi dige
You mean run a movie file from DataSection ?

dige · Post by **dige** » Sat Apr 16, 2016 8:21 am

Hi RASHAD, I'll play encrypted movies directly from RAM.
Would be very handy, to use CatchMedia (*mem) than, instead of LoadMedia()..

Mesa · Post by **Mesa** » Tue Jan 10, 2017 12:13 pm

Hi rashad, do you think it's possible to overlay a png picture with transparency on a video from a position-time to an other (not all the duration of a film) ?

an idea ?

Thanks.

Mesa.

RASHAD · Post by **RASHAD** » Tue Jan 10, 2017 2:58 pm

Hi
If you want to make it permanent you can do it by using tools like
1- VirtualDub
2- AVIdemux

But if you want it temporary while playing the movie yes you can by using
FFdshow filters
http://www.free-codecs.com/download/ffdshow.htm

Good luck

dige · Post by **dige** » Sun Feb 19, 2017 12:51 pm

@Rashad: I'll use the player to grab frames from the videostream. I have 4K stream materials from a copter flight and need the sharpest frame for the snapshot.
So I will grab some more frames before and after the selected frames and will compare them automatically for the best sharpness.

In the german forum I've found a hint to use the ISampleGrabber, but I have not the skills, to know, how to use it.

There is also this way:

Code: Select all

  *p\pVideo\GetCurrentImage(@DataSize, *pImg)
  CreateImage(ResultingImgNo, *pImg\biWidth, *pImg\biHeight, *pImg\biBitCount)
  SetDIBits_(0, ImageID(ResultingImgNo), 0, *pImg\biHeight, *pImg+*pImg\biSize, *pImg, #DIB_RGB_COLORS)

but pVideo\GetCurrentImage() is very slow ( needs 1500ms per frame )

Code: Select all

; German forum, DarkDragon
; http://www.purebasic.fr/german/viewtopic.php?f=3&t=21119&start=40

;===========================================================================================================
; Beim Initialisieren:
;===========================================================================================================

Define *GraphBuilder.IGraphBuilder ; Der steht irgendwo im Code definiert
Define *SampleGrabberFilter.IBaseFilter
Define *SampleGrabber.ISampleGrabber

If CoCreateInstance_(@CLSID_SampleGrabber, 0, #CLSCTX_INPROC_SERVER, @IID_IBaseFilter, @*SampleGrabberFilter) = #S_OK
  *GraphBuilder\AddFilter(*SampleGrabberFilter, #Null)

  *SampleGrabberFilter\QueryInterface(@IID_ISampleGrabber, @*SampleGrabber)
  If *SampleGrabber
    *SampleGrabber\SetBufferSamples(1)
  Else
    Debug "Error: couldn't query IID_ISampleGrabber instance."
  EndIf
Else
  Debug "Error: couldn't create CLSID_SampleGrabber instance."
EndIf

;===========================================================================================================
; Beim Starten des Rendering-Vorgangs dann einfach den *SampleGrabberFilter angeben statt dem VideoRenderer.
;===========================================================================================================

;===========================================================================================================
; Während der Film dann läuft kann man dann mit folgendem Code ein Frame holen:
;===========================================================================================================
Define Length.q
Define *Buffer
Define MediaType.AM_MEDIA_TYPE

; Hole den MediaType
*SampleGrabber\GetConnectedMediaType(@MediaType)

If *SampleGrabber\GetCurrentBuffer(@Length, 0) = #S_OK
  *Buffer = AllocateMemory(Length)
  If *Buffer
    If *SampleGrabber\GetCurrentBuffer(@Length, *Buffer) = #S_OK
      ; Verarbeite nun den *Buffer und MediaType, zeichne ihn auf dein Fenster oder sonst was. StretchDIBits_ könnte da gut zu gebrauchen sein.
    Else
      Debug "Error: what's happening here?"
    EndIf
    FreeMemory(*Buffer)
  Else
    Debug "Error: not enough memory"
  EndIf
Else
  Debug "Error: no frame there"
EndIf

;===========================================================================================================
; Beim freigeben:
;===========================================================================================================

If *SampleGrabber <> #Null
  *SampleGrabber\Release()
  *SampleGrabber = #Null
EndIf

If *SampleGrabberFilter <> #Null
  If *GraphBuilder <> #Null
    *GraphBuilder\RemoveFilter(*SampleGrabberFilter)
  EndIf
  *SampleGrabberFilter\Release()
  *SampleGrabberFilter = #Null
EndIf

Can someone help me, to find a fast way to grab frames from video?

ciao dige

Michael Vogel · Post by **Michael Vogel** » Sun Feb 19, 2017 4:41 pm

Maybe a small bug, but when clicking on the check mark before loading anything, the program crashes here (Line 308 in the procedure ResizeMedia).
But maybe the code will not be updated any more because it has been replaced by the MCI media player

dige · Post by **dige** » Mon Feb 20, 2017 9:54 am

Do you really think so? I thougt MCI is deprecated?

RASHAD · Post by **RASHAD** » Mon Feb 20, 2017 12:46 pm

Hi dige,MV
MV is joking

I am using 2 tech. in my Media Player
1- Using FFdshow filters to grab 10 consecutive sharp frames without affecting the display
2- Using RASHAD patent pending

2-1 Initialize 2 media at start (Media0 & Media1)
2-2 Load the media into the 2 streams
2-3 Media0 in conjunction with the main display window
Media1 in conjunction with the window2 (#win,-10,0,10,10,"",Boderless)
The size of the window does not matter

3- Start playing media0 only
4- When I need to capture the frame I read first the position of Media0
4-1 Seek Media1 to that position or any position then capture the frame
4-2 Save the frame with any required format
(The second method due to Windows XP lack of some functions)

I can upload the Media Player EXE file if you like

PureBasic Forums - English

Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]

Re: Media Player [Windows]