Fichiers AVI dans vos formulaires VFP (sans utiliser MMcontrol) et gérant la transparence
# 0000000332
ajouté le 13/06/2006 18:37:31 et modifié le 16/06/2006
consulté 11842 fois
Niveau
initié
VFP est livré avec une classe utilisant MCI MMcontrol et permettant d'afficher des fichiers AVI; Mais le problème de cette solution est la couleur de "transparence" qui n'est pas respectée (et de plusieurs VCX... _multimedia.VCX _base.vcx). Après avoir essayé de modifier les commands MCI de cette solution...
Voici une solution de quelques lignes de code, n'utilisant pas (directement) le MMcontrol mais permettant l'affichage d'un AVI dans un formulaire en respectant la couleur de fond.
Il s'agit d'une classe, pour l'utiliser il suffit de : - définir un "shape" dans votre formulaire, donnez lui un nom, un backcolor, hauteur, largeur etc... (il peut etre invisible a l'exécution) - créer un objet dans l'INIT (par exemple) du formulaire et appeler la methode PlayAvi() avec en paramétre le nom du Shape et le fichier AVI a utiliser
SET PROCEDURE TO ClasseAvi additive ThisForm.addobject("OAvi1", "AVI") ThisForm.oAvi1.PlayAvi(Thisform.ShapeAvi1, "filecopy.avi")
La classe récupére les propriétés du Shape pour gérer l'affichage de l'AVI...
Ci joint en zip, un exemple d'utilisation
Cordialement Francis FAURE
Merci à Fred pour les infos de paramètres API !
Code source :
*---------------------------------------------------------------------- * ClasseAvi * PayAvi : But afficher un AVI dans un formulaire avec gestion de la couleur de fond (Transparence) * sans utiliser (Directement) le MMcontrol * Francis FAURE 6/2006 *---------------------------------------------------------------------- * 1.0 : Publication * 1.1 : Ajout Méthode "StopAvi", Correction pb chargement dll dans le init, * Stop AVI et suppression de la fenétre au destroy() de l'objet *---------------------------------------------------------------------- DEFINECLASS 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 = ""
PROCEDUREInit Endproc
ProcedureDestroy This.StopAvi() && v 1.1 DODEFAULT() endproc
PROCEDURE PlayAvi(AviShape as object, AviFileName asString) * test 2 paramétres IFpcount()<>2
=MESSAGEBOX("Il faut 2 paramétres pour .PlayAvi(oShape, sAviFileName)") return endif * Fichier Avi IFEMPTY(AviFileName)
=MESSAGEBOX("Veuillez préciser le nom du fichier AVI en paramétre") return endif This.AviFileName = FULLPATH(ALLTRIM(AviFileName)) IFNOTFILE(This.AviFileName)
=MESSAGEBOX("Le fichier :"+This.AviFileName+" est introuvable.") This.AviFileName="" return ENDIF * Récupération des informations du shape IFTYPE("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" DeclareLong 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) CLEARDLLS 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 DeclareLONG 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() CLEARDLLS SendMessage endproc
* Methode déclanchée par la réception du message WM_CTLCOLORSTATIC (BindEvent+haut) PROCEDURE MyCTLCOLORSTATIC(whwnd asLong, uMSG asLong, HDC asLong, HWNDcontrol aslong) IFThis.AviHwnd=0 RETURN endif IFThis.AviHwnd <> HWNDcontrol RETURN ENDIF Declarelong SetBkColor IN Win32API Long, Long
=SetBkColor(HDC, This.BackColor) CLEARDLLS SetBkColor * Suppression du Bind (changement du backcolor une fois suffit) unBINDEVENT(This.FormHwnd, WM_CTLCOLORSTATIC) ENDPROC
* v 1.1 PROCEDURE StopAvi IFThis.AviHwnd<>0 DeclareLONG SendMessage IN user32 Long, Long, Long, String Declarelong 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="" CLEARDLLS DestroyWindow CLEARDLLS SendMessage endif endproc ENDDEFINE *----------------------------------------------------------------------
Commentaires
le 13/06/2006, FredA a écrit : Mais de rien l'ami ! Belle contrib
le 14/06/2006, JpG a écrit : Un très grand merci pour ta contribution.
le 16/06/2006, EmanuelL a écrit : Super Francis, je charchais un truc comme ça!!!
Retour à la liste
France
Fiche personnelle
Note des membres
Télécharger le ZIP
le 14/06/2006, 
le 21/04/2019,
Mais de rien l'ami !
Belle contrib