Ficheros AVI en nuestros formularios (sin usar MMControl)

VFP viene con una clase que mediante el control MCI MMcontrol permite adjuntar ficheros AVI;
Pero el problema de esta solución es el color de la trasparencia que no se respeta. Adjunto una solución con algunas líneas de código que no usa directamente el control MMcontrol y permite vincular un AVI a un formulario respetando el color de fondo.

Se trata de una clase y para usarla basta con definir un shape en el formulario, darle un nombre, poner un backcolor y los tamaños. En el INIT habrá que llamar al método PlayAvi con los parámetros correspondientes

SET PROCEDURE TO ClasseAvi additive
 ThisForm.addobject("OAvi1", "AVI")
 ThisForm.oAvi1.PlayAvi(Thisform.ShapeAvi1, "filecopy.avi")

*----------------------------------------------------------------------
 * ClasseAvi
 * PayAvi : Gestiona un AVI en un formulario respectando la trasparencia
* sans utiliser (Directement) le MMcontrol
 * Francis FAURE 6/2006
 *----------------------------------------------------------------------
  
 DEFINE CLASS AVI as Session
   version = 1.1
   x = 0
   y = 0
   w = 0
   h = 0
   FormHwnd = 0
   AviHwnd = 0
   BackColor = 0
   BackStyle = 1
   Shape = null
   AviFileName = ""
 
   PROCEDURE Init
   Endproc
 
   Procedure Destroy
     This.StopAvi() && v 1.1
     DODEFAULT()
   endproc
 
   PROCEDURE PlayAvi(AviShape as object, AviFileName as String)
     * test 2 paramétres
     IF pcount()<>2
       =MESSAGEBOX("Il faut 2 paramétres pour .PlayAvi(oShape, sAviFileName)")
       return
     endif
     * Fichier Avi
     IF EMPTY(AviFileName)
       =MESSAGEBOX("Veuillez préciser le nom du fichier AVI en paramétre")
       return
     endif
     This.AviFileName = FULLPATH(ALLTRIM(AviFileName))
     IF NOT FILE(This.AviFileName)
       =MESSAGEBOX("Le fichier :"+This.AviFileName+" est introuvable.")
       This.AviFileName=""
       return
     ENDIF
     * Récupération des informations du shape
     IF TYPE("AviShape")<>"O" OR AviShape.BaseClass<>"Shape"
       =MESSAGEBOX("Le premier paramétre de .PlayAvi est une référence a un object Shape (celui sert a positionner l'AVI)")
       RETURN
     ENDIF
     This.FormHwnd = AviShape.Parent.hwnd  && lhwnd
     This.x = AviShape.left
     This.y = AviShape.top
     This.w = AviShape.width
     This.h = AviShape.height
     This.BackColor = AviShape.BackColor
     This.BackStyle = AviShape.BackStyle
     This.Shape = AviShape
 
     * Création d'une fenêtre sur informations du shape
     *ACS_CENTER              0x0001
     *ACS_TRANSPARENT         0x0002
     *ACS_AUTOPLAY            0x0004
     *ACS_TIMER               0x0008
     #DEFINE WS_EX_TRANSPARENT 0x20
     #define ANIMATE_CLASS "SysAnimate32"
     Declare Long CreateWindowEx IN user32 Long, String, String, Long, Long, Long, Long, Long, Long, Long, Long, Long
 This.AviHwnd = CreateWindowEx(WS_EX_TRANSPARENT, ANIMATE_CLASS, "", 0x50000007, this.x, this.y, this.w, this.h, this.FormHwnd, 0, 0, 0)
     CLEAR DLLS CreateWindowEx
 
     * Utilisation de BindEvent pour récupérer le CallBack (hook) du message WM_CTLCOLORSTATIC de l'avi
     #define WM_CTLCOLORSTATIC 0x0138
     BINDEVENT(This.FormHwnd, WM_CTLCOLORSTATIC, This, "MyCTLCOLORSTATIC")
 
     * Message d'ouverture de l'avi
     #define WM_USER 0x400
     #define ACM_OPEN WM_USER + 100
     #define ACM_PLAY WM_USER + 101
     Declare LONG SendMessage IN user32 Long, Long, Long, String
     =SendMessage(This.AviHwnd, ACM_OPEN, 0, This.AviFileName)  && OPEN suffit car la fenetre est définie en autoplay
     This.Shape.Refresh()
     CLEAR DLLS SendMessage
   endproc
 
   * Methode déclanchée par la réception du message WM_CTLCOLORSTATIC (BindEvent+haut)
   PROCEDURE MyCTLCOLORSTATIC(whwnd as Long, uMSG as Long, HDC as Long, HWNDcontrol as long)
     IF This.AviHwnd=0
       RETURN
     endif
     IF This.AviHwnd <> HWNDcontrol
       RETURN
     ENDIF
     Declare long SetBkColor IN Win32API Long, Long
     =SetBkColor(HDC, This.BackColor)
     CLEAR DLLS SetBkColor
     * Suppression du Bind (changement du backcolor une fois suffit)
     unBINDEVENT(This.FormHwnd, WM_CTLCOLORSTATIC)
   ENDPROC
 
   * v 1.1
   PROCEDURE StopAvi
     IF This.AviHwnd<>0
       Declare LONG SendMessage IN user32 Long, Long, Long, String
       Declare long DestroyWindow IN user32 Long
       #define ACM_STOP WM_USER + 102
       =SendMessage(This.AviHwnd, ACM_STOP, 0, "")
       =DestroyWindow(this.AviHwnd)
       This.AviHwnd=0  && permet de savoir si un avi est en cours
       This.AviFileName=""
       CLEAR DLLS DestroyWindow
       CLEAR DLLS SendMessage
     endif
   endproc
 ENDDEFINE
 *----------------------------------------------------------------------