cavictrl.cls

VB6_Transparent_AVI_Player_Full_Source.zip

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cAVICtrl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' ---------------------------------------------------------------------------------------
' cAVICtrl.cls
' Steve McMahon
' vbAccelerator.com
'
' Demonstrates how to play an AVI from first principles.


' // Based on MFC Code written by Jens Schacherl:
' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' ///
' //
' // Copyright (C) 1999 by Jens Schacherl (16.09.1999)
' // All rights reserved.
' //
' // This is free source code and you are allowed to use it even in your
' // billion-dollar-application as long as you leave this copyright notice
' // unchanged.
' //
' // No warranty of any kind, expressed or implied, is included with this
' // software. Any responsibility for damages, loss of money or hair etc. rests
' // entirely with the prospective user.
' // Have fun but use it at your own risk.
' //
' // Mail me your thoughts to:  [e-mail] (preferred) or
' //                      [e-mail]
' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' ///

'#define streamtypeVIDEO         mmioFOURCC('v', 'i', 'd', 's')
'#ifndef MKFOURCC
'#define MKFOURCC( ch0, ch1, ch2, ch3 )                                    \
'      ( (DWORD)(BYTE)(ch0) | ( (DWORD)(BYTE)(ch1) << 8 ) |  \
'      ( (DWORD)(BYTE)(ch2) << 16 ) | ( (DWORD)(BYTE)(ch3) << 24 ) )
'#End If
'
'#if !defined(_INC_MMSYSTEM)
'    #define mmioFOURCC MKFOURCC
'#End If
Private Const streamtypeVIDEO = &H73646976 ' reads "vids"

Private Const RT_AVIVIDEO = "AVI"
Private Const ID_TIMER = 111

Private Const AVC_HALFSPEED = &H1               ' // plays video with half speed
Private Const AVC_DOUBLESPEED = &H2             ' // plays video with double speed

Private Const AVC_CENTERAVI = &H4               ' // centers video inside the window
Private Const AVC_STRETCHAVI = &H8              ' // stretches video to fit inside of the window
Private Const AVC_CENTERRECT = &H10             ' // resizes window, center point stays the same

Private Const AVC_AUTOPLAY = &H20            ' // starts playing automatically after Load()

Private Const AVC_MAPWINDOWCOLOR = &H40         ' // background is COLOR_WINDOW instead of transparent (like CAnimateCtrl's AVS_"TRANSPARENT")
Private Const AVC_FIRSTPIXTRANSPRNT = &H80      ' // ignore clrTransparent parameter and use color of firstframes first pixel for transparency

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
Private Type WINDOWPOS
   hWnd As Long
   hWndInsertAfter As Long
   x As Long
   y As Long
   cx As Long
   cy As Long
   flags As Long
End Type
Private Type BITMAPINFOHEADER
   biSize As Long
   biWidth As Long
   biHeight As Long
   biPlanes As Integer
   biBitCount As Integer
   biCompression As Long
   biSizeImage As Long
   biXPelsPerMeter As Long
   biYPelsPerMeter As Long
   biClrUsed As Long
   biClrImportant As Long
