'************************************************************************ 
' 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