#Include once "window9.bi"

Type OB
  As HWND                hwndParent
  As IGraphBuilder   Ptr pGraph
  As IMediaControl   Ptr pControl
  As IMediaEvent     Ptr pEvent
  As IVideoWindow    Ptr vidwindow
  As IMediaSeeking   Ptr medseek
  As IBasicVideo     Ptr basvideo
  As IBasicAudio     ptr BasAudio
End Type

Function Error_HR(byval hr as Integer,ByVal Inter_face As String) as Integer
  if( FAILED( hr ) ) then
    Var MB=MessageBox(0,"Error associated with " & Inter_face & ". Want Continue?","Error",MB_YESNO)
    If MB=IDNO then
      End
    endif
  Else Return 1
  end If
End Function

Function LoadMovie(ByVal Hwnd As HWND,ByVal nameFile As String, _
                   ByVal x As Integer, ByVal y As Integer,ByVal Width_ As Integer, ByVal Height_ As integer) as integer  Export
  If Len(nameFile)=0 Then Return 0
  Var blen = (Len(nameFile)*2)+2
  Dim As WString Ptr wbuf = Allocate( blen )
  MultiByteToWideChar(CP_ACP, 0, StrPtr(nameFile), -1, wbuf, blen)
  Dim OBB As OB Ptr=allocate( sizeof( OB))
  OBB->hwndParent=Hwnd
  Error_HR( CoInitialize(0),"CoInitialize")
  Error_HR( CoCreateInstance(@CLSID_FilterGraph,NULL, CLSCTX_INPROC_SERVER,@IID_IGraphBuilder, @OBB->pGraph),"CoCreateInstance")
  Error_HR(IGraphBuilder_QueryInterface(OBB->pGraph, @IID_IMediaControl, @OBB->pControl  ),"IMediaControl")
  Error_HR(IGraphBuilder_QueryInterface(OBB->pGraph, @IID_IMediaEvent  , @OBB->pEvent    ),"IMediaEvent")
  Error_HR(IGraphBuilder_QueryInterface(OBB->pGraph, @IID_IVideoWindow , @OBB->vidwindow ),"IVideoWindow")
  Error_HR(IGraphBuilder_QueryInterface(OBB->pGraph, @IID_IMediaSeeking, @OBB->medseek   ),"IMediaSeeking")
  Error_HR(IGraphBuilder_QueryInterface(OBB->pGraph, @IID_IBasicVideo  , @OBB->basvideo  ),"IBasicVideo")
  Error_HR(IGraphBuilder_QueryInterface(OBB->pGraph, @IID_IBasicAudio  , @OBB->basAudio  ),"IBasicAudio")
  IGraphBuilder_RenderFile(OBB->pGraph, *wbuf, NULL )
  IVideoWindow_put_Owner( OBB->vidwindow, Cast(OAHWND,OBB->hwndParent ))
  IVideoWindow_put_WindowStyle( OBB->vidwindow, WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN )
  IVideoWindow_SetWindowPosition( OBB->vidwindow, x, y,Width_ ,Height_)
  DeAllocate(wbuf)
  Return Cast(Integer,OBB)
End Function

Function FreeMovie(ByVal OBB As Integer) As Integer Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,OBB)
  If obb_->pGraph Then
    IMediaControl_Release(obb_->pControl)
    IMediaEvent_Release  (obb_->pEvent)    
    IVideoWindow_Release (obb_->vidwindow)
    IMediaSeeking_Release(obb_->medseek)
    IBasicVideo_Release  (obb_->basvideo)
    IBasicAudio_Release  (obb_->basAudio)
    IGraphBuilder_Release(obb_->pGraph)
    ' !!! must be deallocate !!!
    DeAllocate( obb_)
  EndIf
  CoUninitialize()  
  Return 1
End Function

Function PlayMovie(ByVal Movie_ As integer) As Integer Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  Error_HR(IMediaControl_Run(obb_->pControl), "Metod IMediaControl_Run")
  Return 1
End Function

Function StopMovie(ByVal Movie_ As Integer) As Integer Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  Dim As LongInt rtNow
  Dim As LongInt rtStop
  Dim As LongInt rtbegin
  Error_HR(IMediaSeeking_GetPositions(obb_->medseek,@rtNow,@rtStop),"Not put begin positions")
  Error_HR(IMediaSeeking_SetPositions(obb_->medseek,@rtbegin,AM_SEEKING_AbsolutePositioning,@rtStop ,AM_SEEKING_AbsolutePositioning),"Not set begin positions")
  Error_HR(IMediaControl_Stop(obb_->pControl), "Metod IMediaControl_Stop")
  Return 1
End Function

Function PauseMovie(ByVal Movie_ As Integer) As Integer Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  Error_HR(IMediaControl_Pause(obb_->pControl), "Metod IMediaControl_Pause")
  Return 1
End Function

Function ResizeMovie(ByVal Movie_ As Integer,ByVal x As Integer, ByVal y As Integer, ByVal Width_ As Integer, ByVal Height_ As integer) As Integer Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  Error_HR(IVideoWindow_SetWindowPosition( obb_->vidwindow, x, y,Width_ ,Height_),"Metod IVideoWindow_SetWindowPosition")
  InvalidateRect(obb_->hwndParent,0,1)
  Return 1
