ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Fichiers AVI dans vos formulaires VFP (sans utiliser MMcontrol) et gérant la transparence   



L'auteur

Francis Faure
France France
Membre Actif (personne physique)
# 0000000001
enregistré le 11/10/2004

http://www.wanagain.net
56 ans
Faure Francis
de la société Design Or Decline
Fiche personnelle


Note des membres
19/20
2 votes


Contributions > 05 - API et appels systèmes

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é 11508 fois
Niveau initié

Version(s) Foxpro :
VFP 9.0

Zoomer sur l'image

Télécharger le ZIP (1.63 Ko)
Description

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
*----------------------------------------------------------------------
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 LongStringStringLongLongLongLongLongLongLongLongLong
  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 LongLongLongString
    =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 LongLong
    =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 LongLongLongString
      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
*----------------------------------------------------------------------

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!!!
le 21/04/2019, eddymaue a écrit :
Allo Francis

il manque le formulaire PlayAvi.

bonne journée



Publicité

Les pubs en cours :


www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3