cavictrl.cls

VB6_Transparent_AVI_Player_Full_Source.zip

   AVIFileExit

End Sub


'BEGIN_MESSAGE_MAP(CAVICtrl, CWnd)
'   ' //{{AFX_MSG_MAP(CAVICtrl)
'   ON_WM_WINDOWPOSCHANGING()
'   ON_WM_PAINT()
'   ON_WM_ERASEBKGND()
'   ON_WM_SYSCOLORCHANGE()
'   ON_WM_DESTROY()
'   ' //}}AFX_MSG_MAP
'END_MESSAGE_MAP()


' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' //' ///
' // CAVICtrl public members
'Private function LoadFromResource(ByVal nIDResource As Long, ByVal dwFlags As Long, ByVal clrTransparent As Long) as boolean
'Dim hRes As Long
'Dim hMem As Long
'Dim dwSizeRes As Long
'Dim lpData As Long
'
'   ' // pls subclass *before* loading
'   If Not (IsWindow(m_hWnd) = 0) Then
'      LoadFromResource = False
'   Else
'
'      If (m_pAS) Then
'         ' // control has been used before: reinitialize everything
'         CtrlDestroy
'         CtrlInit
'      End If
'
'      ' // find & load our avi resource
'      hRes = FindResource(hInstance, nIDResource, RT_AVIVIDEO)
'      If (hRes = 0) Then
'         lErr = Err.LastDllError
'         Debug.Print "FindRes error=" & lErr
'         LoadFromResource = False
'      Else
'
'         hMem = LoadResource(AfxGetResourceHandle(), hRes);
'   _ASSERTE(hMem);
'   dwSizeRes = ::SizeofResource(AfxGetResourceHandle(), hRes);
'   _ASSERTE(dwSizeRes > 0L);
'
'   lpData = ::LockResource(hMem);
'   _ASSERTE(lpData);
'
'   ' // create temp file
'   _ASSERTE(m_csTempFile.IsEmpty());
'
'   ' //VERIFY(GetTempPath(_MAX_PATH, szTempDir));
'   ' //VERIFY(GetTempFileName(szTempDir, _T("AVC"), 0, m_csTempFile.GetBuffer(_MAX_PATH)));
'   ' //m_csTempFile.ReleaseBuffer();
'   m_csTempFile = GetTempAVIFileName();
'   _ASSERTE(!m_csTempFile.IsEmpty());
'
'   ' // for NT it's ok, but stupid Win98 cannot open the file if the extension is not AVI
'   /*CString sNewName(m_csTempFile);
'   sNewName.Replace(".TMP", ".AVI");
'   _trename(m_csTempFile, sNewName);
'   m_csTempFile = sNewName;*/
'
'   ' // open temp file and write avi data to it
'   CFile tmpFile;
'
'   if (!tmpFile.Open(m_csTempFile, CFile::modeCreate | CFile::modeWrite | CFile::shareDenyWrite))
'   {
'      TRACE("Failed opening temp file\n");
'      return E_FAIL;
'   }
'
'   TRY
'   {
'      tmpFile.Write(lpData, dwSizeRes);
'   }
'   CATCH(CFileException, e)
'   {
'      TRACE("Failed writing temp file: %d\n", e->m_cause);
'      tmpFile.Close();
'
'      return E_FAIL;
'   }
'   END_CATCH
'
'   tmpFile.Close();
'
'   ' // OLH to Unlock-/FreeResource says that they are obsolete, but most of the
'   ' // Win32 samples still use them...so what?
'   ' // Anyway they are redefined as dummies in AFXV_W32.H so it makes no sense calling them.
'   ' //::UnlockResource(hMem);
'   ' //::FreeResource(hMem);
'
'   return Load(m_csTempFile, dwFlags, clrTransparent);
'}
'End Sub

Public Property Get FileName() As String
   FileName = m_sFileName
End Property
Public Property Let FileName(ByVal sFileName As String)
   m_sFileName = sFileName
End Property

