'************************************************************************
' Test program of DirecrShow.INC file for RapidQ/Hotbasic
' Converted from code for PB by V.Shulakov , overloc@uch.net
'========================================================================
' DirectShow Example converted to RapidQ code contributions by:
' Jacques Philippe, Don67Geo, JohnK
'========================================================================
$TYPECHECK ON
'________________________________________________________________________________
' Procedures
DECLARE FUNCTION GetClipFileName() AS STRING
DECLARE FUNCTION InitCom() AS LONG
DECLARE FUNCTION RELEASE(BYREF x AS LONG) AS LONG
DECLARE FUNCTION WndProc(hwnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
DECLARE SUB Form_click
DECLARE SUB PlayMovieInWindow (szFile AS STRING, hWndX AS LONG)
DECLARE SUB RELEASEALL()
DECLARE SUB Resize
DECLARE SUB StopMovie
$INCLUDE <ole.inc>
'$INCLUDE <RapidQ2.inc>
'or this
'________________________________________________________________________________
'
Declare Function MultiByteToWideChar Lib "kernel32" Alias "MultiByteToWideChar" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As Long, ByVal cchMultiByte As Long, lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Declare Function GetClientRect Lib "user32" Alias "GetClientRect" (ByVal hwnd As Long, lpRect As QRECT) As Long
$DEFINE MAX_PATH 256
$IFNDEF NULL
$DEFINE NULL 0&
$ENDIF
$DEFINE False 0&
$DEFINE True 1&
'our custom window messages, & win constants
$DEFINE WM_GRAPHNOTIFY &H40D
$DEFINE WS_CHILD &H40000000
$DEFINE WS_CLIPSIBLINGS &H4000000
$DEFINE WS_CLIPCHILDREN &H2000000
$DEFINE WS_MAXIMIZE &H1000000
$DEFINE WS_CAPTION &HC00000
$DEFINE MAX_PATH 255
$DEFINE CP_ACP 0
'---------------------------------------------------------------------
'virtual table offsets for directShow
$DEFINE DDQueryInterface 0
$DEFINE DDAddRef 4
$DEFINE DDRelease 8
$DEFINE DSSetWindowPosition 156
$DEFINE DSRenderFile 44
$DEFINE DSput_Owner 116
$DEFINE DSput_WindowStyle 36
$DEFINE DSSetNotifyWindow 52
$DEFINE DSRun 28
$DEFINE DSStop 36
$DEFINE DSput_Visible 36
$DEFINE DSGetEvent 32
$DEFINE DSFreeEventParams 48
DIM grc AS QRECT
' Collection of interfaces
DIM pif AS DWORD ' IBaseFilter
DIM pigb AS DWORD ' IGraphBuilder
DIM pimc AS DWORD ' IMediaControl
DIM pimex AS DWORD ' IMediaEventEx
DIM pivw AS DWORD ' IVideoWindow
DIM fDialog as QOpenDialog
SUB PlayMovieInWindow (szFile AS STRING, hWndX AS LONG)
DIM wFile AS STRING *MAX_PATH * 2
DEFSTR tmpStr = szFile 'for an odd reason, need to get a new string
DIM hr AS LONG 'return codes
'WIN32API call maps a character string to a wide-character (Unicode) string.
' The character string mapped by this function is not necessarily from a multibyte character set.
MultiByteToWideChar(CP_ACP, 0, VARPTR(tmpStr), -1, VARPTR(wFile), MAX_PATH )
DIM CLSID_FilterGraph AS STRING *16 'GUID
DIM IID_IGraphBuilder AS STRING *16
DIM IID_IMediaControl AS STRING *16
DIM IID_IMediaEventEx AS STRING *16
DIM IID_IVideoWindow AS STRING *16
CLSID_FilterGraph = GUID$("{e436ebb3-524f-11ce-9f53-0020af0ba770}")
IID_IGraphBuilder = GUID$("{56a868a9-0ad4-11ce-b03a-0020af0ba770}")
IID_IMediaControl = GUID$("{56A868B1-0AD4-11CE-B03A-0020AF0BA770}")
IID_IMediaEventEx = GUID$("{56A868C0-0AD4-11CE-B03A-0020AF0BA770}")
IID_IVideoWindow = GUID$("{56A868B4-0AD4-11CE-B03A-0020AF0BA770}")
hr = CoCreateInstance(VARPTR(CLSID_FilterGraph), 0&, CLSCTX_INPROC_SERVER,_
VARPTR(IID_IGraphBuilder), VARPTR(pigb))
IF hr = 0 THEN 'usual error is REGDB_E_CLASSNOTREG error (0x80040154)
' QueryInterface for some basic interfaces
hr = hr + MCALL(pigb,DDQueryInterface,VARPTR(IID_IMediaControl), VARPTR(pimc))
hr = hr + MCALL(pigb,DDQueryInterface,VARPTR(IID_IMediaEventEx), VARPTR(pimex))
hr = hr + MCALL(pigb,DDQueryInterface,VARPTR(IID_IVideoWindow), VARPTR(pivw))
hr = hr + MCALL(pimc,DSRenderFile, VARPTR(wFile), NULL)
hr = hr + MCALL(pivw,DSput_Owner, hWndX, NULL)
hr = hr + MCALL(pivw,DSput_WindowStyle, WS_CHILD OR WS_CLIPSIBLINGS OR WS_CLIPCHILDREN)
' Have the graph signal event via window callbacks for performance
hr = hr + MCALL(pimex,DSSetNotifyWindow, hWndX, WM_GRAPHNOTIFY, 0)
GetClientRect hWndX, grc
hr = hr + MCALL(pivw,DSSetWindowPosition, grc.left, grc.top, grc.right, grc.bottom)
' Run the graph if RenderFile succeeded
IF hr = 0 THEN MCALL (pimc,DSRun)
END IF
END SUB
'****************************
' GetClipFileName Procedure
'****************************
FUNCTION GetClipFileName() AS STRING
DIM i as integer
fDialog.Caption = "Direct Show file test"
fDialog.FileName= ""
fDialog.InitialDir = "C:\RapidQ"
fDialog.Filter = "Video files|*.mpg; *.mpeg; *.avi; *.mov|All Files|*.*"
IF fDialog.Execute THEN
RESULT = fDialog.FileName
END IF
END FUNCTION
'****************************
' RELEASE Procedure
'****************************
FUNCTION RELEASE(BYREF x AS LONG) AS LONG
IF x <> 0 THEN
MCALL(x,DDRelease)
x = 0
END IF
END FUNCTION
'****************************
' RELEASEALL Procedure
'****************************
SUB RELEASEALL()
RELEASE(pif)
RELEASE(pigb)
RELEASE(pimc)
RELEASE(pimex)
CoUninitialize
END SUB
FUNCTION InitCom() AS LONG
' normally OLE requires initialize first but RapidQ must already do it!
RESULT = CoInitialize(0&) 'if result = false then Could not initialize COM for DX Show"
END FUNCTION
CREATE Form AS QFORM
Caption = "DirectShow example - click form to open file"
Width = 500
Height = 500
WndProc = WndProc
OnClick = Form_click
END CREATE
'InitCom
Form.ShowModal
SUB Resize
IF pivw <> 0 THEN
MCALL(pivw,DSSetWindowPosition, form.left, form.top, form.Width, form.Height)
END IF
END SUB
SUB Form_click
DIM sFileName AS STRING
sFileName = GetClipFileName()
IF sFileName <> "" THEN
PlayMovieInWindow(sFilename, Form.Handle)
END IF
END SUB
SUB StopMovie
IF pimc <> 0 THEN MCALL (pimc,DSStop)
IF pivw <> 0 THEN ' Relinquish ownership after hiding
MCALL (pivw,DSput_Visible,False)
MCALL (pivw,DSput_Owner,NULL)
RELEASE(pivw)
END IF
RELEASEALL
END SUB
'****************************
' Windows Procedure
'****************************
FUNCTION WndProc(hwnd AS LONG, uMsg AS LONG, wParam AS LONG, lParam AS LONG) AS LONG
DIM hr AS LONG
DIM evCode AS LONG
DIM DSParam1 AS LONG
DIM DSParam2 AS LONG
SELECT CASE uMsg
CASE WM_GRAPHNOTIFY
WHILE MCALL(pimex,DSGetEvent,VARPTR(evCode), VARPTR(DSParam1), VARPTR(DSParam2), 0)
' Spin through the events
hr = MCALL(pimex,DSFreeEventParams, evCode, DSParam1, DSParam2)
IF evCode = 1 THEN '#define EC_COMPLETE 0x01
' Finished
IF pivw THEN
' Relinquish ownership after hiding
MCALL(pivw,DSput_Visible, False)
MCALL(pivw,DSput_Owner, NULL)
RELEASE(pivw)
END IF
RELEASEALL
Showmessage "finished"
END IF ' Finished
WEND
END SELECT
END FUNCTION