#N88BASIC
Declare Sub AVIFileInit Lib "avifil32" ()
Declare Sub AVIFileExit Lib "avifil32" ()
Declare Function AVIFileOpen Lib "avifil32" Alias "AVIFileOpenA" (ppfile As **DWord, szFile As *Byte, mode As Long, pclsidHandler As VoidPtr) As Long
Declare Function AVIFileRelease Lib "avifil32" (pfile As *DWord) As Long
Declare Function AVIFileInfo Lib "avifil32" Alias "AVIFileInfoA" (pfile As *DWord, pfi As *AVIFILEINFO, lSize As Long) As Long
Declare Sub AVIFileGetStream lib "avifil32" (pfile As *DWord, ppavi As **DWord, fccType As Long, lParam As Long)
Declare Function AVIStreamRelease Lib "avifil32" Alias "AVIStreamRelease" (pavi As *DWord) As Long
Declare Function AVIStreamLength Lib "avifil32" Alias "AVIStreamLength" (pg As *DWord) As DWord
Declare Function AVIStreamGetFrame Lib "avifil32" Alias "AVIStreamGetFrame" (pg As *DWord, lPos As DWord) As *Byte
Declare Function AVIStreamGetFrameOpen Lib "avifil32" Alias "AVIStreamGetFrameOpen" (pfile As *DWord, lpbiWanted As *BITMAPINFOHEADER) As *DWord
Declare Sub AVIStreamGetFrameClose Lib "avifil32" Alias "AVIStreamGetFrameClose" (pg As *DWord)
Const streamtypeVIDEO = 1935960438 '= mmioStringToFOURCC("vids", 0&)
Const streamtypeAUDIO = 1935963489 '= mmioStringToFOURCC("auds", 0&)
Const streamtypeMIDI = 1935960429 '= mmioStringToFOURCC("mids", 0&)
Const streamtypeTEXT = 1937012852 '= mmioStringToFOURCC("txts", 0&)
Const OF_SHARE_DENY_NONE = &h00000040
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[64] As Byte 'ファイルタイプ情報の記述を含む、Nullで終わる文字列
End Type
Dim pavi As *DWord
Dim pstrm As *DWord
Dim pg As *DWord
Dim afi As AVIFILEINFO
Dim pbih As *BITMAPINFOHEADER
Dim fr As Dword
Dim hDC As HDC
Dim hWnd As HWND
Dim wait As DWord
Dim smpl As DWord
Dim mes[1000] As Byte
Dim start As DWord
Dim s As DWord
Dim fps As Double
Dim realfps As Double
AVIFileInit()
If AVIFileOpen(VarPtr(pavi), "test.avi", OF_SHARE_DENY_NONE, NULL) <> 0 Then
Print "open エラー"
Goto *AVICLOSE
End If
AVIFileInfo(pavi, VarPtr(afi), SizeOf(AVIFILEINFO))
AVIFileGetStream(pavi, VarPtr(pstrm), streamtypeVIDEO, 0)
pg = AVIStreamGetFrameOpen(pstrm, NULL)
fps = (afi.dwRate/afi.dwScale)
wait = 1000/ fps
smpl = AVIStreamLength(pstrm)
hWnd = GetForegroundWindow()
hDC = GetDC(hWnd)
start = GetTickCount()
For fr=0 To smpl-1
pbih = AVIStreamGetFrame(pg, fr)
'Savef(pbih, "0.bmp")
Putf(pbih, hDC)
s = (GetTickCount()-start)/1000
realfps= fr/s
wsprintf(mes, "サンプル %d/%d 再生時間=%d秒 fps=%d wait=%d", fr, smpl-1, Int(s), Int(realfps), Int(wait))
SetWindowText(hWnd,mes)
If fps < realfps Then wait++
If fps > realfps Then wait--
If wait > 1000 Then wait = 1
Sleep(wait)
Next
ReleaseDC(hWnd, hDC)
AVIStreamGetFrameClose(pg)
AVIStreamRelease(pstrm)
AVIFileRelease(pavi)
*AVICLOSE
AVIFileExit()
'ビットマップを画面に表示
Function Putf(pbih As *BITMAPINFOHEADER, hDC As HDC) As Long
Dim bi As BITMAPINFO
memcpy(VarPtr(bi.bmiHeader), pbih, SizeOf(BITMAPINFOHEADER))
StretchDIBits(hDC, 0,0, pbih->biWidth, pbih->biHeight, 0, 0, pbih->biWidth, pbih->biHeight, pbih+SizeOf(BITMAPINFOHEADER), bi, DIB_RGB_COLORS, SRCCOPY)
End Function
'ビットマップをファイルに保存
Function Savef(pbih As *BITMAPINFOHEADER, fnam As *Byte) As Long
Dim hF As HANDLE
Dim bfh As BITMAPFILEHEADER
Dim r As DWord
hF = CreateFile(fnam, GENERIC_WRITE, 0, ByVal 0, CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0)
If hF = INVALID_HANDLE_VALUE Then Exit Function
'ビットマップファイルヘッダーを初期化
bfh.bfType = &h4D42
bfh.bfOffBits = SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER)
bfh.bfSize = bfh.bfOffBits + pbih->biSizeImage
'ディスクファイルに書き込み処理
WriteFile(hF, VarPtr(bfh), SizeOf(BITMAPFILEHEADER), VarPtr(r), ByVal 0)
WriteFile(hF, pbih, SizeOf(BITMAPINFOHEADER), VarPtr(r), ByVal 0)
WriteFile(hF, pbih + SizeOf(BITMAPINFOHEADER), pbih->biSizeImage, VarPtr(r), ByVal 0)
CloseHandle(hF)
End Function