End Function

Function SetRateMovie(ByVal Movie_ As Integer,ByVal Rate As Double) As bool Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  Return IMediaSeeking_SetRate(obb_->medseek,Rate)
End Function

Function GetRateMovie(ByVal Movie_ As Integer) As Double Export
  Dim As Double Rate
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  IMediaSeeking_GetRate(obb_->medseek,@Rate)
  Return Rate
End Function

Function GetEndPosMovie(ByVal Movie_ As Integer) As longint Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  Dim As LongInt rtNow
  Dim As LongInt rtStop
  IMediaSeeking_GetPositions(obb_->medseek,@rtNow,@rtStop)
  Return rtStop
End Function

Function MovieSetPositions(ByVal Movie_ As Integer,ByVal Rnew As LongInt,ByVal Rend As LongInt,ByVal flagNew As Integer=1,ByVal flagEnd As Integer=1) As Integer Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  IMediaSeeking_SetPositions(obb_->medseek,@Rnew,flagNew,@Rend ,flagEnd)
  Return 1
End Function

Function MovieGetCurrentPosition(ByVal Movie_ As Integer) As LongInt Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  Dim As REFERENCE_TIME rtii
  IMediaSeeking_GetCurrentPosition(obb_->medseek,@rtii)
  Return rtii
End Function

Function MovieSourseWidth(ByVal Movie_ As Integer) As LongInt Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  Dim As Integer  width_
  IBasicVideo_get_SourceWidth(obb_->basvideo,@width_)
  Return width_
End Function

Function MovieSourseHeight(ByVal Movie_ As Integer) As LongInt Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
   Dim As Integer  height_
  IBasicVideo_get_SourceHeight(obb_->basvideo,@height_)
  Return height_
End Function

Function MovieFullScreen(ByVal Movie_ As Integer,ByVal Mode As Integer) As Integer Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  Error_HR(IVideoWindow_put_FullScreenMode(obb_->vidwindow,Mode),"metod IVideoWindow_put_FullScreenMode")
  Return 1
End Function

Function MovieAudioSetVolume(ByVal Movie_ As Integer,ByVal Volume As Integer) As Integer Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  Error_HR(IBasicAudio_put_Volume(obb_->basAudio,Volume),"metod IBasicAudio_Set_Volume")
  Return 1
End Function

Function MovieAudioGetVolume(ByVal Movie_ As Integer) As Integer Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  Dim Volume As Integer
  Error_HR(IBasicAudio_get_Volume(obb_->basaudio,@Volume),"metod IBasicAudio_get_Volume")
  Return Volume
End Function

Function MovieScreenShot(ByVal Movie_ As Integer) As HBITMAP Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  Dim As integer lBufSize
  IBasicVideo_GetCurrentImage(obb_->basvideo,@lBufSize,NULL)
  Dim As Integer Ptr pDIB=Allocate(lBufSize)
  IBasicVideo_GetCurrentImage(obb_->basvideo,@lBufSize,pDIB)
  Dim As HANDLE fh
  Dim As BITMAPFILEHEADER bmphdr
  Dim As BITMAPINFOHEADER bmpinfo
  Dim As DWORD nWritten
  Dim As Integer  height_
  IBasicVideo_get_SourceHeight(obb_->basvideo,@height_)
  Dim As Integer  Width_
  IBasicVideo_get_SourceWidth(obb_->basvideo,@Width_)
  bmphdr.bfType = 19778
  bmphdr.bfSize = sizeof(bmphdr) + sizeof(bmpinfo) + lbufSize
  bmphdr.bfOffBits = sizeof(bmphdr) + sizeof(bmpinfo)
  bmpinfo.biSize = sizeof(bmpinfo)
  bmpinfo.biWidth = Width_
  bmpinfo.biHeight = height_
  bmpinfo.biPlanes = 1
  bmpinfo.biBitCount = 32
  Dim templ As Integer=SizeOf(bmphdr)+lbufSize
  Dim As Byte ptr buf = Cast(Byte Ptr,Allocate(templ))  
  RtlMoveMemory(buf,@bmphdr,SizeOf(bmphdr))
  RtlMoveMemory(buf+SizeOf(bmphdr),pDIB,lbufSize)
  Dim logoinfo as BITMAPINFO Ptr
  dim logo as BITMAPFILEHEADER ptr = Cast(BITMAPFILEHEADER Ptr,buf )
  logoinfo = cast(BITMAPINFO ptr, logo + 1)
  Var gghdc=GetDC(obb_->hwndParent )
  Function=  CreateDIBitmap( gghdc, _
  @logoinfo->bmiHeader, _
  CBM_INIT, _
  cast(byte ptr, logo) + logo->bfOffBits, _
  logoinfo, _
  DIB_RGB_COLORS )  
  DeleteDC(gghdc)
  DeAllocate(pDIB) 
  DeAllocate(buf)
End Function

Function MovieGetState(ByVal Movie_ As Integer,ByVal msTimeout As Integer) As Integer Export
  Dim obb_ As ob Ptr
  obb_=Cast(ob Ptr,Movie_)
  Dim As Integer FilterState
  IMediaControl_GetState(obb_->pControl,msTimeout,@FilterState)
  Return FilterState
End Function

