Direct Show

Für allgemeine Fragen zur Programmierung mit PureBasic.
Benutzeravatar
Fluid Byte
Beiträge: 3110
Registriert: 27.09.2006 22:06
Wohnort: Berlin, Mitte

Re: Direct Show

Beitrag von Fluid Byte »

Hallo
Wie stellen Frage richtig?
Windows 10 Pro, 64-Bit / Outtakes | Derek
Benutzeravatar
Max_der_Held
Beiträge: 594
Registriert: 18.04.2006 17:01
Wohnort: Bavaria
Kontaktdaten:

Re: Direct Show

Beitrag von Max_der_Held »

hey flüssigbyte.. nicht jeder deusch! ;)
vielleicht er nur film schaut und jetzt kein untertitel. arme mensch, helfen! :D
Mqrio
Beiträge: 4
Registriert: 13.02.2010 03:46

Re: Direct Show

Beitrag von Mqrio »

Entschuldigen Sie bitte, sag mir google
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Re: Direct Show

Beitrag von Kaeru Gaman »

du benutzt also Google-Translate und schreibst "Mario" mit "q", weil du das "a" nicht gefunden hast...

was ist denn deine Muttersprache?

es gibt auch ein internationales englisches Forum http://www.purebasic.fr/english/
und ein französisches Forum http://www.purebasic.fr/french/
vielleicht liegt dir eine dieser Sprachen eher zu...
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Benutzeravatar
Joel
Beiträge: 851
Registriert: 21.04.2006 19:22

Re: Direct Show

Beitrag von Joel »

Hach, ich hab schon gehofft, dass sich jetzt mal jemand außer mir mit Direct Show beschäftigt hat, weil hier in mienem Thema ein neue Beitrag war. :D

Aber was haben Untertitel mit DirectShow zutun?
Max_der_Held hat geschrieben:hey flüssigbyte.. nicht jeder deusch! ;)
vielleicht er nur film schaut und jetzt kein untertitel. arme mensch, helfen! :D
:D lol!!!!
----------------------------------------------------------

PB 5.20 Beta 10 | Windows 7
Benutzeravatar
Max_der_Held
Beiträge: 594
Registriert: 18.04.2006 17:01
Wohnort: Bavaria
Kontaktdaten:

Re: Direct Show

Beitrag von Max_der_Held »

Was nicht heißt, dass du hier nicht willkommen bist... ehrlich gesagt sollten wir uns entschuldigen,
hab gedacht, du machst es so wie ich und lässt einfach mal ein paar wörter weg etc..
willkommen in unserem forum :)
lg
max
Mqrio
Beiträge: 4
Registriert: 13.02.2010 03:46

Re: Direct Show

Beitrag von Mqrio »

Zu Beginn möchte ich mich für die Übersetzung auf Google zu entschuldigen.
Ich sah überall auf dem Internet. Es gibt kein Beispiel die Untertitel in den Film in dshow anzuzeigen. In RenderMovieFrame nicht funktioniert MovieSeek.
Ich verlasse mich auf den Text im Bild:
Bild
heinz
Beiträge: 6
Registriert: 20.10.2009 11:41

Re: Direct Show

Beitrag von heinz »

Hallo

Ich habe einen MP3-Directory-Player mit der Dshowmedia.pbi gemacht.

Vielleicht kann es jemand gebrauchen.

Code: Alles auswählen

IncludeFile "c:\dshowmedia.pbi"

Enumeration 1 
  #Gadget_VolumeTxt 
  #Gadget_Volume 
  #Gadget_Speed 
  #Gadget_PositionTxt 
  #Gadget_Position 
  #Gadget_Pause 
  #Gadget_Next
  #Gadget_Prev
  #Gadget_ExList
  #Gadget_Check
  #Gadget_CheckRepeat
  #Gadget_Quit 
EndEnumeration 

mynew.LV_ITEM
mynew\stateMask = #LVIS_SELECTED	| #LVIS_FOCUSED	
mynew\state = #LVIS_SELECTED	| #LVIS_FOCUSED	
mynew2.LV_ITEM
mynew2\stateMask = #LVIS_SELECTED	| #LVIS_FOCUSED	

