Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

MCI movie player

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

    MCI movie player

    Ok here is the MCI "poor man" movie player i promised in another thread.

    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
    Save this as MCIplayer.bas
    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
    And for the fun, i shall post a new MovieBox version using the MMengine, to show you a good looking one
    Last edited by Patrice Terrier; 29 Feb 2008, 06:53 AM.
    Patrice Terrier
    www.zapsolution.com
    www.objreader.com
    Addons: GDImage.DLL 32/64-bit (Graphic library), WinLIFT.DLL 32/64-bit (Skin Engine).
Working...
X
😀
🥰
🤢
😎
😡
👍
👎