End Type
Private Const OF_READ = &H0
Private Const OF_SHARE_EXCLUSIVE = &H10
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint 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
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function MapWindowPoints Lib "user32" (ByVal hwndFrom As Long, ByVal hwndTo As Long, lppt As Any, ByVal cPoints As Long) As Long
Private Const SWP_FRAMECHANGED = &H20        '  The frame changed: send WM_NCCALCSIZE
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOCOPYBITS = &H100
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
Private Const WM_ERASEBKGND = &H14
Private Const WM_PAINT = &HF
Private Const WM_DESTROY = &H2
Private Const WM_WINDOWPOSCHANGING = &H46
Private Const WM_WININICHANGE = &H1A
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function InvalidateRectAsNull Lib "user32" Alias "InvalidateRect" (ByVal hWnd As Long, lpRect As Any, ByVal bErase As Long) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function RedrawWindow Lib "user32" (ByVal hWnd As Long, lprcUpdate As RECT, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Private Const RDW_ALLCHILDREN = &H80
Private Const RDW_ERASE = &H4
Private Const RDW_ERASENOW = &H200
Private Const RDW_FRAME = &H400
Private Const RDW_INTERNALPAINT = &H2
Private Const RDW_INVALIDATE = &H1
Private Const RDW_NOCHILDREN = &H40
Private Const RDW_NOERASE = &H20
Private Const RDW_NOFRAME = &H800
Private Const RDW_NOINTERNALPAINT = &H10
Private Const RDW_UPDATENOW = &H100
Private Const RDW_VALIDATE = &H8
Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long

Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Type BITMAP '24 bytes
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type


'STDAPI_(void) AVIFileInit(void);   // Call this first!
Private Declare Sub AVIFileInit Lib "avifil32.dll" ()
'STDAPI_(void) AVIFileExit(void);
Private Declare Sub AVIFileExit Lib "avifil32.dll" ()
'STDAPI_(ULONG) AVIStreamAddRef       (PAVISTREAM pavi);
Private Declare Function AVIStreamAddRef Lib "avifil32.dll" (pavi As Any) As Long
'STDAPI_(ULONG) AVIStreamRelease      (PAVISTREAM pavi);
Private Declare Function AVIStreamRelease Lib "avifil32.dll" (pavi As Any) As Long
'STDAPI AVIStreamOpenFromFileA(PAVISTREAM FAR *ppavi, LPCSTR szFile,
'              DWORD fccType, LONG lParam,
'              UINT mode, CLSID FAR *pclsidHandler);
Private Declare Function AVIStreamOpenFromFile Lib "avifil32.dll" Alias "AVIStreamOpenFromFileA" ( _
      ppavi As Any, ByVal szFile As String, _
      ByVal fccType As Long, ByVal lParam As Long, _
      ByVal mode As Long, pclsidHandler As Any _
   ) As Long
'STDAPI_(PGETFRAME) AVIStreamGetFrameOpen(PAVISTREAM pavi,
'                LPBITMAPINFOHEADER lpbiWanted);
Private Declare Function AVIStreamGetFrameOpen Lib "avifil32.dll" ( _
         pavi As Any, lpbiWanted As Any _
      ) As Long
'STDAPI_(LONG) AVIStreamLength       (PAVISTREAM pavi);
Private Declare Function AVIStreamLength Lib "avifil32.dll" (pavi As Any) As Long
'#define     AVIStreamEndTime(pavi) \
'            AVIStreamSampleToTime(pavi, AVIStreamEnd(pavi))
'#define     AVIStreamEnd(pavi) \
'            (AVIStreamStart(pavi) + AVIStreamLength(pavi))
'STDAPI_(LONG) AVIStreamStart        (PAVISTREAM pavi);
Private Declare Function AVIStreamStart Lib "avifil32.dll" (pavi As Any) As Long
'STDAPI_(LONG) AVIStreamSampleToTime (PAVISTREAM pavi, LONG lSample);
Private Declare Function AVIStreamSampleToTime Lib "avifil32.dll" (pavi As Any, ByVal lSample As Long) As Long
'STDAPI AVIStreamGetFrameClose(PGETFRAME pg);
Private Declare Function AVIStreamGetFrameClose Lib "avifil32.dll" (pg As Any) As Long
'STDAPI_(LPVOID) AVIStreamGetFrame(PGETFRAME pg, LONG lPos);
Private Declare Function AVIStreamGetFrame Lib "avifil32.dll" (pg As Any, ByVal lPos As Long) As Long


Private Type TAVISTREAMINFO ' this is the ANSI version
    fccType As Long
    fccHandler As Long
    dwFlags As Long         '/* Contains AVITF_* flags */
    dwCaps As Long
    wPriority As Integer
    wLanguage As Integer
    dwScale As Long
    dwRate As Long ' /* dwRate / dwScale == samples/second */
    dwStart As Long
    dwLength As Long '; /* In units above... */
    dwInitialFrames As Long
    dwSuggestedBufferSize As Long
    dwQuality As Long
    dwSampleSize As Long
    rcFrame As RECT
    dwEditCount As Long
    dwFormatChangeCount As Long
    szName(0 To 63) As Byte
End Type
'STDAPI AVIStreamInfoA (PAVISTREAM pavi, LPAVISTREAMINFOA psi, LONG lSize);
Private Declare Sub AVIStreamInfo Lib "avifil32.dll" Alias "AVIStreamInfoA" (pavi As Any, psi As TAVISTREAMINFO, ByVal lSize As Long)

' DrawDIB functions:
'extern HDRAWDIB VFWAPI DrawDibOpen(void);
Private Declare Function DrawDibOpen Lib "msvfw32.dll" () As Long
'extern BOOL VFWAPI DrawDibClose(HDRAWDIB hdd);
Private Declare Function DrawDibClose Lib "msvfw32.dll" (ByVal hDD As Long) As Long
'extern BOOL VFWAPI DrawDibDraw(HDRAWDIB hdd,
'                                   HDC      hdc,
'                                   int      xDst,
'                                   int      yDst,
'                                   int      dxDst,
'                                   int      dyDst,
'                                   LPBITMAPINFOHEADER lpbi,
'                                   LPVOID   lpBits,
'                                   int      xSrc,
'                                   int      ySrc,
'                                   int      dxSrc,
'                                   int      dySrc,
'                                   UINT     wFlags);
Private Declare Function DrawDibDraw Lib "msvfw32.dll" (ByVal hDD As Long, ByVal hdc As Long, _
      ByVal xDst As Long, ByVal yDst As Long, ByVal dxDst As Long, ByVal dyDst As Long, _
      lpBI As Any, lpBits As Any, _
      ByVal xSrc As Long, ByVal ySrc As Long, ByVal dxSrc As Long, ByVal dySrc As Long, _
      ByVal wFlags As Long) As Long
      

Private m_hWnd As Long
Private m_sFileName As String
Private m_dwFlags As Long
Private m_bTransparent As Boolean
Private m_bCentre As Boolean
Private m_csTempFile As String
Private m_nRealWidth As Long
Private m_nRealHeight As Long
Private m_nAVIOffsetY As Long
Private m_nAVIOffsetX As Long
Private m_bOnce As Boolean
Private m_bInitBkg As Boolean
Private m_hDrawDib As Long
Private m_nTimerTime As Long
Private m_lFrames As Long
Private m_nCurrentFrame As Long
Private m_bPlaying As Boolean

Private m_oTransColor As OLE_COLOR
Private m_oBackColor As OLE_COLOR

' MemDC for drawing background to AVI:
Private m_cDCBack As pcMemDC
Private m_tR As RECT

' MemDC for holding picture:
Private m_cDCPicture As pcMemDC
Private m_pic As StdPicture

Private m_pGF As Long ' PGETFRAME
Private m_pAS As Long ' PAVISTREAM

Private WithEvents m_cTimer As CTimer
Attribute m_cTimer.VB_VarHelpID = -1

Implements ISubclass

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_bInitBkg = True
End Property

Public Property Get Picture() As StdPicture
   Set Picture = m_pic
End Property
Public Property Let Picture(sPic As StdPicture)
   pSetPicture sPic
End Property
Public Property Set Picture(sPic As StdPicture)
   pSetPicture sPic
End Property
Private Sub pSetPicture(sPic As StdPicture)
   If Not sPic Is Nothing Then
      Set m_cDCPicture = New pcMemDC
      m_cDCPicture.CreateFromPicture sPic
   Else
      Set m_cDCPicture = Nothing
   End If
   Set m_pic = sPic
   m_bInitBkg = True
   Invalidate
End Sub
Public Property Get TransparentColor() As OLE_COLOR
   TransparentColor = m_oTransColor
End Property
Public Property Let TransparentColor(ByVal oColor As OLE_COLOR)
   m_oTransColor = oColor
   Invalidate
End Property

Public Property Get Transparent() As Boolean
   Transparent = m_bTransparent
End Property
Public Property Let Transparent(ByVal bState As Boolean)
   m_bTransparent = bState
   m_bInitBkg = True
   Invalidate
End Property
Public Property Get Centre() As Boolean
   Centre = m_bCentre
End Property
Public Property Let Centre(ByVal bState As Boolean)
   m_bCentre = bState
   m_bInitBkg = True
   Invalidate
End Property
      
Private Function AVIStreamEndTime() As Long
Dim lSample As Long
   lSample = AVIStreamStart(ByVal m_pAS) + AVIStreamLength(ByVal m_pAS)
   AVIStreamEndTime = AVIStreamSampleToTime(ByVal m_pAS, lSample)
End Function

Public Sub Attach(ByVal hWndA As Long)
   ' Ensure not already in use:
   Detach
   
   ' Store hWnd:
   m_hWnd = hWndA
   
   ' Attach the messages:
   AttachMessage Me, m_hWnd, WM_PAINT
   AttachMessage Me, m_hWnd, WM_ERASEBKGND
   AttachMessage Me, m_hWnd, WM_WINDOWPOSCHANGING
   AttachMessage Me, m_hWnd, WM_WININICHANGE
   AttachMessage Me, m_hWnd, WM_DESTROY
   
End Sub
Public Sub Detach()
   If Not m_hWnd = 0 Then
      ' Stop & Clear up:
      CtrlDestroy
      
      ' Detach messages:
      DetachMessage Me, m_hWnd, WM_PAINT
      DetachMessage Me, m_hWnd, WM_ERASEBKGND
      DetachMessage Me, m_hWnd, WM_WINDOWPOSCHANGING
      DetachMessage Me, m_hWnd, WM_WININICHANGE
      DetachMessage Me, m_hWnd, WM_DESTROY
      
      ' Clear hWnd:
      m_hWnd = 0
   End If
End Sub

Public Sub Test(ByVal nF As Long)
Dim lpBI As Long
Dim rcClip As RECT
Dim lHDC As Long
Dim lR As Long

   'GetClientRect m_hWnd, rcClip

   'lpBI = AVIStreamGetFrame(ByVal m_pGF, nF)
   'Debug.Assert (lpBI <> 0)

   lHDC = GetDC(m_hWnd)
   'lR = DrawDibDraw(m_hDrawDib, lhDC, rcClip.Left + m_nAVIOffsetX, rcClip.Top + m_nAVIOffsetY, _
   '            m_nRealWidth, m_nRealHeight, ByVal lpBI, ByVal 0&, _
   '            0, 0, -1, -1, 0)
   
   m_nCurrentFrame = nF
   DrawCurrentFrame lHDC
   
   ReleaseDC m_hWnd, lHDC

End Sub

Private Sub Invalidate()
Dim tR As RECT
   If IsWindow(m_hWnd) Then
      'InvalidateRectAsNull m_hWnd, ByVal 0&, 1
      'UpdateWindow m_hWnd
      OnPaint
   End If
End Sub

Private Sub Class_Initialize()
   
   m_bTransparent = True
   
   ' // initialize members
   CtrlInit

   ' // open avi library
   AVIFileInit

   ' // open draw lib
   m_hDrawDib = DrawDibOpen()
   Debug.Assert (m_hDrawDib <> 0)     ' Trouble!

End Sub

Private Sub Class_Terminate()
   Detach
   
   ' // close drawing library
   If Not (m_hDrawDib = 0) Then
      DrawDibClose m_hDrawDib
      m_hDrawDib = 0
   End If
   
   ' No more bitmap
   Set m_cDCBack = Nothing
   Set m_cDCPicture = Nothing

   ' // close avi library