AVIファイルの再生(Ⅱ) <TOP>
AVIファイルを再生(Ⅰ)と同じですが、透過処理でフォームをCTV風にしてみました。
AVIFileOpen
AVIファイルオープン
AVIFileReleaseAVIファイルハンドル解放
AVIFileInfo
AVIファイル情報取得
AVIFileInit
AVIファイル初期化
AVIFileExit
AVIファイルライブラリ解放
mciSendString
文字列をMCIに送信
mciGetErrorString
MCIエラーコードを記述する文字列を取得
GetShortPathName
ファイルの短い形式のパス名を取得
GetCursorPos
マウスポインタのスクリーン座標を取得
SetWindowPos
ウィンドウのサイズ、位置、およびZオーダーを設定
GetWindowRect
ウィンドウの座標をスクリーン座標系で取得
SetCapture
指定のウィンドウにマウスキャプチャを設定
ReleaseCapture
マウスのキャプチャを解放
SetWindowLong
指定されたウィンドウの属性を変更
GetWindowLong
指定されたウィンドウの情報を取得
SetLayeredWindowAttributes
レイヤードウィンドウの不透明および透明のカラーキーを設定
Picture1のサイズ（391x218）より大きなAVIファイルは、その比率を維持し縮小、小さなAVIファイルは、実サイズで再生します。
図のBMPファイルをフォームに貼り付け、スタンド部の背景色RGB(0, 128, 128)をキーとして透明にしています。
「…」でファイルのオープンダイアログを開く、またはAVIファイルをフォーム上にドラッグ＆ドロップしてください。
「終了」は、フォームをダブルクリックします。
参照
'================================================================ '= AVIファイルの再生(Ⅱ)
'= (mciSendString3.bas) '================================================================ #include "Windows.bi" Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Type POINTAPI x As Long y As Long End Type Type AVIFILEINFO dwMaxBytesPerSec As Long 'ファイルのデータレートのほぼ最大値 dwFlags As Long '拡張可能なフラグ dwCaps As Long '適応フラグ dwStreams As Long 'ファイル中のストリーム数 dwSuggestedBufferSize As Long '読み込み時に必要となる予想されるバッファサイズ(バイト) dwWidth As Long 'AVIファイル中の幅(ピクセル) dwHeight As Long 'AVIファイル中の高さ(ピクセル) dwScale As Long '全ファイルに適応できるタイムスケール dwRate As Long '(dwRate÷dwScale)は秒間サンプル数 dwLength As Long 'AVIファイルサイズ。単位は(dwRate÷dwScale) dwEditCount As Long 'AVIファイルに追加、またはAVIファイルから削除されたストリームの数 szFileType As String * 64 'ファイルタイプ情報の記述を含む、Nullで終わる文字列 End Type ' AVIファイルオープン Declare Function Api_AVIFileOpen& Lib "avifil32" Alias "AVIFileOpenA" (ppFile&, ByVal szFile$, ByVal Mode&, pclsidHandler As Any) ' AVIファイルハンドル解放 Declare Function Api_AVIFileRelease& Lib "avifil32" Alias "AVIFileRelease" (ByVal pFile&) ' AVIファイル情報取得 Declare Function Api_AVIFileInfo& Lib "avifil32" Alias "AVIFileInfoA" (ByVal pFile&, pfi As AVIFILEINFO, ByVal lSize&) ' AVIファイル初期化 Declare Sub Api_AVIFileInit Lib "avifil32" Alias "AVIFileInit" () ' AVIファイルライブラリ解放 Declare Sub Api_AVIFileExit Lib "avifil32" Alias "AVIFileExit" () ' 文字列を MCI に送信 Declare Function Api_mciSendString& Lib "winmm" Alias "mciSendStringA" (ByVal lpstrCommand$, ByVal lpstrReturnString As Any, ByVal uReturnLength&, ByVal hwndCallback&) ' MCIエラーコードを記述する文字列を取得 Declare Function Api_mciGetErrorString& Lib "winmm" Alias "mciGetErrorStringA" (ByVal dwError&, ByVal lpstrBuffer$, ByVal uLength&) ' ファイルの短い形式のパス名を取得 Declare Function Api_GetShortPathName& Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath$, ByVal lpszShortPath$, ByVal lBuffer&) ' マウスカーソル(マウスポインタ)の現在の位置に相当するスクリーン座標を取得 Declare Function Api_GetCursorPos& Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) ' ウィンドウのサイズ、位置、および Z オーダーを設定 Declare Function Api_SetWindowPos& Lib "user32" Alias "SetWindowPos" (ByVal hWnd&, ByVal hWndInsertAfter&, ByVal X&, ByVal Y&, ByVal CX&, ByVal CY&, ByVal uFlags&) ' ウィンドウの座標をスクリーン座標系で取得 Declare Function Api_GetWindowRect& Lib "user32" Alias "GetWindowRect" (ByVal hWnd&, lpRect As RECT) ' 指定のウィンドウにマウスキャプチャを設定 Declare Function Api_SetCapture& Lib "user32" Alias "SetCapture" (ByVal hWnd&) ' マウスのキャプチャを解放 Declare Function Api_ReleaseCapture& Lib "user32" Alias "ReleaseCapture" () ' 指定されたウィンドウの属性を変更。また、拡張ウィンドウメモリの指定されたオフセットの32ビット値を書き換えることができる Declare Function Api_SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&) ' 指定されたウィンドウに関しての情報を取得。また、拡張ウィンドウメモリから、指定されたオフセットにある32ビット値を取得することもできる Declare Function Api_GetWindowLong& Lib "user32" Alias "GetWindowLongA" (ByVal hWnd&, ByVal nIndex&) ' レイヤード ウィンドウの不透明および透明のカラーキーを設定 Declare Function Api_SetLayeredWindowAttributes& Lib "user32" Alias "SetLayeredWindowAttributes" (ByVal hWnd&, ByVal crKey&, ByVal bAlpha&, ByVal dwFlags&) #define WS_CHILD &H40000000 '親ウインドウを持つコントロール(子ウインドウ)を作成する #define PS_SOLID 0 #define RGN_AND 1 'リージョン同士のAND結合 #define RGN_COPY 5 'HRGNSRC1のコピーを作成 #define RGN_DIFF 4 'HRGNSRC1からHRGNSRC2を除いた領域 #define RGN_OR 2 'リージョン同士のOR結合 #define RGN_XOR 3 'リージョン同士のXOR結合 #define WS_EX_LAYERED &H80000 '透明なウィンドウ属性(Windows2000以上) #define LWA_COLORKEY 1 'crKeyを透明色として使う(dwFlagsの定数) #define LWA_ALPHA 2 'bAlphaをアルファー値として使う #define GWL_EXSTYLE -20 '拡張ウィンドウスタイル #define OF_SHARE_DENY_WRITE &H20 '他のプロセスから書き込み可能 #define HWND_BOTTOM 1 'ウィンドウを最背面に配置 #define HWND_NOTOPMOST (-2) 'ウィンドウを常に最前面に配置(他のウィンドウがHWND_TOPMOSTに配置されている場合はその配下) #define HWND_TOP 0 'ウィンドウを最前面に配置 #define HWND_TOPMOST (-1) 'ウィンドウを常に最前面に配置 #define SWP_SHOWWINDOW &H40 'ウインドウを表示する #define SWP_NOZORDER &H4 'ウィンドウリスト内での現在位置を保持する #define SWP_NOSIZE &H1 'ウィンドウの現在のサイズを保持する #define SWP_NOMOVE &H2 'ウインドウの現在位置を保持する Var Shared Button1 As Object Var Shared Button2 As Object Var Shared Picture1 As Object Var Shared Bitmap As Object BitmapObject Bitmap Button1.Attach GetDlgItem("Button1") : button1.SetFontSize 9 Button2.Attach GetDlgItem("Button2") : button2.SetFontSize 9 Picture1.Attach GetDlgItem("Picture1") Var Shared FileName As String Var Shared StartCursor As POINTAPI Var Shared StartPos As RECT Var Shared Capture As Integer Var Shared aviWidth As Integer Var Shared aviHeight As Integer '================================================================ '= '================================================================ Declare Sub MainForm_Start edecl () Sub MainForm_Start() Var dwStyle As Long Var Ret As Long Bitmap.LoadFile "CTV.bmp" DrawBitmap Bitmap, 0, 0 Bitmap.DeleteObject Picture1.SetFontName "ＭＳ ゴシック" dwStyle = Api_GetWindowLong(GethWnd, GWL_EXSTYLE) dwStyle = dwStyle Or WS_EX_LAYERED Ret = Api_SetWindowLong(GethWnd, GWL_EXSTYLE, dwStyle) Ret = Api_SetLayeredWindowAttributes(GethWnd, RGB(0, 128, 128), 0, LWA_COLORKEY) Ret = Api_SetWindowPos(GethWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE) ShowWindow -1 End Sub '================================================================ '= '================================================================ Declare Sub PathAndSizeSet() Sub PathAndSizeSet() Var hFile As Long Var AviInfo As AVIFILEINFO Var newPicWidth As Integer Var newPicHeight As Integer Var hOffset As Integer Var vOffset As Integer Var Ret As Long Picture1.MoveWindow 26, 28 Picture1.SetWindowSize 391, 218 Picture1.Cls 'AVIファイル初期化 Api_AVIFileInit 'AVIファイルハンドル取得 Ret = Api_AVIFileOpen(hFile, FileName, OF_SHARE_DENY_WRITE, ByVal 0) Ret = Api_AVIFileInfo(hFile, AviInfo, Len(AviInfo)) aviWidth = AviInfo.dwWidth aviHeight = AviInfo.dwHeight 'AVIサイズを縮小 If aviWidth > Picture1.GetWidth Or aviHeight > Picture1.GetHeight Then '10:9より比率が大の場合 If aviHeight / aviWidth > 0.56 Then newPicWidth = Picture1.GetHeight / aviHeight * aviWidth hOffset = (Picture1.GetWidth - newPicWidth) / 2 Picture1.MoveWindow 26 + hOffset, 28 Picture1.SetWindowSize newPicWidth, 218 '10:9より比率が小の場合 Else newPicHeight = Picture1.GetWidth / aviWidth * aviHeight vOffset = (Picture1.GetHeight - newPicHeight) / 2 Picture1.MoveWindow 26, 28 + vOffset Picture1.SetWindowSize 391, newPicHeight End If 'AVIサイズをそのまま Else hOffset = (391 - aviWidth) / 2 vOffset = (218 - aviHeight) / 2 Picture1.MoveWindow 26 + hOffset, 28 + vOffset Picture1.SetWindowSize aviWidth, aviHeight End If 'AVIファイル名 Picture1.Print "Path:" & FileName 'AVIサイズ Picture1.Print "Size:" & Trim$(Str$(aviWidth)) & "x" & Trim$(Str$(aviHeight)) Picture1.Print "Ofst:" & Trim$(Str$(hOffset)) & "x" & Trim$(Str$(vOffset)) End Sub '================================================================ '= '================================================================ Declare Sub Button1_on edecl () Sub Button1_on() FileName = WinOpenDlg("ファイルのオープン","C:\*.avi","AVIファイル(*.avi)", 0) If FileName <> Chr$(&H1B) Then PathAndSizeSet End If End Sub '================================================================ '= '================================================================ Declare Sub Button2_on edecl () Sub Button2_on() Var CommandString As String Var ShortFileName As String * 260 Var deviceIsOpen As Integer Var Ret As Long Ret = Api_GetShortPathName(FileName, ShortFileName, Len(ShortFileName)) FileName = Left$(ShortFileName, Ret) Ret = Api_mciSendString("Close All", ByVal 0, 0, 0) 'デバイスオープン Ret = Api_mciSendString("Open " & FileName & " Type AVIVideo Alias Video Parent " & Str$(Picture1.GethWnd) & " Style " & Str$(WS_CHILD), ByVal 0, 0, 0) If Ret Then Goto *Err_Trap deviceIsOpen = True 'ピクチャボックスサイズに合わせる Ret = Api_mciSendString("Put Video Window at 0 0 " & Str$(Picture1.GetWidth ) & " " & Str$(Picture1.GetHeight), ByVal 0, 0, 0) If Ret <> 0 Then Goto *Err_Trap 'ファイル再生 Ret = Api_mciSendString("Play Video Wait", ByVal 0, 0, 0) If Ret <> 0 Then Goto *Err_Trap 'デバイスクローズ Ret = Api_mciSendString("Close Video", ByVal 0, 0, 0) If Ret <> 0 Then Goto *Err_Trap Exit Sub *Err_Trap Var ErrorString As String ErrorString = Space$(256) Ret = Api_mciGetErrorString(Ret, ErrorString, Len(ErrorString)) ErrorString = Left$(ErrorString, InStr(ErrorString, Chr$(0)) - 1) If deviceIsOpen Then Ret = Api_mciSendString("Close Video", ByVal 0, 0, 0) End If End Sub '================================================================ '= シェルドロップされたファイル名を取得 '================================================================ Declare Sub MainForm_DropFiles edecl (ByVal DF As Long) Sub MainForm_DropFiles(ByVal DF As Long) Var CN As Long CN = GetDropFileCount(DF) FileName = GetDropFileName(DF, 0) PathAndSizeSet End Sub '================================================================ '= '================================================================ Declare Sub MainForm_MouseDown edecl (ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Sub MainForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Var Ret As Long If Button = 1 Then 'ドラッグ Capture = True Ret = Api_GetCursorPos(StartCursor) Ret = Api_GetWindowRect(GethWnd, StartPos) Ret = Api_SetCapture(GethWnd) End If End Sub '================================================================ '= '================================================================ Declare Sub MainForm_MouseMove edecl (ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Sub MainForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Var CurrentCursor As POINTAPI static Event As Integer Var Ret As Long If Capture And Button = 1 And Not Event Then Event = True CallEvent Ret = Api_GetCursorPos(CurrentCursor) Ret = Api_SetWindowPos(GethWnd, 0, StartPos.Left + CurrentCursor.x - StartCursor.x, StartPos.Top + CurrentCursor.y - StartCursor.y, 0, 0, SWP_NOZORDER Or SWP_NOSIZE) Event = False End If End Sub '================================================================ '= '================================================================ Declare Sub MainForm_MouseUp edecl (ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Sub MainForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Var Ret As Long If Button = 1 And Capture Then 'ドラッグ停止 Capture = False Ret = Api_ReleaseCapture End If End Sub '================================================================ '= '================================================================ Declare Sub MainForm_DblClick edecl () Sub MainForm_DblClick() End End Sub '================================================================ '= '================================================================ While 1 WaitEvent Wend Stop End