「AVIファイルの操作」の編集履歴（バックアップ）一覧はこちら

「AVIファイルの操作」(2010/09/28 (火) 23:56:28) の最新版変更点

追加された行は緑色になります。

削除された行は赤色になります。

#asciiart(blockquote){
#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
}