|
說明
這是個網友問的問題,因為要做個檔案複製方塊,需要再視窗上放檔案搬移的AVI,但使用MCI播放卻會出現底色的部分 無法做到通透 如下圖
透過Animate物件 ,我們就可以播放出整個通透的影像
程式
Option Explicit
Private Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function mciGetErrorString Lib "winmm" Alias _
"mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _
ByVal uLength As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias _
"GetShortPathNameA" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As
Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA"
(ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal
hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(Destination As Any, Source As Any, ByVal Length As Long)
Private Type tagInitCommonControlsEx
lngSize As Long
lngICC As Long
End Type
Private Declare Function InitCommonControlsEx Lib "Comctl32.dll" _
(iccex As tagInitCommonControlsEx) As Boolean
Private Const ICC_ANIMATE_CLASS = &H80
Private Const ANIMATE_CLASS = "SysAnimate32"
Private Const WM_USER = &H400&
Private Const ACS_CENTER = &H1&
Private Const ACS_TRANSPARENT = &H2&
Private Const ACS_AUTOPLAY = &H4&
Private Const ACM_OPEN = WM_USER + 100
Private Const ACM_PLAY = WM_USER + 101
Private Const WS_EX_TRANSPARENT = &H20&
Private AnimateHwnd As Long
Private StaticWin As Long
Private Const WS_CHILD = &H40000000
Private Sub Command1_Click()
PlayAviFileAt App.Path & "\FILECOPY.AVI", Me.hwnd, 100, 55, 270, 40
End Sub
Public Sub PlayAviFileAt(ByVal sFileName As String, lhWnd As Long, lx As Long,
ly As Long, lw As Long, lh As Long)
Dim FileName As String, ret As Long
ret = GetShortPathName(sFileName, 0, 0)
FileName = String(ret - 1, Chr(0))
ret = GetShortPathName(sFileName, FileName, ret)
Debug.Print Asc(Mid(FileName, Len(FileName) - 1, 1))
Debug.Print Asc("I")
mciSendString "open " & FileName & " type AVIVideo alias mAVI parent " &
CStr(hwnd) & " style " & CStr(WS_CHILD), vbNullString, 0, 0
mciSendString "put mAVI window at " & CStr(lx) & " " & CStr(ly) & " " & CStr(lw)
& " " & CStr(lh), vbNullString, 0, 0
mciSendString "play mAVI wait", vbNullString, 0, 0
mciSendString "close mAVI", vbNullString, 0, 0
End Sub
Public Sub PlayTransAviFileAt(ByVal sFileName As String, lhWnd As Long, lx As Long, ly As Long, lw As Long, lh As Long)
Dim iccex As tagInitCommonControlsEx
With iccex
.lngSize = LenB(iccex)
.lngICC = ICC_ANIMATE_CLASS
End With
Call InitCommonControlsEx(iccex)
StaticWin = CreateWindowEx(WS_EX_TRANSPARENT, ANIMATE_CLASS, "",
&H50000007, lx, ly, lw, lh, lhWnd, 0&, App.hInstance, ByVal 0&)
AnimateHwnd = CreateWindowEx(WS_EX_TRANSPARENT, ANIMATE_CLASS,
"", &H50000007, lx, ly, lw + lx, lh + ly, StaticWin, 0&, App.hInstance, ByVal 0&)
SendMessage AnimateHwnd, ACM_OPEN Or ACS_AUTOPLAY, 0&, ByVal sFileName
SendMessage AnimateHwnd, ACM_PLAY, -1, 0
End Sub
Private Sub Command2_Click()
PlayTransAviFileAt App.Path & "\FILECOPY.AVI", Me.hwnd, 20, 10, 360, 100
End Sub
範例程式下載
整理時間
|
