#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, Byref Inter_face As USTRING) as Integer
	if( FAILED( hr ) ) then
		#ifdef UNICODE
			Var MB=MessageBox(0,"Error associated with " & *Inter_face & ". Want Continue?","Error",MB_YESNO)
		#else	
			Var MB=MessageBox(0,"Error associated with " & Inter_face & ". Want Continue?","Error",MB_YESNO)
		#EndIf	
		If MB=IDNO then
			End
		endif
	Else Return 1
	end If
End Function

Function LoadMovie(ByVal Hwnd As HWND, _
					ByRef sFileName As USTRING, _
					ByVal x As Integer, ByVal y As Integer, _
					ByVal w As Integer, ByVal h As integer) as integer  Export
	If Len(sFileName)=0 Then Return 0
	#ifdef UNICODE
		Dim As WString Ptr wbuf = cast(any ptr , *sFileName)		
	#else	
		Var blen = (Len(sFileName)*2)+2
		Dim As WString Ptr wbuf = Allocate( blen )
		if wbuf = 0 then return 0
		MultiByteToWideChar(CP_ACP, 0, StrPtr(sFileName), -1, wbuf, blen)		
	#EndIf
	Dim OBB As OB Ptr=allocate( sizeof( OB))
	if OBB then
		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,w,h)
	endif
	#ifndef UNICODE
		DeAllocate(wbuf)
	#EndIf
	Return Cast(Integer,OBB)
End Function

Function FreeMovie(ByVal Movie_ As Integer) As Integer Export
	Dim As ob Ptr obb_ = Cast(ob Ptr,Movie_)
	If obb_ andalso 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 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 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 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 w As Integer, ByVal h As integer) As Integer Export
	Dim As ob Ptr obb_ = Cast(ob Ptr,Movie_)
	Error_HR(IVideoWindow_SetWindowPosition( obb_->vidwindow, x,y,w,h),"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 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 ob Ptr obb_ = Cast(ob Ptr,Movie_)
	dim as double Rate
	IMediaSeeking_GetRate(obb_->medseek,@Rate)
	Return Rate
End Function

Function GetEndPosMovie(ByVal Movie_ As Integer) As longint Export
	Dim 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, ByVal flagEnd As Integer) As Integer Export
	Dim 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 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 As ob Ptr obb_ = Cast(ob Ptr,Movie_)
	Dim As long  width_
	IBasicVideo_get_SourceWidth(obb_->basvideo,@width_)
	Return width_
End Function

Function MovieSourseHeight(ByVal Movie_ As Integer) As LongInt Export
	Dim As ob Ptr obb_ = Cast(ob Ptr,Movie_)
	Dim As long  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 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 As ob Ptr obb_ = Cast(ob Ptr,Movie_)
	Dim Volume As long
	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 As ob Ptr obb_ = Cast(ob Ptr,Movie_)
	Dim As long lBufSize
	IBasicVideo_GetCurrentImage(obb_->basvideo,@lBufSize,NULL)
	Dim As long Ptr pDIB=Allocate(lBufSize)
	if pDIB = 0 then return 0
	IBasicVideo_GetCurrentImage(obb_->basvideo,@lBufSize,pDIB)
	Dim As HANDLE fh
	Dim As BITMAPFILEHEADER bmphdr
	Dim As BITMAPINFOHEADER bmpinfo
	Dim As DWORD nWritten
	Dim As long w,h
	IBasicVideo_get_SourceWidth(obb_->basvideo,@w)
	IBasicVideo_get_SourceHeight(obb_->basvideo,@h)
	bmphdr.bfType = 19778
	bmphdr.bfSize = sizeof(bmphdr) + sizeof(bmpinfo) + lbufSize
	bmphdr.bfOffBits = sizeof(bmphdr) + sizeof(bmpinfo)
	bmpinfo.biSize = sizeof(bmpinfo)
	bmpinfo.biWidth = w
	bmpinfo.biHeight = h
	bmpinfo.biPlanes = 1
	bmpinfo.biBitCount = 32
	Dim templ As Integer=SizeOf(bmphdr)+lbufSize
	Dim As Byte ptr buf = Cast(Byte Ptr,Allocate(templ))
	if buf = 0 then
		DeAllocate(pDIB)
		return 0
	EndIf
	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 As ob Ptr obb_ = Cast(ob Ptr,Movie_)
	Dim As long FilterState
	IMediaControl_GetState(obb_->pControl,msTimeout,@FilterState)
	Return FilterState
End Function

