Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
How can i automatically play avi file on the form
Message
General information
Forum:
Visual FoxPro
Category:
Pictures and Image processing
Miscellaneous
Thread ID:
00714261
Message ID:
00714290
Views:
18
Try this code:

MartinJ
* Add this code into method Show()
SET LIBRARY TO foxtools.fll
=WinMCIAPIInit()
lcFile='"c:\program files\devstudio6\vfp98\gallery\media\search.avi"'
* Show avi on _Screen
*=ShowAVI(lcFile,"VFPAVI",Mainhwnd(),50,50,100,100)

* Show AVI on ontop form
=ShowAVI(lcFile,"VFPAVI",_WhTOHwnd(_WOnTop()),50,50,100,100)

*=INKEY(0)
*=StopAVI("VFPAVI")
********************************************************************

* In procedures file
*************************************************
* Start playing AVI file
***********************************************
PROCEDURE ShowAVI(lcAVI,lcAVIAlias,lihwnd,liLeft,liTop,liWidth,liHeight)
* lcAVI      - Folder and name of AVI file
* lcAVIAlias - AVI alias for MCI API
* lihwnd     - Handle output window
* liLeft     - Left position AVI overlay
* liTop      - Top position AVI overlay
* liWidth    - Width AVI overlay
* liHeight   - Width AVI overlay

LOCAL lcProgram,lcPath,lii,lnAVIhwnd,;
      lcMCIString,lcRetVal,lcErrMSG,liErr
STORE "" TO lcRetVal,lcErrMSG,lcPath

* otevøi MCI zaøízení
lcMCIString="OPEN "+ lcAVI+" ALIAS "+lcAVIAlias+" STYLE CHILD PARENT "+;
            LTRIM(STR(lihwnd,11))
liErr=SendMCI(lcMCIString,@lcRetVal,@lcErrMSG)
IF liErr=0 && pokud se to povedlo
   * zjisti handle okna AVI klipu
   lcMCIString="STATUS "+lcAVIAlias+" WINDOW HANDLE"
   liErr=SendMCI(lcMCIString,@lcRetVal,@lcErrMSG)

   IF liErr=0 && pokud se to povedlo
      lnAVIhwnd=VAL(lcRetVal)
      =SetWindowPos(lnAVIhwnd,0,liLeft,liTop,liWidth,liHeight,0)

      * ukaž to
      lcMCIString="WINDOW "+lcAVIAlias+" STATE SHOW"
      liErr=SendMCI(lcMCIString,@lcRetVal,@lcErrMSG)
      IF liErr=0 && pokud se to povedlo
         lcMCIString="PLAY "+lcAVIAlias+" REPEAT"
         liErr=SendMCI(lcMCIString,@lcRetVal,@lcErrMSG)
      ENDIF
   ENDIF
ENDIF

IF liErr>0
   * Error
   =MESSAGEBOX(lcErrMSG)
ENDIF

*************************************************
* Stop playing AVI file
***********************************************
PROCEDURE StopAVI(lcAVIAlias)
* lcAVIAlias - AVI alias for MCI API

LOCAL lcMCIString,lcRetVal,lcErrMSG,liErr
STORE "" TO lcRetVal,lcErrMSG
* zavøi MCI zaøízení
lcMCIString="CLOSE "+lcAVIAlias
liErr=SendMCI(lcMCIString,@lcRetVal,@lcErrMSG)
IF liErr>0
   * Error
*   =MESSAGEBOX(lcErrMSG,msgType4,XXF000_msgMain)
ENDIF



*************************************************
* Initialize API
***********************************************
PROCEDURE WinMCIAPIInit
* tato funkce posílá MCI pøíkazy (string)
DECLARE INTEGER mciSendString IN WINMM.DLL ;
   STRING cMCIString,;
   STRING @cRetString,;
   INTEGER nRetLength,;
   INTEGER hInstance

*!* This function allows us to retrieve the last MCI error that occured
DECLARE INTEGER mciGetErrorString ;
   IN WINMM.DLL ;
   INTEGER nErrorno, ;
   STRING @cBuffer, ;
   INTEGER nBufSize
   
DECLARE INTEGER SetWindowPos IN USER32;
        INTEGER, INTEGER, INTEGER, INTEGER, INTEGER, INTEGER, INTEGER


*************************************************
* 
***********************************************
PROCEDURE SendMCI(lcMCIString,lcRetVal,lcErrMSG)
*  lcMCIString - MCI pøíkaz
* @lcRetVal    - Návratová hodnota
* @lcErrMSG    - Chybová hláška

LOCAL nRetValue,lii
*!* This method takes a MCI command string and executes it using
*!* the Windows API function mciSendString

*!* If the function executes successfully, the result is returned.
*!* Otherwise, the error string is returned.
lcRetVal = SPACE(254)
nRetValue = mciSendString(lcMCIString,@lcRetVal,LEN(lcRetVal),0)

lii=AT(CHR(0),lcRetVal) && najdi znak 
IF lii>0 && pokud tam je
   lcRetVal=LEFT(lcRetVal,lii-1) && z navrácené hodnoty oøež pøebyteèné znaky
ENDIF

lcErrMSG="" && vyèisti øetìzec chybového hlášení
IF nRetValue > 0
   lcErrMSG=SPACE(250)
   =mciGetErrorString(nRetValue,@lcErrMSG,LEN(lcErrMSG))
ENDIF
 
RETURN nRetValue && vra chybový kód
>Thanks Martin,
>i saw the solutions samples but it requieres select an avi file... i wantto play avi file continiously and when form is activate...
"Navision is evil that needs to be erazed... to the ground"

Jabber: gorila@dione.zcu.cz
Jabber? Jabbim
Previous
Reply
Map
View

Click here to load this message in the networking platform