vbalaviplayer.ctl

VB6_Transparent_AVI_Player_Full_Source.zip

VERSION 5.00
Begin VB.UserControl vbalAVIPlayer 
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   3600
   ScaleWidth      =   4800
   ToolboxBitmap   =   "vbalAVIPlayer.ctx":0000
End
Attribute VB_Name = "vbalAVIPlayer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

' Some styles:
Private Const GWL_STYLE = (-16)
Private Const WS_BORDER = &H800000

Private Const WS_CHILD = &H40000000
Private Const WS_DISABLED = &H8000000
Private Const WS_VISIBLE = &H10000000
Private Const WS_TABSTOP = &H100000
Private Const WS_HSCROLL = &H100000
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_TOPMOST = &H8&
Private Const WS_EX_CLIENTEDGE = &H200&
Private Const WS_EX_STATICEDGE = &H20000
Private Const CW_USEDEFAULT = &H80000000

' SetWindowPos
Private Const SWP_FRAMECHANGED = &H20        '  The frame changed: send WM_NCCALCSIZE
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOOWNERZORDER = &H200      '  Don't do owner Z ordering
Private Const SWP_NOREDRAW = &H8
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const SWP_SHOWWINDOW = &H40

Public Enum EAVIPAppearanceConstants
   eavipFlat
   eavip3D
End Enum

Public Enum EAVIPBorderStyleConstants
   eavipNone
   eavipFixedSingle
   eavipThin
End Enum

Private m_eAppearance As EAVIPAppearanceConstants
Private m_eBorder As EAVIPBorderStyleConstants
Private m_hWnd As Long
Private m_bTransparent As Boolean
Private m_oBackColor As OLE_COLOR
Private m_cAV As New cAVICtrl
Private m_bRunTime As Boolean

Public Property Get Appearance() As EAVIPAppearanceConstants
   Appearance = m_eAppearance
End Property
Public Property Let Appearance(ByVal eStyle As EAVIPAppearanceConstants)
   m_eAppearance = eStyle
   pSetBorder
   PropertyChanged "Appearance"
End Property
Public Property Get BorderStyle() As EAVIPBorderStyleConstants
   BorderStyle = m_eBorder
End Property
Public Property Let BorderStyle(ByVal eStyle As EAVIPBorderStyleConstants)
   m_eBorder = eStyle
   pSetBorder
   PropertyChanged "BorderStyle"
End Property
Private Sub pSetBorder()
Dim lS As Long
   If m_eAppearance = eavipFlat Then
      ' Flat border
      UserControl.BorderStyle() = 0
      pSetWinExStyle 0, WS_EX_STATICEDGE Or WS_EX_CLIENTEDGE
      If m_eBorder > eavipNone Then
         pSetStyle WS_BORDER, 0
      Else
         pSetStyle 0, WS_BORDER
      End If
   Else
      ' 3d border
      pSetStyle 0, WS_BORDER
      UserControl.BorderStyle() = 0
      If m_eBorder = eavipFixedSingle Then
         pSetWinExStyle WS_EX_CLIENTEDGE, WS_EX_STATICEDGE
      Else
         If m_eBorder = eavipThin Then
            pSetWinExStyle WS_EX_STATICEDGE, WS_EX_CLIENTEDGE
         Else
            pSetWinExStyle 0, WS_EX_STATICEDGE Or WS_EX_CLIENTEDGE
         End If
      End If
   End If
End Sub

Private Sub pSetStyle(ByVal lStyle As Long, ByVal lStyleNot As Long)
Dim lS As Long
   If Not m_hWnd = 0 Then
      lS = GetWindowLong(m_hWnd, GWL_STYLE)
      lS = lS And Not lStyleNot
      lS = lS Or lStyle
      SetWindowLong m_hWnd, GWL_STYLE, lS
      SetWindowPos m_hWnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
   End If
End Sub
Private Sub pSetWinExStyle(ByVal lStyle As Long, ByVal lStyleNot As Long)
Dim lS As Long
   If Not m_hWnd = 0 Then
      lS = GetWindowLong(m_hWnd, GWL_EXSTYLE)
      lS = lS And Not lStyleNot
      lS = lS Or lStyle
      SetWindowLong m_hWnd, GWL_EXSTYLE, lS
      SetWindowPos m_hWnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOOWNERZORDER Or SWP_NOZORDER Or SWP_FRAMECHANGED
   End If
End Sub
Public Function Load() As Boolean
   Load = m_cAV.Load
End Function
Public Function AVIPlay() As Boolean
   If m_cAV.IsLoaded Then
      AVIPlay = m_cAV.AVIPlay
   End If