Global hwnd = OpenWindow(0, 50, 20, 1210, 655+5+25, "MP3 Directory Player", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget ) 
top=5 
TextGadget    (#Gadget_VolumeTxt,  5,top,300,20,"Volume: 100"):top+20 
TrackBarGadget(#Gadget_Volume     ,5,top,300,25, 60, 100):top+30 
TextGadget    (#Gadget_PositionTxt,5,top,300,20,"Position"):top+20 
TrackBarGadget(#Gadget_Position   ,5,top,300,25,0,100000):top+30 
ButtonGadget  (#Gadget_Pause      ,45,top,35,20,"Play") 
ButtonGadget  (#Gadget_Next       ,85, top, 35, 20, "Next")
ButtonGadget  (#Gadget_Prev       ,5, top, 35, 20, "Prev")
ButtonGadget  (#Gadget_Quit       ,125, top, 35, 20, "Quit")
CheckBoxGadget(#Gadget_Check, 240,  top, 60, 20, "Random")
CheckBoxGadget(#Gadget_CheckRepeat, 180,  top, 60, 20, "Repeat")
ExplorerListGadget(#Gadget_ExList ,310, 10 , 800, 650 ,"*.mp3", #PB_Explorer_AlwaysShowSelection | #PB_Explorer_FullRowSelect | #PB_Explorer_HeaderDragDrop )
SetGadgetItemAttribute(#Gadget_ExList, 0, #PB_Explorer_ColumnWidth , 400)    
SendMessage_( GadgetID(#Gadget_Volume), #TBM_SETPAGESIZE, 0, 5)
SendMessage_( GadgetID(#Gadget_Position), #TBM_SETPAGESIZE, 0, 20000)
AddWindowTimer(0, 1, 300)
AddWindowTimer(0, 2, 200)
Global hMedia = InitMedia()

Procedure.s ConvTime(x)
   x = x / 1000
   If x/60 < 10 : x1.s = "0" : EndIf   
   If x-60*(x/60) < 10 : x2.s ="0" : EndIf
   ProcedureReturn x1 + Str(x/60) + ":" + x2 + Str(x-60*(x/60))
EndProcedure

Procedure PlayFile(Auswahl)
   File$ = GetGadgetText(#Gadget_ExList) + GetGadgetItemText(#Gadget_ExList, Auswahl)
   If Right(File$, 4) = ".mp3"
      SetWindowTitle(0, File$)
      FreeMedia(hmedia)
      hMedia = InitMedia()
      LoadMedia(hMedia, File$, hwnd, #VMR7_Windowed, #WaveOutRenderer)
      PlayMedia(hMedia)
      SetGadgetState(#Gadget_Volume, MediaGetVolume(hMedia) + 100)
      SetGadgetText(#Gadget_VolumeTxt, "Volume: " + Str(GetGadgetState(#Gadget_Volume)))
   EndIf 
EndProcedure

Repeat
      Event = WaitWindowEvent(100)  
      If Event = #PB_Event_Timer And EventTimer() = 1 And MediaState(hMedia)
             SetGadgetText(#Gadget_PositionTxt, "Position:  " + ConvTime(MediaPosition(hMedia)) + "  -  " + ConvTime(MediaLenght(hMedia)))
             SetGadgetAttribute(#Gadget_Position, #PB_TrackBar_Maximum, MediaLenght(hMedia))
             SetGadgetState(#Gadget_Position, MediaPosition(hMedia))
             
      ElseIf Event = #PB_Event_Timer And EventTimer() = 2 And MediaPosition(hMedia) = MediaLenght(hMedia) And GetGadgetText(#Gadget_Pause) =  "Pause"
                Auswahl = GetGadgetState(#Gadget_ExList)
                SendMessage_( GadgetID(#Gadget_ExList), #LVM_SETITEMSTATE, Auswahl, @mynew2)       ;Deselect
                Auswahl = Auswahl + 1
                If GetGadgetState(#Gadget_CheckRepeat) : Auswahl = Auswahl - 1 :EndIf   ; Repeat
                If GetGadgetState(#Gadget_Check) : Auswahl = Random(CountGadgetItems(#Gadget_ExList)) :EndIf   ;Random
                SendMessage_( GadgetID(#Gadget_ExList), #LVM_SETITEMSTATE, Auswahl, @mynew)           ;Select New
                mypoint.POINT
                SendMessage_( GadgetID(#Gadget_ExList), #LVM_GETITEMPOSITION, Auswahl, @mypoint)     ;Position für Scollen     
                SendMessage_( GadgetID(#Gadget_ExList), #LVM_SCROLL, 0, -20000)
                SendMessage_( GadgetID(#Gadget_ExList), #LVM_SCROLL, 0, mypoint\y - 250)            ;Scrollen
                Playfile(Auswahl)
     
       ElseIf  event = #PB_Event_SizeWindow 
                ResizeGadget(#Gadget_ExList, 310, 10, WindowWidth(0) - 320, WindowHeight(0) - 20)  
 
       ElseIf  Event = #PB_Event_Gadget And EventGadget() =  #Gadget_Position 
                MediaSeek(hMedia, GetGadgetState(#Gadget_Position))
                SetGadgetText(#Gadget_PositionTxt, "Position:  " + ConvTime(MediaPosition(hMedia)) + "  -  " + ConvTime(MediaLenght(hMedia)))
                
       ElseIf  Event = #PB_Event_Gadget And EventGadget() =  #Gadget_Volume           
                MediaPutVolume(hMedia, GetGadgetState(#Gadget_Volume) - 100) ; Set Volume
                SetGadgetText(#Gadget_VolumeTxt, "Volume: " + Str(GetGadgetState(#Gadget_Volume))) 

       ElseIf  Event = #PB_Event_Gadget And EventGadget() =  #Gadget_Exlist And EventType() = #PB_EventType_LeftDoubleClick  ; MP3 Doppelklick
                SetGadgetText(#Gadget_Pause , "Pause")          
                Auswahl = GetGadgetState(#Gadget_ExList) 
                PlayFile(Auswahl)
               
       ElseIf  Event = #PB_Event_Gadget And EventGadget() =  #Gadget_Next
                SetGadgetText(#Gadget_Pause , "Pause")
                Auswahl = GetGadgetState(#Gadget_ExList)
                SendMessage_( GadgetID(#Gadget_ExList), #LVM_SETITEMSTATE, Auswahl, @mynew2)
                SendMessage_( GadgetID(#Gadget_ExList), #LVM_SETITEMSTATE, Auswahl + 1, @mynew)
                PlayFile(Auswahl + 1)
                 
       ElseIf  Event = #PB_Event_Gadget And EventGadget() =  #Gadget_Prev
                Auswahl = GetGadgetState(#Gadget_ExList)
                SendMessage_( GadgetID(#Gadget_ExList), #LVM_SETITEMSTATE, Auswahl, @mynew2)
                SendMessage_( GadgetID(#Gadget_ExList), #LVM_SETITEMSTATE, Auswahl - 1, @mynew)
                PlayFile(Auswahl - 1) 
                              
       ElseIf  Event = #PB_Event_Gadget And EventGadget() =  #Gadget_Pause And MediaState(hMedia) = #State_Running
                PauseMedia(hMedia)
                SetGadgetText(#Gadget_Pause , "Play") 
                 
       ElseIf  Event = #PB_Event_Gadget And EventGadget() =  #Gadget_Pause And MediaState(hMedia) = #State_Paused   
                PlayMedia(hMedia) 
                SetGadgetText(#Gadget_Pause , "Pause")  
             
       ElseIf  Event = #PB_Event_Gadget And EventGadget() = #Gadget_Quit : End         
       EndIf
Until Event = #PB_Event_CloseWindow
Benutzeravatar
Codusa
Beiträge: 92
Registriert: 11.07.2009 09:44

Re: Direct Show

Beitrag von Codusa »

Hallo Leute,
Ich habe gerade Inc.s Code bei mir eingebaut Statt der MovieLib und nun stehe Ich vor dem Problem,
dass Ich den Film nicht im FullScreenMode anzeigen kann, mir fehlt also die ResizeMovie() Funktion...

Ist das in DS überhaupt vorgesehen? Wenn ja wie heisst die Funktion?

Thx!
"I became insane, with long intervals of horrible sanity." - Edgar A. Poe
Benutzeravatar
inc.
Beiträge: 348
Registriert: 27.10.2004 12:25

Re: Direct Show

Beitrag von inc. »

Ja natürlich, ... habe da was seit langer Zeit auf der Platte ...

ist zwar noch nicht ganz fertig da DVD Support fehlt, aber hier meine aktuelle DshowMedia.pbi.

- Support von PureBasic #IDs anstelle von Handles
- Kontextmenu via rechter Maustaste
- Fullscreen Switch (per Doppelclick oder per Kontextmenu)
- Individuelle Filtereinstellung via Kontextmenu

Müsste noch optimiert werden, daher hatte ich es noch nicht im DirectShow Thread veröffentlicht.
Vor allem die unfeine Sache, den Mauszeiger via Timer-Thread im Fullscreen-Modus verschwinden zu lassen.
Das ginge viel eleganter mit dem PB-Nativen Timer.

Code: Alles auswählen

; DshowMedia.pbi v1.3 tested with Purebasic v4.51, 2010 by Inc.

EnableExplicit

#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
  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_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 g_MediaFullscreen.b
Global NewList filters.s()

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

Procedure ToggleCursorFullscreen(*object.Dshow_Interfaces)
  Protected res.l, x.l = WindowMouseX(0), y.l = WindowMouseY(0), button.l, cursor.l = #True, reset.l = ElapsedMilliseconds(), KeyStroke.INPUT
  Repeat
    Delay(100)
    If g_MediaFullscreen 
      If cursor
        If ElapsedMilliseconds() - reset > 2 * 1000 ; 2 Secs.
          *object\pWindow\HideCursor(#OATRUE)
          ;*object\pWindow\SetWindowForeground(#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\SetWindowForeground(#OAFALSE)
          *object\pWindow\HideCursor(#OAFALSE)
          ; SetForegroundWindow_(WindowID(1))
          ; SetFocus_(WindowID(1))
          cursor = #True
        EndIf
      EndIf 
    EndIf
  ForEver
EndProcedure

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"
      If g_MediaFullscreen
        *object\pWindow\SetWindowForeground(#OATRUE)
      EndIf
      *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\pGraphBuilder)
  ProcedureReturn #True
EndProcedure

Procedure _BuildInterfaces(Object.l)
  _GetMediaObject(*object)
  Protected a.l, b.l, c.l, d.l, e.l, f.l
  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 ResizeMedia(Object.l, x.l = #PB_Default, y.l = #PB_Default, width.l = #PB_Default, height.l = #PB_Default, keepAR.l = #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 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()
  
  
  Protected i.l = 4
  If CreatePopupMenu(0)      ; here the creating of the pop-up menu begins...
    ;MenuTitle("Source")     ; you can use any of the menu creating commands,
    MenuItem(1, "Open")    ; just like in a normal menu...
    MenuItem(2, "Toggle fullscreen")
    MenuItem(3, "Quit")
    MenuBar()
    OpenSubMenu("Filters")
    ForEach filters()
      MenuItem(i, filters())
      i+1
    Next
    CloseSubMenu()
    ; MenuTitle("Edit")
    ; MenuTitle("Options")
  EndIf
  
  
  
  
  ProcedureReturn #True
Else
  Debug "Error: Rendering file failed"
  ProcedureReturn #False
EndIf 

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 = #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 MediaWidth(Object.l)
  _GetMediaObject(*object) 
  ProcedureReturn *object\width 
EndProcedure

Procedure MediaHeight(Object.l, height.l = #PB_Default)
  _GetMediaObject(*object)
  ProcedureReturn *object\height
EndProcedure

Procedure MediaToggleFullscreen(Object.l)
  _GetMediaObject(*object)
  Protected res.l
  Global  g_origWidth.l, g_OrigHeigth.l 
  If Not *object\renderer & #OverlayMixer
    If *object\fullscreen = #True
      SetWindowPos_(FindWindow_("Shell_traywnd", ""), 0, 0, 0, 0, 0, #SWP_SHOWWINDOW) 
      ResizeMedia(Object.l, #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 = MediaWidth(Object)
      g_OrigHeigth = MediaHeight(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)
      ResizeMedia(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 MediaPosition(Object.l, mode.l = #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 MediaState(Object.l)
  _GetMediaObject(*object)
  Protected pfs.l
  *object\pControl\GetState(10,@pfs)
  ProcedureReturn pfs
EndProcedure

Procedure.f MediaFPS(Object.l) ; 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 CaptureCurrMediaImage(Object.l, ResultingImgNo.l)
  _GetMediaObject(*object)
  Protected DataSize.l, *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 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) ; 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 MediaPutBalance(Object.l, bal.l) ; -100 to +100
  _GetMediaObject(*object)
  *object\pAudio\put_balance(bal*100)
EndProcedure

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

Procedure CloseMedia(Object.l)
  _GetMediaObject(*object)
  
  Protected pfs.l
  If g_MediaFullscreen
    MediaToggleFullscreen(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 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

DisableExplicit




; //////// EXAMPLE USAGE ///////////



CompilerIf #PB_Compiler_Debugger = #False
  MessageRequester("Info","Please run this example using the debugger and see its output while choosing a media file")
  End
CompilerEndIf


hwnd = OpenWindow(0,20,20,352,288,"PB native Dshow example", #PB_Window_BorderLess|#WS_CLIPCHILDREN|#PB_Window_ScreenCentered);#PB_Window_SizeGadget|#PB_Window_SystemMenu|
hwnd2 = OpenWindow(1,WindowX(0),WindowY(0)+WindowHeight(0),WindowWidth(0),15, "Slider", #PB_Window_BorderLess)
If hwnd2
  TrackBarGadget(2, 5, 5, WindowWidth(1)-10, 20, 0, 10000) 
EndIf
SetForegroundWindow_(WindowID(1))



#Media = 0
#DebugTimer = 0
#MouseTimer = 1

If InitMedia(#Media)
  File.s = OpenFileRequester("Choose media file","","All Files (*.*)|*.*",0)
  If File
    If LoadMedia(#Media, File, hwnd);, #VMR7_Windowed|#DirectSoundRenderer|#DontKeepAR);#WaveOutRenderer) ; 
      mWidth = MediaWidth(#Media) : mHeight = MediaHeight(#Media)
      If mWidth = 0 : mWidth = #PB_Ignore :EndIf
      If mHeight = 0 : mHeight = #PB_Ignore :EndIf
      ResizeWindow(0, #PB_Ignore, #PB_Ignore, mWidth, mHeight);
      ResizeWindow(1, WindowX(0),WindowY(0)+WindowHeight(0)+5,WindowWidth(0),30)
      PlayMedia(#Media)
      Debug "lenght = "+MediaTime2String(MediaLenght(#Media))+" (hh:mm:ss:ms)"
      fps.f = MediaFPS(#Media)
      If fps ; Does media contain Videodata?
        Debug "frames = "+Str(MediaLenght(#Media, #MEDIA_TIME_FRAMES))
        Debug "FPS    = "+StrF(fps,3)
        Debug "Width  = "+Str(MediaWidth(#Media))
        Debug "Height = "+Str(MediaHeight(#Media))
      EndIf 
      Debug "playing ..."
      Debug " "
      Debug "esc = exit"
      Debug "c = capture current image to C:/"
      Debug "left/right keys = step forward/backward in 5% steps"
      Debug "up/down keys = alter volume in 2db steps"
      Debug " "
      Debug "Mosue doubleclick for fullscreen toggle"
      Debug " "
      Debug "Mouse rightclick for more options!"
      Debug " "
      
      AddWindowTimer(0, #DebugTimer, 20)
      
      Repeat
        Delay(10)
        If MediaState(#Media) = #State_Running
          SetGadgetState(2, (MediaPosition(#Media)/(MediaLenght(#Media)/10000)))
        EndIf 
        
        ev = WaitWindowEvent()
        If ev = #WM_KEYDOWN
          WPARAM = EventwParam()
          If WPARAM = #VK_ESCAPE
            MediaPutVolume(#Media,0)
            FreeMedia(#Media)
            End
          ElseIf WPARAM = #VK_C
            If CaptureCurrMediaImage(#Media, 99)
              SaveImage(99, "C:/MyImage"+Str(im)+".bmp",#PB_ImagePlugin_BMP)
              FreeImage(99)
              im+1
              Debug "Image "+Str(im)+" safed to C:/"
            EndIf 
          ElseIf WPARAM = #VK_LEFT
            MediaSeek(#Media, MediaPosition(#Media)-Int(MediaLenght(#Media)/50)) ; 5% steps
          ElseIf WPARAM = #VK_RIGHT
            MediaSeek(#Media, MediaPosition(#Media)+Int(MediaLenght(#Media)/50)) ; 5% steps 
          ElseIf WPARAM =#VK_UP  
            MediaPutVolume(#Media, MediaGetVolume(#Media)+2)
          ElseIf WPARAM = #VK_DOWN
            MediaPutVolume(#Media ,MediaGetVolume(#Media)-2)
          ElseIf WPARAM = #VK_SPACE
            MediaToggleFullscreen(#Media)
          EndIf
          
        ElseIf ev = #WM_GRAPHEVENT 
          OnMediaEvent(EventlParam());)
          
        ElseIf ev = #WM_LBUTTONDBLCLK 
          MediaToggleFullscreen(#Media)
          
        ElseIf ev = #WM_LBUTTONDOWN 
          If EventWindow() = 0
            MoveWindow()
          EndIf 
          
        ElseIf ev = #WM_RBUTTONDOWN 
          DisplayPopupMenu(0, hwnd)
          
        ElseIf ev = #PB_Event_Menu
          Select GetMenuItemText(0, EventMenu())
            Case "Open"
              File.s = OpenFileRequester("Choose media file","","All Files (*.*)|*.*",0)
              If File
                CloseMedia(#Media)
                LoadMedia(#Media, File, hwnd, #VMR7_Windowed|#DirectSoundRenderer)
                ResizeWindow(0, #PB_Ignore, #PB_Ignore, MediaWidth(#Media), MediaHeight(#Media));
                PlayMedia(#Media)
              EndIf
            Case "Toggle fullscreen"
              MediaToggleFullscreen(#Media) 
            Case "Quit"
              MediaPutVolume(#Media,0)
              FreeMedia(#Media)
              End
            Default
              ; /// Altering filter settings is only supported in x86 compiles ////
              CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
                MessageRequester("Info","Filter properties won't work in an x64 compile! "+Chr(13)+"Thats due the usage of OLE-API calls which are not compatible with x64.")
              CompilerElse
                GetFilterProperties(#Media, GetMenuItemText(0, EventMenu()))
              CompilerEndIf 
              
          EndSelect
          
        ElseIf ev = #PB_Event_Gadget
          If EventGadget() = 2 
            SetFocus_(WindowID(1))
            If GetAsyncKeyState_(#VK_LBUTTON) > 0              
              PauseMedia(#Media)  
              MediaSeek(#Media, (MediaLenght(#Media)/10000)*GetGadgetState(2))
            ElseIf GetAsyncKeyState_(#VK_LBUTTON) = 0
              PlayMedia(#Media)
            EndIf
          EndIf
          
          
        ElseIf ev = #PB_Event_SizeWindow
          ResizeMedia(#Media, #PB_Default, #PB_Default, WindowWidth(0), WindowHeight(0),#True)
          UpdateWindow_(WindowID(0))
          
        ElseIf ev = #PB_Event_MoveWindow
          
          If EventWindow() = 0 
            ResizeWindow(1, WindowX(0),WindowY(0)+WindowHeight(0)+5,WindowWidth(0),30)
          ElseIf EventWindow() = 1
            ResizeWindow(0, WindowX(1), WindowY(1)-WindowHeight(0)-5, WindowWidth(0), WindowHeight(0))
          EndIf 
          ResizeGadget(2, 5, 5, WindowWidth(1)-10, 20)
          
        ElseIf ev = #PB_Event_Timer And EventTimer() = #DebugTimer
          Debug MediaTime2String(MediaPosition(#Media)) ;- #### Uncomment this for watching continous counter ###
          Debug MediaPosition(#Media, #MEDIA_TIME_FRAMES) 
        EndIf
        
      Until ev = #PB_Event_CloseWindow  
      
      MediaPutVolume(#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.
      FreeMedia(#Media)
      End
      
    EndIf
  Else
    FreeMedia(#Media)
    End
  EndIf
EndIf
Zuletzt geändert von inc. am 28.12.2010 20:07, insgesamt 1-mal geändert.
Hier gibts die OOP Option für PureBasic.
Antworten