Save this as MMengine.inc
Code:
'+--------------------------------------------------------------------------+ '| | '| MMengine | '| | '| MultiMedia MCI encapsulation | '| | '| Version 1.00 | '| | '+--------------------------------------------------------------------------+ '| | '| Author Patrice TERRIER | '| 8 Domaine de Rochagnon. 38800 Champagnier FRANCE | '| http://www.zapsolution.com | '| E-mail: [email protected] | '| | '| copyright (c) 2000 Patrice TERRIER | '| | '+--------------------------------------------------------------------------+ '| Project started on : 09-21-2000 | '| Last revised : 02-29-2008 | '+--------------------------------------------------------------------------+ DECLARE FUNCTION MMOpen LIB "MMENGINE.DLL" ALIAS "MMOpen" (BYVAL hWnd AS DWORD, zFilName AS ASCIIZ) AS DWORD DECLARE FUNCTION MMPlay LIB "MMENGINE.DLL" ALIAS "MMPlay" (BYVAL FromHere AS LONG, BYVAL ToThere AS LONG) AS DWORD DECLARE FUNCTION MMGetTotalFrames LIB "MMENGINE.DLL" ALIAS "MMGetTotalFrames" () AS LONG DECLARE FUNCTION MMGetTotalTimeByMS LIB "MMENGINE.DLL" ALIAS "MMGetTotalTimeByMS" () AS LONG DECLARE FUNCTION MMClose LIB "MMENGINE.DLL" ALIAS "MMClose" () AS DWORD DECLARE FUNCTION MMStop LIB "MMENGINE.DLL" ALIAS "MMStop" () AS DWORD DECLARE FUNCTION MMPause LIB "MMENGINE.DLL" ALIAS "MMPause" () AS DWORD DECLARE FUNCTION MMResume LIB "MMENGINE.DLL" ALIAS "MMResume" () AS DWORD DECLARE FUNCTION MMPutWindow LIB "MMENGINE.DLL" ALIAS "MMPutWindow" (BYVAL xLeft&, BYVAL yTop&, BYVAL xWidth&, BYVAL yHeight&) AS DWORD DECLARE FUNCTION MMMove LIB "MMENGINE.DLL" ALIAS "MMMove" (BYVAL ToThere AS LONG, BYVAL IsInPauseMode AS LONG) AS DWORD DECLARE FUNCTION MMGetStatus LIB "MMENGINE.DLL" ALIAS "MMGetStatus" () AS LONG DECLARE FUNCTION MMGetCurrentPos LIB "MMENGINE.DLL" ALIAS "MMGetCurrentPos" () AS LONG DECLARE FUNCTION MMGetPercent LIB "MMENGINE.DLL" ALIAS "MMGetPercent" () AS LONG DECLARE FUNCTION MMGetFramesPerSecond LIB "MMENGINE.DLL" ALIAS "MMGetFramesPerSecond" () AS LONG DECLARE FUNCTION MMAreAtEnd LIB "MMENGINE.DLL" ALIAS "MMAreAtEnd" () AS LONG DECLARE SUB MMSetAutoRepeat LIB "MMENGINE.DLL" ALIAS "MMSetAutoRepeat" (BYVAL Autorep AS LONG) DECLARE FUNCTION MMGetDefaultDevice LIB "MMENGINE.DLL" ALIAS "MMGetDefaultDevice" (zTypeDevice AS ASCIIZ) AS STRING DECLARE SUB MMSetDefaultDevice LIB "MMENGINE.DLL" ALIAS "MMSetDefaultDevice" (zTypeDevice AS ASCIIZ, zDrvDefaultDevice AS ASCIIZ) DECLARE SUB MMInit LIB "MMENGINE.DLL" ALIAS "MMInit" () DECLARE FUNCTION MMDeviceID LIB "MMENGINE.DLL" ALIAS "MMDeviceID" () AS DWORD DECLARE FUNCTION MMFreeze LIB "MMENGINE.DLL" ALIAS "MMFreeze" () AS DWORD DECLARE FUNCTION MMUnFreeze LIB "MMENGINE.DLL" ALIAS "MMUnFreeze" () AS DWORD DECLARE FUNCTION MMErrorMsg$ LIB "MMENGINE.DLL" ALIAS "MMErrorMsg" (BYVAL Ret AS DWORD) DECLARE FUNCTION MMGetSize LIB "MMENGINE.DLL" ALIAS "MMGetSize" (BYREF xWidth AS LONG, BYREF yHeight AS LONG) AS DWORD DECLARE FUNCTION MMMoveAtPercent LIB "MMENGINE.DLL" ALIAS "MMMoveAtPercent" (BYREF Percent AS LONG) AS DWORD DECLARE FUNCTION MMGetLocation LIB "MMENGINE.DLL" ALIAS "MMGetLocation" (BYREF xLeft AS LONG, BYREF yTop AS LONG, BYREF xWidth AS LONG, BYREF yHeight AS LONG) AS DWORD DECLARE FUNCTION MMGetWindowHandle LIB "MMENGINE.DLL" ALIAS "MMGetWindowHandle" (BYREF hWnd AS DWORD) AS DWORD DECLARE FUNCTION MMSetVideo LIB "MMENGINE.DLL" ALIAS "MMSetVideo" (BYVAL hWndParent AS DWORD) AS DWORD DECLARE FUNCTION MMSetVolume LIB "MMENGINE.DLL" ALIAS "MMSetVolume" (BYVAL UseVolume AS LONG) AS DWORD %MM_PLAYING = 3 %MM_PAUSED = 2 %MM_STOPPED = 1
Save this as MMengine.bas
Code:
'+--------------------------------------------------------------------------+ '| | '| MMengine | '| | '| MultiMedia MCI encapsulation | '| | '| Version 1.00 | '| | '+--------------------------------------------------------------------------+ '| | '| Author Patrice TERRIER | '| 8 Domaine de Rochagnon. 38800 Champagnier FRANCE | '| http://www.zapsolution.com | '| E-mail: [email protected] | '| | '| copyright (c) 2000 Patrice TERRIER | '| | '+--------------------------------------------------------------------------+ '| Project started on : 09-21-2000 | '| Last revised : 10-01-2000 | '+--------------------------------------------------------------------------+ #COMPILE DLL "MMENGINE.DLL" '----------------------------------------------------------------- ' Equates: 7 '----------------------------------------------------------------- %WINAPI = 1 %TRUE = 1 %NULL = 0 %DLL_PROCESS_DETACH = 0 %DLL_PROCESS_ATTACH = 1 %MCIERR_BASE = 256 %MCIERR_UNSUPPORTED_FUNCTION = %MCIERR_BASE + 18 '----------------------------------------------------------------- ' TYPE and UNION structures: 1 '----------------------------------------------------------------- TYPE RECT nLeft AS LONG nTop AS LONG nRight AS LONG nBottom AS LONG END TYPE '----------------------------------------------------------------- ' Declared Functions: 10 '----------------------------------------------------------------- DECLARE FUNCTION GetPrivateProfileString LIB "KERNEL32.DLL" ALIAS "GetPrivateProfileStringA" (lpApplicationName AS ASCIIZ, lpKeyName AS ASCIIZ, lpDefault AS ASCIIZ, lpReturnedString AS ASCIIZ, BYVAL nSize AS DWORD, lpFileName AS ASCIIZ) AS DWORD DECLARE FUNCTION GetShortPathName LIB "KERNEL32.DLL" ALIAS "GetShortPathNameA" (lpszLongPath AS ASCIIZ, lpszShortPath AS ASCIIZ, BYVAL cchBuffer AS LONG) AS LONG DECLARE FUNCTION GetWindowRect LIB "USER32.DLL" ALIAS "GetWindowRect" (BYVAL hWnd AS DWORD, lpRect AS RECT) AS LONG DECLARE FUNCTION GetWindowsDirectory LIB "KERNEL32.DLL" ALIAS "GetWindowsDirectoryA" (lpBuffer AS ASCIIZ, BYVAL nSize AS DWORD) AS DWORD DECLARE FUNCTION KillTimer LIB "USER32.DLL" ALIAS "KillTimer" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG) AS LONG DECLARE FUNCTION mciGetDeviceID LIB "WINMM.DLL" ALIAS "mciGetDeviceIDA" (lpstrName AS ASCIIZ) AS LONG DECLARE FUNCTION mciGetErrorString LIB "WINMM.DLL" ALIAS "mciGetErrorStringA" (BYVAL dwError AS DWORD, lpstrBuffer AS ASCIIZ, BYVAL uLength AS DWORD) AS LONG DECLARE FUNCTION mciSendString LIB "WINMM.DLL" ALIAS "mciSendStringA" (lpstrCommand AS ASCIIZ, lpstrReturnString AS ASCIIZ, BYVAL uReturnLength AS DWORD, BYVAL hwndCallback AS DWORD) AS LONG DECLARE FUNCTION SetTimer LIB "USER32.DLL" ALIAS "SetTimer" (BYVAL hWnd AS DWORD, BYVAL nIDEvent AS LONG, BYVAL uElapse AS DWORD, BYVAL lpTimerFunc AS LONG) AS LONG DECLARE FUNCTION WritePrivateProfileString LIB "KERNEL32.DLL" ALIAS "WritePrivateProfileStringA" (lpApplicationName AS ASCIIZ, lpKeyName AS ASCIIZ, lpString AS ASCIIZ, lpFileName AS ASCIIZ) AS LONG #INCLUDE "MMENGINE.INC" %PLAYING = 3 %PAUSED = 2 %STOPPED = 1 %NOT_OPENED = -1 GLOBAL MM_from, MM_to, MM_IsOpen AS LONG, zTmp AS ASCIIZ * 260 'FUNCTION LibMain& (BYVAL DllInstance&, BYVAL Reason&, BYVAL Reserved&) EXPORT ' ' Ret& = %TRUE ' ' SELECT CASE Reason& ' CASE %DLL_PROCESS_ATTACH ' DLL is attaching to the address space of the current process ' ' hInst& = DllInstance& ' CALL MMInit() ' ' CASE %DLL_PROCESS_DETACH ' The calling process is detaching the DLL from its address space. ' ' CALL MMSetAutoRepeat (0) ' CALL MMClose ' ' END SELECT ' 'LibExit: ' FUNCTION = Ret& ' 'END FUNCTION SUB MMInit ALIAS "MMInit" () EXPORT ' These functions help you if you want to use the default device ' the parameter must be the device type like: ' MpegVideo, sequencer, avivideo, waveaudio, videodisc IF MMGetDefaultDevice("MEPGVideo") <> "mciqtz.drv" THEN ' If Driver"mciqtz.drv" not the default device for type ' "MMVideo" then set mciqtz.drv as a default device CALL MMSetDefaultDevice("MPEGVideo", "mciqtz.drv") ' MMSetDefaultDevice "MPEGVideo", "mciqtz.drv"' this the most ' important device and it will receives calls mci. ' Some programs change this device like XING mpeg ' and if this occur you can not play all mutimedia files ' and you will have unexpected errors END IF IF MMGetDefaultDevice("Sequencer") <> "mciseq.drv" THEN ' If Driver"mciseq.drv" not the default device for type ' "sequencer" then set mciqtz.drv as a default device CALL MMSetDefaultDevice("Sequencer", "mciseq.drv") END IF IF MMGetDefaultDevice("AviVideo") <> "mciavi.drv" THEN ' If Driver"mciavi.drv" not the default device for type ' "avivideo" then set avivideo as a default device CALL MMSetDefaultDevice("AviVideo", "mciavi.drv") END IF END SUB FUNCTION MMOpen ALIAS "MMOpen" (BYVAL hWnd AS DWORD, zFilName AS ASCIIZ) EXPORT AS DWORD ' This function initializes a device to play the specified FilName$. ' hWnd correspond to the handle of the parent window. CALL GetShortPathName (zFilName$, zTmp, SIZEOF(zTmp)) ShortPath$ = zTmp So& = INSTR(-1, zFilName, ".") IF So& THEN Fext$ = LCASE$(MID$(zFilName, So&)) typeDevice$ = "MPEGVideo" RetryOpen: cmdToDo$ = "Open " + zTmp + " Type " + typeDevice$ + " Alias MM" + _ " parent" + STR$(hWnd) + " Style Child"' + STR$(Style&) MM_from& = 0: MM_to& = 0 Ret??? = mciSendString((cmdToDo$), BYVAL %NULL, 0, BYVAL %NULL) IF Ret??? = 0 THEN MM_IsOpen& = -1 ELSEIF Fext$ = ".wav" THEN Fext$ = "": typeDevice$ = "waveaudio": GOTO RetryOpen END IF FUNCTION = Ret??? END FUNCTION FUNCTION MMSetVideo ALIAS "MMSetVideo" (BYVAL hWndParent AS DWORD) EXPORT AS DWORD LOCAL rc AS RECT CALL GetWindowRect(hWndParent, rc) wW& = rc.nRight - rc.nLeft: wH& = rc.nBottom - rc.nTop cmdToDo$ = "Window MM handle" + STR$(hWndParent) Ret??? = mciSendString((CmdToDo$), BYVAL %NULL, 0, BYVAL %NULL) IF Ret??? = 0 THEN cmdToDo$ = "Put MM destination at 0 0" + str$(wW&) + STR$(wH&) Ret??? = mciSendString((CmdToDo$), BYVAL %NULL, 0, BYVAL %NULL) END IF FUNCTION = Ret??? END FUNCTION FUNCTION MMDeviceID ALIAS "MMDeviceID" () EXPORT AS DWORD ' This function retrieves the device identifier corresponding ' to the name of an open device. FUNCTION = mciGetDeviceID("MM") END FUNCTION FUNCTION MMGetTotalFrames ALIAS "MMGetTotalFrames" () EXPORT AS LONG ' This function returns the number of frames in a multimedia file. CALL mciSendString("set MM time format frames", zTmp, SIZEOF(zTmp), BYVAL %NULL) Ret??? = mciSendString("status MM length", zTmp, SIZEOF(zTmp), BYVAL %NULL) IF Ret??? = 0 THEN FUNCTION = CLNG(VAL(zTmp)) END FUNCTION FUNCTION MMGetTotalTimeByMS ALIAS "MMGetTotalTimeByMS" () EXPORT AS LONG ' This function returns the track length in minutes and seconds. ' Sets the time format to minutes, seconds. ' All commands that use position values will assume MS. CALL mciSendString("set MM time format ms", zTmp, SIZEOF(zTmp), BYVAL %NULL) Ret??? = mciSendString("status MM length", zTmp, SIZEOF(zTmp), BYVAL %NULL) IF Ret??? = 0 THEN FUNCTION = CLNG(VAL(zTmp)) END FUNCTION FUNCTION MMPlay ALIAS "MMPlay" (BYVAL FromHere AS LONG, BYVAL ToThere AS LONG) EXPORT AS DWORD ' This function allows to play specific parts from within a multimeda file. TotalFrames& = MAX&(MMGetTotalFrames, 0) IF FromHere& = 0 AND ToThere& = 0 THEN MM_from& = 1 MM_to& = TotalFrames& ELSEIF FromHere& AND ToThere& THEN MM_from& = FromHere& MM_to& = ToThere& ELSEIF FromHere& AND ToThere& = 0 THEN MM_from& = FromHere& MM_to& = TotalFrames& ELSEIF FromHere& = 0 AND ToThere& THEN MM_from& = 1 MM_to& = ToThere& END IF cmdToDo$ = "Play MM from" + STR$(MM_from&) + " to" + STR$(MM_to&) FUNCTION = mciSendString((cmdToDo$), BYVAL %NULL, 0, BYVAL %NULL) END FUNCTION FUNCTION MMSetVolume ALIAS "MMSetVolume" (BYVAL UseVolume AS LONG) EXPORT AS DWORD cmdToDo$ = "Setaudio MM volume to" + STR$(UseVolume) FUNCTION = mciSendString((cmdToDo$), BYVAL %NULL, 0, BYVAL %NULL) END FUNCTION FUNCTION MMClose ALIAS "MMClose" () EXPORT AS DWORD ' This function closes an open multimedia device. IF MM_IsOpen& THEN CALL MMStop FUNCTION = mciSendString("Close MM", BYVAL %NULL, 0, BYVAL %NULL) MM_IsOpen& = 0 END IF END FUNCTION FUNCTION MMStop ALIAS "MMStop" () EXPORT AS DWORD ' This function stops playing of a multimedia file. FUNCTION = mciSendString("Stop MM", BYVAL %NULL, 0, BYVAL %NULL) END FUNCTION FUNCTION MMPause ALIAS "MMPause" () EXPORT AS DWORD ' This function pauses playing of a multimedia file. FUNCTION = mciSendString("Pause MM", BYVAL %NULL, 0, BYVAL %NULL) END FUNCTION FUNCTION MMResume ALIAS "MMResume" () EXPORT AS DWORD ' This function resumes playing of a multimedia file. FUNCTION = mciSendString("Resume MM", BYVAL %NULL, 0, BYVAL %NULL) END FUNCTION FUNCTION MMPutWindow ALIAS "MMPutWindow" (BYVAL xLeft&, BYVAL yTop&, BYVAL xWidth&, BYVAL yHeight&) EXPORT AS DWORD ' This function sets the VIDEO's window size and location ' using the provided coordinates. cmdToDo$ = "Put MM window at" + STR$(xLeft&) + STR$(yTop&) + str$(xWidth&) + str$(yHeight&) FUNCTION = mciSendString((cmdToDo$), BYVAL %NULL, 0, BYVAL %NULL) END FUNCTION FUNCTION MMMove ALIAS "MMMove" (BYVAL ToThere AS LONG, BYVAL IsInPauseMode AS LONG) EXPORT AS DWORD ' This function moves the current read/play position ' to the specified ToThere& location. cmdToDo$ = "Seek MM to" + STR$(ToThere&) FUNCTION = mciSendString((cmdToDo$), BYVAL %NULL, 0, BYVAL %NULL) CALL mciSendString("Play MM", BYVAL %NULL, 0, BYVAL %NULL) IF IsInPauseMode THEN CALL MMPause() END FUNCTION FUNCTION MMGetStatus ALIAS "MMGetStatus" () EXPORT AS LONG ' This function returns the current status of an open multimedia file. CALL mciSendString("Status MM mode", zTmp, SIZEOF(zTmp), BYVAL %NULL) SELECT CASE LCASE$(zTmp) CASE "playing" FUNCTION = %MM_PLAYING CASE "paused" FUNCTION = %MM_PAUSED CASE "stopped" FUNCTION = %MM_STOPPED CASE ELSE FUNCTION = 0 END SELECT END FUNCTION FUNCTION MMGetCurrentPos ALIAS "MMGetCurrentPos" () EXPORT AS LONG ' This function returns the current pos location in an open multimedia file. CALL mciSendString("set MM time format ms", zTmp, SIZEOF(zTmp), BYVAL %NULL) Ret??? = mciSendString("Status MM position", zTmp, SIZEOF(zTmp), BYVAL %NULL) IF Ret??? = 0 THEN FUNCTION = CLNG(VAL(zTmp)) END IF END FUNCTION FUNCTION MMGetPercent ALIAS "MMGetPercent" () EXPORT AS LONG ' This function returns the current pos as a percentage value. TotalTime& = MMGetTotalTimeByMS() CurrentPos& = MMGetCurrentPos() IF TotalTime& THEN FUNCTION = (CurrentPos& * 100) \ TotalTime& END FUNCTION FUNCTION MMMoveAtPercent ALIAS "MMMoveAtPercent" (BYREF Percent AS LONG) EXPORT AS DWORD ' This function moves the current read/play position ' at the specified Percent& location. TotalFrames& = MAX&(MMGetTotalFrames, 0) IF Percent& = 100 THEN ToThere& = TotalFrames& ELSE ToThere& = CLNG(TotalFrames& / 100) * Percent& END IF FUNCTION = MMMove(ToThere&, 0) END FUNCTION FUNCTION MMGetFramesPerSecond ALIAS "MMGetFramesPerSecond" () EXPORT AS LONG ' This function returns the number of frames per second. TotalTime& = MMGetTotalTimeByMS() TotalFrames& = MMGetTotalFrames() IF TotalTime& THEN FUNCTION = CLNG(TotalFrames& / (TotalTime& / 1000)) END FUNCTION FUNCTION MMAreAtEnd ALIAS "MMAreAtEnd" () EXPORT AS LONG ' This function test for the current play location ' It returns TRUE if the END has been reached ' Else it returns FALSE. CurrentPos& = MMGetCurrentPos IF CurrentPos& > -1 THEN IF MM_to& <= CurrentPos& THEN FUNCTION = -1 END IF END FUNCTION FUNCTION MMTimerProc (BYVAL hWnd&, BYVAL Msg&, BYVAL idEvent&, BYVAL dwTime&) AS LONG ' Private function being used by MMSetAutoRepeat IF MMAreAtEnd THEN CALL MMPlay (MM_from&, MM_to&) END FUNCTION SUB MMSetAutoRepeat ALIAS "MMSetAutoRepeat" (BYVAL Autorep AS LONG) STATIC EXPORT ' This subroutine switches the autorepeat mode to ON or OFF. IF Autorep& THEN MMTimerIs& = SetTimer(%NULL , 0, 100, CodePtr(MMTimerProc)) ELSE IF MMTimerIs& THEN CALL KillTimer(%NULL, MMTimerIs&): MMTimerIs& = 0 END IF END SUB FUNCTION MMGetDefaultDevice ALIAS "MMGetDefaultDevice" (zTypeDevice AS ASCIIZ) EXPORT AS STRING ' This function gets the default device for a typeDevice$. DIM zDevice AS ASCIIZ * 256 CALL GetWindowsDirectory(zTmp, SIZEOF(zTmp)) zTmp = RTRIM$(zTmp, ANY CHR$(0,92)) + "\system.ini" CALL GetPrivateProfileString("MCI", zTypeDevice, "None", zDevice, SIZEOF(zDevice), zTmp) FUNCTION = LCASE$(zDevice) END FUNCTION SUB MMSetDefaultDevice ALIAS "MMSetDefaultDevice" (zTypeDevice AS ASCIIZ, zDrvDefaultDevice AS ASCIIZ) EXPORT ' This subroutine updates SYSTEM.INI with the provided typeDevice$ CALL GetWindowsDirectory(zTmp, SIZEOF(zTmp)) zTmp = RTRIM$(zTmp, ANY CHR$(0,92)) + "\system.ini" CALL WritePrivateProfileString("MCI", zTypeDevice, zDrvDefaultDevice, zTmp) END SUB FUNCTION MMErrorMsg ALIAS "MMErrorMsg" (BYVAL Ret AS DWORD) EXPORT AS STRING ' This function returns a detailed MCI error string. CALL mciGetErrorString(Ret???, zTmp, SIZEOF(zTmp)) FUNCTION = zTmp END FUNCTION FUNCTION MMFreeze ALIAS "MMFreeze" () EXPORT AS DWORD ' The freeze command freezes video input or video output on a VCR or disables ' video acquisition to the frame buffer. ' Digital-video, video-overlay, and VCR devices recognize this command. CALL mciSendString("Capability MM can freeze", zTmp, SIZEOF(zTmp), BYVAL %NULL) IF LCASE$(zTmp) = "true" THEN cmdToDo$ = "Freeze MM output wait" FUNCTION = mciSendString((cmdToDo$), BYVAL %NULL, 0, BYVAL %NULL) ELSE FUNCTION = %MCIERR_UNSUPPORTED_FUNCTION END IF END FUNCTION FUNCTION MMUnFreeze ALIAS "MMUnFreeze" () EXPORT AS DWORD ' The MMUnFreeze command reenables video acquisition to the frame buffer after ' it has been disabled by the freeze command. ' Digital-video, video-overlay, and VCR devices recognize this command. CALL mciSendString("Capability MM can freeze", zTmp, SIZEOF(zTmp), BYVAL %NULL) IF LCASE$(zTmp) = "true" THEN cmdToDo$ = "Unfreeze MM wait" FUNCTION = mciSendString((cmdToDo$), BYVAL %NULL, 0, BYVAL %NULL) ELSE FUNCTION = %MCIERR_UNSUPPORTED_FUNCTION END IF END FUNCTION FUNCTION MMGetSize ALIAS "MMGetSize" (BYREF xWidth AS LONG, BYREF yHeight AS LONG) EXPORT AS DWORD ' This function gets the media's width and height sizes. ' Returns Error code if unsuccessful Ret??? = mciSendString("Where MM source", zTmp, SIZEOF(zTmp), BYVAL %NULL) IF Ret??? THEN xWidth& = 0: yHeight& = 0 ELSE Coordinate$ = TRIM$(zTmp) xWidth& = VAL(PARSE$(Coordinate$, " ", 3)) yHeight& = VAL(PARSE$(Coordinate$, " ", 4)) END IF END FUNCTION FUNCTION MMGetLocation ALIAS "MMGetLocation" (BYREF xLeft AS LONG, BYREF yTop AS LONG, BYREF xWidth AS LONG, BYREF yHeight AS LONG) EXPORT AS DWORD ' This function returns the media's window coordinates. ' Returns Error code if unsuccessful Ret??? = mciSendString("Where MM window", zTmp, SIZEOF(zTmp), BYVAL %NULL) IF Ret??? THEN xLeft& = 0: yTop& = 0: xWidth& = 0: yHeight& = 0 ELSE Coordinate$ = TRIM$(zTmp) xLeft& = VAL(PARSE$(Coordinate$, " ", 1)) yTop& = VAL(PARSE$(Coordinate$, " ", 2)) xWidth& = VAL(PARSE$(Coordinate$, " ", 3)) yHeight& = VAL(PARSE$(Coordinate$, " ", 4)) END IF END FUNCTION FUNCTION MMGetWindowHandle ALIAS "MMGetWindowHandle" (BYREF hWnd AS DWORD) EXPORT AS DWORD ' This function returns the handle of the window being used to display video. Ret??? = mciSendString("Status MM window handle", zTmp, SIZEOF(zTmp), BYVAL %NULL) IF Ret??? = 0 THEN hWnd = VAL(zTmp) ELSE hWnd = 0 END IF FUNCTION = Ret??? END FUNCTION 'FUNCTION MMCapture ALIAS "MMCapture" (BYVAL FilName$, BYVAL xL&, BYVAL yT&, BYVAL xW&, BYVAL yH&) EXPORT AS DWORD '' This function copies the content of the frame buffer and stores it '' in the specified file. '' Returns Error code if unsuccessful ' IF xL& OR yT& OR xW& OR yH& THEN ' AtLocation$ = " at" + STR$(xL&) + STR$(yT&) + STR$(xW&) + STR$(yH&) ' END IF ' cmdToDo$ = "Capture MM as " + FilName$ + AtLocation$ ' FUNCTION = mciSendString((CmdToDo$), BYVAL %NULL, 0, BYVAL %NULL) ' 'END FUNCTION
Code:
'+--------------------------------------------------------------------------+ '| MCIplayer | '| | '| Poor man MCI video player | '| to be used with the MMENGINE.DLL | '| | '+--------------------------------------------------------------------------+ '| | '| Author Patrice TERRIER | '| copyright(c) 2008 | '| www.zapsolution.com | '| [email protected] | '| | '+--------------------------------------------------------------------------+ '| Project started on : 02-29-2008 (MM-DD-YYYY) | '| Last revised : 02-29-2008 (MM-DD-YYYY) | '+--------------------------------------------------------------------------+ #COMPILE EXE "MCIplayer.exe" #INCLUDE "ComDlg32.inc" #INCLUDE "MMENGINE.INC" ' Menu identifiers %ID_FILE_OPENCLIP = 40001 %ID_FILE_EXIT = 40002 GLOBAL gbMoviePlaying, ghVideoHandle AS LONG FUNCTION FileOpen (BYVAL hwnd AS DWORD) AS STRING LOCAL Path AS STRING LOCAL fOptions AS STRING LOCAL dwStyle AS DWORD LOCAL f AS STRING LOCAL rc AS RECT Path = CURDIR$ fOptions = "Video Files (*.MPG;*MPEG;*.AVI;*.MOV;*.QT;*.WMV)|*.MPG;*.MPEG;*.AVI;*.MOV;*.QT;*.WMV|" f = "*.MPG;*.MPEG;*.AVI;*.MOV;*.QT;*.WMV" dwStyle = %OFN_EXPLORER OR %OFN_FILEMUSTEXIST IF OpenFileDialog(hwnd, "", f, Path, fOptions, "MPG", dwStyle) THEN FUNCTION = f END IF END FUNCTION SUB MovieClose() CALL MMClose() ' CloseMedia gbMoviePlaying = 0 END SUB SUB MoviePlay() CALL MMResume() gbMoviePlaying = -1 END SUB SUB MoviePlayNewMedia(BYVAL hParent AS LONG, zThisMovie AS ASCIIZ) LOCAL lWidth, lHeight AS LONG, rc AS RECT ' If there is a movie playing then stop it CALL MovieClose() ' Render the file IF MMOpen(hParent, zThisMovie) = 0 THEN ' Retrieve the real video size CALL MMGetSize(lWidth, lHeight) ' Get the true Video window handle CALL MMGetWindowHandle(ghVideoHandle) ' Set the window position IF ghVideoHandle THEN CALL GetClientRect(hParent, rc) CALL MoveWindow(ghVideoHandle, rc.nLeft, rc.nTop, rc.nRight, rc.nBottom, 0) ' Run the movie CALL MMPlay(0, 0) CALL MoviePlay() END IF END IF END SUB FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG LOCAL hWndMain AS DWORD LOCAL wcex AS WndClassEx LOCAL szClassName AS ASCIIZ * 80 LOCAL szCaption AS ASCIIZ * 255 ' Register the window class szClassName = "MCIplayer" wcex.cbSize = SIZEOF(wcex) wcex.style = %CS_HREDRAW OR %CS_VREDRAW wcex.lpfnWndProc = CODEPTR(WndProc) wcex.cbClsExtra = 0 wcex.cbWndExtra = 0 wcex.hInstance = hInstance wcex.hCursor = LoadCursor (%NULL, BYVAL %IDC_ARROW) wcex.hbrBackground = GetStockObject(%BLACK_BRUSH) ' %COLOR_3DFACE + 1 wcex.lpszMenuName = %NULL wcex.lpszClassName = VARPTR(szClassName) wcex.hIcon = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) wcex.hIconSm = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) RegisterClassEx wcex ' Window caption szCaption = "MCIplayer demo" ' Create a window using the registered class hWndMain = CreateWindowEx(%WS_EX_CONTROLPARENT, _ ' extended style szClassName, _ ' window class name szCaption, _ ' window caption %WS_OVERLAPPEDWINDOW, _ ' window style %CW_USEDEFAULT, _ ' initial x position %CW_USEDEFAULT, _ ' initial y position %CW_USEDEFAULT, _ ' initial x size %CW_USEDEFAULT, _ ' initial y size %NULL, _ ' parent window handle 0, _ ' window menu handle hInstance, _ ' program instance handle BYVAL %NULL) ' creation parameters LOCAL hMenu AS DWORD LOCAL hMenuFile AS DWORD hMenu = CreateMenu hMenuFile = CreatePopUpMenu AppendMenu hMenu, %MF_POPUP OR %MF_ENABLED, hMenuFile, "&File" AppendMenu hMenuFile, %MF_ENABLED, %ID_FILE_OPENCLIP, "&Open clip..." AppendMenu hMenuFile, %MF_ENABLED, %ID_FILE_EXIT, "E&xit" SetMenu hWndMain, hMenu ' Show the window ShowWindow hWndMain, nCmdShow UpdateWindow hWndMain ' Message handler loop LOCAL Msg AS tagMsg WHILE GetMessage(Msg, %NULL, 0, 0) IF ISFALSE IsDialogMessage(hWndMain, Msg) THEN TranslateMessage Msg DispatchMessage Msg END IF WEND FUNCTION = msg.wParam END FUNCTION FUNCTION WndProc (BYVAL hWnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG LOCAL hr AS LONG LOCAL rc AS RECT LOCAL strFileName AS STRING SELECT CASE wMsg CASE %WM_SIZE IF ghVideoHandle THEN CALL GetClientRect(hWnd, rc) CALL MoveWindow(ghVideoHandle, rc.nLeft, rc.nTop, rc.nRight, rc.nBottom, 0) END IF CASE %WM_ERASEBKGND IF gbMoviePlaying THEN FUNCTION = 1: EXIT FUNCTION CASE %WM_COMMAND SELECT CASE LOWRD(wParam) CASE %IDOK IF HIWRD(wParam) = %BN_CLICKED THEN END IF CASE %IDCANCEL, %ID_FILE_EXIT IF HIWRD(wParam) = %BN_CLICKED THEN SendMessage hWnd, %WM_CLOSE, wParam, lParam FUNCTION = 0 EXIT FUNCTION END IF CASE %ID_FILE_OPENCLIP IF HIWRD(wParam) = %BN_CLICKED THEN strFileName = FileOpen(hwnd) IF LEN(strFileName) THEN MoviePlayNewMedia(hWnd, (strFileName)) END IF END SELECT CASE %WM_SYSCOMMAND ' Capture this message and send a WM_CLOSE message IF (wParam AND &HFFF0) = %SC_CLOSE THEN SendMessage hWnd, %WM_CLOSE, wParam, lParam EXIT FUNCTION END IF CASE %WM_CLOSE CASE %WM_DESTROY CALL MovieClose() PostQuitMessage 0 EXIT FUNCTION END SELECT FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam) END FUNCTION