Public Function Load() As Boolean
   
   ' // pls subclass *before* loading
   If (IsWindow(m_hWnd) = 0) Then
      Load = False
      
   Else
   
      If Not (m_pAS = 0) Then
         ' // control has been used before: reinitialize everything
         CtrlDestroy
         CtrlInit
      End If

      Dim hr As Long ' HResult

      ' // open AVI
      hr = AVIStreamOpenFromFile(m_pAS, m_sFileName, streamtypeVIDEO, _
                         0, OF_READ Or OF_SHARE_EXCLUSIVE, ByVal 0&)
      If FAILED(hr) Then
         Debug.Assert False
         m_pAS = 0
      Else

         ' //set flags and color
         'm_dwFlags = dwFlags
         'm_clrTransp = m_clrTransparent

         ' // open frames
         Debug.Assert (m_pAS <> 0)
         m_pGF = AVIStreamGetFrameOpen(ByVal m_pAS, ByVal 0&)
         Debug.Assert (m_pGF <> 0)
         
         ' // get number of frames
         m_lFrames = AVIStreamLength(ByVal m_pAS)
         Debug.Assert (m_lFrames > 0)

         ' // calculate timer delay
         Dim lLTime As Long
         lLTime = AVIStreamEndTime()
         Debug.Assert (lLTime > 0)
         m_nTimerTime = (lLTime / m_lFrames)
   
         ' // get size of control
         Dim rcCtrl As RECT
         GetClientRect m_hWnd, rcCtrl

         ' // get size of avi
         Dim si As TAVISTREAMINFO
         AVIStreamInfo ByVal m_pAS, si, Len(si)

         ' // precalculate some often needed values in case we need them later
         Dim nOfsX As Long, nOfsY As Long
         Dim nWidth As Long, nHeight As Long
         
         nWidth = si.rcFrame.Right - si.rcFrame.Left
         nHeight = si.rcFrame.Bottom - si.rcFrame.Top
         If (m_dwFlags And AVC_CENTERAVI) = AVC_CENTERAVI Then
            m_nAVIOffsetX = nOfsX
            m_nAVIOffsetY = nOfsY

            ' //special case: different size of ctrl and avi
            m_nRealWidth = nWidth
            m_nRealHeight = nHeight

         ElseIf (Not (m_dwFlags And AVC_STRETCHAVI) = AVC_STRETCHAVI) Then
            Dim rcW As RECT, hWNdP As Long
            
            'GetWindowRect m_hWnd, rcW
            'hWNdP = GetParent(m_hWnd)
            'MapWindowPoints 0, hWNdP, rcW, 2
            'MoveWindow m_hWnd, rcW.Left, rcW.Top, nWidth, nHeight, 1
            'Invalidate

            m_nRealWidth = nWidth
            m_nRealHeight = nHeight

'            If (m_dwFlags And AVC_CENTERRECT) = AVC_CENTERRECT Then
'               ' // calculate ctrl postion relative to parent and move it
'               GetWindowRect
'               CRect rcWnd;
'               GetWindowRect(&rcWnd);
'
'               CWnd* pParent = GetParent();
'               _ASSERTE(pParent);
'               if (pParent)
'               {
'                  pParent->ScreenToClient(&rcWnd);
'                  rcWnd.OffsetRect(nOfsX, nOfsY);
'                  MoveWindow(rcWnd, FALSE);
'               }
'            End If
         End If
'
'
'         ' // not transparent
'         if (m_dwFlags & AVC_MAPWINDOWCOLOR)
'         {
'            CClientDC dcCtrl(this);
'
'            m_dcBkg.CreateCompatibleDC(&dcCtrl);
'            m_bmpBkg.CreateCompatibleBitmap(&dcCtrl, rcCtrl.Width(), rcCtrl.Height());
'            m_pbmpBkgOld = m_dcBkg.SelectObject(&m_bmpBkg);
'            m_dcBkg.FillSolidRect(&rcCtrl, ::GetSysColor(COLOR_WINDOW));
'         }
'         else if (m_dwFlags & AVC_FIRSTPIXTRANSPRNT)
'         {
'            m_clrTransp = GetFirstPixelColor();
'         }
'
'         ' // autoplay?
'         if (m_dwFlags & AVC_AUTOPLAY)
'         {
'            VERIFY(Play());
'         }
'
'         return hr;
         Load = True
      End If
   End If
           
End Function
Public Property Get Width() As Long
   Width = m_nRealWidth
End Property
Public Property Get Height() As Long
   Height = m_nRealHeight
End Property

Public Function AVIPlay(Optional ByVal bOnce As Boolean = False) As Boolean
Dim lTime As Long

   If Not (m_pAS = 0) Then
      ' // set flag
      m_bOnce = bOnce

      If (m_bPlaying) Then
         ' // reset frame to first and exit
         m_nCurrentFrame = 0
         
      End If

      ' // draw current (first) frame
      Invalidate

      ' // set timer
      If m_cTimer Is Nothing Then
         Set m_cTimer = New CTimer
      End If
      
      lTime = m_nTimerTime
      If (m_dwFlags And AVC_HALFSPEED) = AVC_HALFSPEED Then
         lTime = m_nTimerTime * 2
      ElseIf (m_dwFlags And AVC_DOUBLESPEED) = AVC_DOUBLESPEED Then
         lTime = m_nTimerTime / 2
      End If
      
      m_cTimer.Interval = lTime

      ' // flags
      m_bPlaying = True

      AVIPlay = True
   End If
   
End Function
Public Property Get FrameTime() As Long
   FrameTime = m_nTimerTime