End Function
Public Function AVIStop() As Boolean
   If m_cAV.IsLoaded Then
      If m_cAV.IsPlaying Then
         AVIStop = m_cAV.AVIStop
      End If
   End If
End Function
Public Function AVISeek(ByVal nFrame As Long) As Boolean
   If m_cAV.IsLoaded Then
      AVISeek = m_cAV.AVISeek(nFrame)
   End If
End Function
Public Property Get Playing() As Boolean
   Playing = m_cAV.IsPlaying
End Property
Public Property Let Playing(ByVal bState As Boolean)
   If m_cAV.IsPlaying Then
      If Not bState Then
         m_cAV.AVIStop
      End If
   Else
      If bState Then
         m_cAV.AVIPlay
      End If
   End If
End Property
Public Property Get CurrentFrame() As Boolean
   CurrentFrame = m_cAV.CurrentFrame
End Property
Public Property Get FrameCount() As Boolean
   FrameCount = m_cAV.FrameCount
End Property
Public Property Get FileName() As String
   FileName = m_cAV.FileName
End Property
Public Property Let FileName(ByVal sFileName As String)
   m_cAV.FileName = sFileName
End Property
Public Property Get TransparentColor() As OLE_COLOR
   TransparentColor = m_cAV.TransparentColor
End Property
Public Property Let TransparentColor(ByVal oColor As OLE_COLOR)
   m_cAV.TransparentColor = oColor
   PropertyChanged "TransparentColor"
End Property
Public Property Get Transparent() As Boolean
   Transparent = m_cAV.Transparent
End Property
Public Property Let Transparent(ByVal bState As Boolean)
   m_cAV.Transparent = bState
   PropertyChanged "Transparent"
End Property
Public Property Get Centre() As Boolean
   Centre = m_cAV.Centre
End Property
Public Property Let Centre(ByVal bState As Boolean)
   m_cAV.Centre = bState
   PropertyChanged "Centre"
End Property

Public Property Get BackColor() As OLE_COLOR
   BackColor = m_oBackColor
End Property
Public Property Let BackColor(ByVal oColor As OLE_COLOR)
   m_oBackColor = oColor
   m_cAV.BackColor = m_oBackColor
   UserControl.BackColor = m_oBackColor
   PropertyChanged "BackColor"
End Property

Public Property Get Picture() As StdPicture
   Set Picture = m_cAV.Picture
End Property
Public Property Let Picture(sPic As StdPicture)
   pSetPicture sPic
   PropertyChanged "Picture"
End Property
Public Property Set Picture(sPic As StdPicture)
   pSetPicture sPic
   PropertyChanged "Picture"
End Property
Private Sub pSetPicture(sPic As StdPicture)
   Set m_cAV.Picture = sPic
End Sub

Public Property Get hWnd() As Long
   hWnd = m_hWnd
End Property

Private Sub pInitialise()
   m_hWnd = UserControl.hWnd
   Set m_cAV = New cAVICtrl
   m_bRunTime = UserControl.Ambient.UserMode
   If m_bRunTime Then
      m_cAV.Attach m_hWnd
   End If
End Sub
Private Sub pTerminate()
   Set m_cAV = Nothing
End Sub

Private Sub UserControl_Initialize()
   m_eBorder = eavipFixedSingle
   m_eAppearance = eavip3D
End Sub

Private Sub UserControl_InitProperties()
   pInitialise
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
   pInitialise
   BackColor = PropBag.ReadProperty("BackColor", vbButtonFace)
   BorderStyle = PropBag.ReadProperty("BorderStyle", eavipFixedSingle)
   Appearance = PropBag.ReadProperty("Appearance", eavip3D)
   Picture = PropBag.ReadProperty("Picture", Nothing)
   TransparentColor = PropBag.ReadProperty("TransparentColor", &HFFFF00)
   Transparent = PropBag.ReadProperty("Transparent", False)
   Centre = PropBag.ReadProperty("Centre", False)
   FileName = PropBag.ReadProperty("FileName", "")
End Sub

Private Sub UserControl_Resize()
'
End Sub

Private Sub UserControl_Terminate()
   pTerminate
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
   PropBag.WriteProperty "BackColor", m_oBackColor, vbButtonFace
   PropBag.WriteProperty "BorderStyle", BorderStyle, eavipFixedSingle
   PropBag.WriteProperty "Appearance", Appearance, eavip3D
   PropBag.WriteProperty "Picture", Picture, Nothing
   PropBag.WriteProperty "TransparentColor", TransparentColor, &HFFFF00
   PropBag.WriteProperty "Transparent", Transparent, False
   PropBag.WriteProperty "Centre", Centre, False
   PropBag.WriteProperty "FileName", FileName, ""
End Sub