End Property
Public Property Let FrameTime(ByVal lTime As Long)
   If lTime > 0 Then
      m_nTimerTime = lTime
      If m_bPlaying Then
         m_cTimer.Interval = lTime
      End If
   End If
End Property
Public Property Get IsPlaying() As Boolean
   IsPlaying = m_bPlaying
End Property
Public Property Get IsLoaded() As Boolean
   IsLoaded = Not ((m_pAS = 0) Or (m_pGF = 0))
End Property

Public Function AVIStop(Optional ByVal bResetToFirst As Boolean = False) As Boolean

   ' // reset even if not playing
   If (bResetToFirst) Then
      m_nCurrentFrame = 0
      Invalidate
   End If

   If Not (m_bPlaying) Then
      AVIStop = True
   End If

   ' // stop playing
   m_cTimer.Interval = 0

   m_bPlaying = False

   AVIStop = True

   
End Function


Public Function AVISeek(ByVal nTo As Long) As Boolean
   If nTo <= m_lFrames Then
      If (m_bPlaying) Then
         AVIStop False
      End If
   
      m_nCurrentFrame = Max(nTo, m_lFrames)
      Invalidate
   End If
End Function

Public Property Get FrameCount() As Long
   If m_pAS Then
      FrameCount = AVIStreamLength(ByVal m_pAS)
   End If
End Property

Public Property Get CurrentFrame() As Long
   CurrentFrame = m_nCurrentFrame
End Property


Private Function OnPaint() As Long
Dim lHDC As Long
   If (m_pAS) Then
      lHDC = GetDC(m_hWnd)
      DrawCurrentFrame lHDC
      ReleaseDC m_hWnd, lHDC
   End If
End Function


Private Function OnEraseBkgnd() As Long
   ' // if needed, get new background
   If (m_bInitBkg) Then
   
      m_bInitBkg = False
      InitBackground
   End If

   ' // do nothing else here
   ' // it would cause too much flicker if we'd restore the background here
   OnEraseBkgnd = 1

End Function


Private Function OnWindowPosChanging(lpwndpos As WINDOWPOS) As Long
   If (lpwndpos.flags And (SWP_HIDEWINDOW Or SWP_SHOWWINDOW)) = 0 Then
      m_bInitBkg = True
   End If
End Function

Private Sub OnSysColorChange()
Dim lHDC As Long
'
'   if (m_dcBkg.m_hDC && (m_dwFlags & AVC_MAPWINDOWCOLOR))
'   {
'      CRect rcCtrl;
'
'      GetClientRect(&rcCtrl);
'      m_dcBkg.FillSolidRect(&rcCtrl, ::GetSysColor(COLOR_WINDOW));
'   }
'}
   If Not m_hWnd = 0 Then
      '
   End If
End Sub

Private Sub OnDestroy()
   Detach
End Sub

Private Sub pDrawBackground()
   ' If we have picture, tile or stretch into
   ' background as required, else set the
   ' background colour:
   If Not (m_cDCPicture Is Nothing) Then
   '   ' Stretch or tile
      TileArea m_cDCBack.hdc, 0, 0, m_tR.Right - m_tR.Left, m_tR.Bottom - m_tR.Top, m_cDCPicture.hdc, m_cDCPicture.Width, m_cDCPicture.Height, 0, 0
   Else
      Dim hBr As Long
      hBr = CreateSolidBrush(TranslateColor(m_oBackColor))
      FillRect m_cDCBack.hdc, m_tR, hBr
      DeleteObject hBr
   End If
   
End Sub
Private Sub TileArea( _
        ByVal hdc As Long, _
        ByVal x As Long, _
        ByVal y As Long, _
        ByVal Width As Long, _
        ByVal Height As Long, _
        ByVal lSrcDC As Long, _
        ByVal lBitmapW As Long, _
        ByVal lBitmapH As Long, _
        ByVal lSrcOffsetX As Long, _
        ByVal lSrcOffsetY As Long _
    )
Dim lSrcX As Long
Dim lSrcY As Long
Dim lSrcStartX As Long
Dim lSrcStartY As Long
Dim lSrcStartWidth As Long
Dim lSrcStartHeight As Long
Dim lDstX As Long
Dim lDstY As Long
Dim lDstWidth As Long
Dim lDstHeight As Long

    lSrcStartX = ((x + lSrcOffsetX) Mod lBitmapW)
    lSrcStartY = ((y + lSrcOffsetY) Mod lBitmapH)
    lSrcStartWidth = (lBitmapW - lSrcStartX)
    lSrcStartHeight = (lBitmapH - lSrcStartY)
    lSrcX = lSrcStartX
    lSrcY = lSrcStartY
    
    lDstY = y
    lDstHeight = lSrcStartHeight
    
    Do While lDstY < (y + Height)
        If (lDstY + lDstHeight) > (y + Height) Then
            lDstHeight = y + Height - lDstY
        End If