C# と VB.NET の質問掲示板

わんくま同盟

ASP.NET、C++/CLI、Java 何でもどうぞ

C# と VB.NET の入門サイト


(過去ログ 26 を表示中)
■11998 / )  Re[7]: VB.NETでBMPからAVIを作成する方法
□投稿者/ moro (5回)-(2007/12/26(Wed) 18:05:21)
> あなたが書いたVBのソースを載せて、どこが悪いのか指摘を受けたほうが有意義だと思いますよ。

よもやまさんに紹介していただいたページをVBに変換しました。
http://www.adp-gmbh.ch/csharp/avi/write_avi.html

悪い点や誤り等ありましたらご指摘をお願いいたします。


以下ソースです。よろしくお願いします。
※ToUInt32についてはSystem.Convert.を省略して記載しています。

Imports System
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System.Drawing.Imaging

 _

Public Class AviWriter
	<StructLayout(LayoutKind.Sequential, Pack:=1)> _
	Private Structure AVISTREAMINFOW
		Public fccType, fccHandler, dwFlags, dwCaps As UInt32

		Public wPriority, wLanguage As UInt16

		Public dwScale, dwRate, dwStart, dwLength, dwInitialFrames, dwSuggestedBufferSize, dwQuality, dwSampleSize, rect_left, rect_top, rect_right, rect_bottom, dwEditCount, dwFormatChangeCount As UInt32

		Public szName0, szName1, ..... szName63 As UInt16
	End Structure 'AVISTREAMINFOW
	<StructLayout(LayoutKind.Sequential, Pack:=1)> _
		Private Structure AVICOMPRESSOPTIONS
		Public fccType As UInt32
		Public fccHandler As UInt32
		Public dwKeyFrameEvery As UInt32 ' only used with AVICOMRPESSF_KEYFRAMES
		Public dwQuality As UInt32
		Public dwBytesPerSecond As UInt32 ' only used with AVICOMPRESSF_DATARATE
		Public dwFlags As UInt32
		Public lpFormat As IntPtr
		Public cbFormat As UInt32
		Public lpParms As IntPtr
		Public cbParms As UInt32
		Public dwInterleaveEvery As UInt32
	End Structure 'AVICOMPRESSOPTIONS
	<StructLayout(LayoutKind.Sequential, Pack:=1)> _
	 Public Structure BITMAPINFOHEADER
		Public biSize As UInt32
		Public biWidth As Int32
		Public biHeight As Int32
		Public biPlanes As Int16
		Public biBitCount As Int16
		Public biCompression As UInt32
		Public biSizeImage As UInt32
		Public biXPelsPerMeter As Int32
		Public biYPelsPerMeter As Int32
		Public biClrUsed As UInt32
		Public biClrImportant As UInt32
	End Structure 'BITMAPINFOHEADER
	_

	Public Class AviException
		Inherits ApplicationException

		Public Sub New(ByVal s As String)
			MyBase.New(s)
		End Sub 'New

		Public Sub New(ByVal s As String, ByVal hr As Int32)
			MyBase.New(s)

			If hr = AVIERR_BADPARAM Then
				err_msg = "AVIERR_BADPARAM"
			Else
				err_msg = "unknown"
			End If
		End Sub 'New


		Public Function ErrMsg() As String
			Return err_msg
		End Function 'ErrMsg
		Private AVIERR_BADPARAM As Int32 = -2147205018
		Private err_msg As String
	End Class 'AviException

	Private Const OF_WRITE As Long = &H1
	Private Const OF_CREATE As Long = &H1000
	Private Const OF_SHARE_DENY_NONE As Long = &H40
	Private Const AVIIF_KEYFRAME As Long = &H10L

	Public Function Open(ByVal fileName As String, ByVal frameRate As UInt32, ByVal width As Integer, ByVal height As Integer) As Bitmap
		frameRate_ = frameRate
		width_ = width
		height_ = height
		bmp_ = New Bitmap(width, height, PixelFormat.Format24bppRgb)
		Dim bmpDat As BitmapData = bmp_.LockBits(New Rectangle(0, 0, width, height), ImageLockMode.ReadOnly, PixelFormat.Format24bppRgb)
		stride_ = bmpDat.Stride
		bmp_.UnlockBits(bmpDat)
		AVIFileInit()
		Dim hr As Integer = AVIFileOpen(pfile_, fileName, OF_CREATE Or OF_WRITE Or OF_SHARE_DENY_NONE, 0)

		If hr <> 0 Then
			Throw New AviException("error for AVIFileOpen")
		End If

		CreateStream()
		SetOptions()

		Return bmp_
	End Function 'Open


	Public Sub AddFrame()

		Dim bmpDat As BitmapData = bmp_.LockBits(New Rectangle(0, 0, CInt(width_), CInt(height_)), ImageLockMode.ReadOnly, PixelFormat.Format24bppRgb)

		Dim hr As Integer = AVIStreamWrite(psCompressed_, count_, 1, bmpDat.Scan0, CType(stride_ * height_, Int32), 0, 0, 0)
		' pointer to data
		' 16 = AVIIF_KEYFRAMe

		If hr <> 0 Then
			Throw New AviException("AVIStreamWrite")
		End If

		bmp_.UnlockBits(bmpDat)

		count_ += 1
	End Sub 'AddFrame


	Public Sub Close()
		AVIStreamRelease(ps_)
		AVIStreamRelease(psCompressed_)

		AVIFileRelease(pfile_)
		AVIFileExit()
	End Sub 'Close


	Private Sub CreateStream()
		Dim strhdr As New AVISTREAMINFOW
		strhdr.fccType = fccType_
		strhdr.fccHandler = fccHandler_
		strhdr.dwFlags = ToUInt32(0)
		strhdr.dwCaps = ToUInt32(0)
		strhdr.wPriority = ToUInt16(0)
		strhdr.wLanguage = ToUInt16(0)
		strhdr.dwScale = ToUInt32(1)
		strhdr.dwRate = frameRate_ ' Frames per Second
		strhdr.dwStart = ToUInt32(0)
		strhdr.dwLength = ToUInt32(0)
		strhdr.dwInitialFrames = ToUInt32(0)
		strhdr.dwSuggestedBufferSize = ToUInt32(height_ * stride_)
		strhdr.dwQuality = ToUInt32(4294967295)
		strhdr.dwSampleSize = ToUInt32(0)
		strhdr.rect_top = ToUInt32(0)
		strhdr.rect_left = ToUInt32(0)
		strhdr.rect_bottom = ToUInt32(height_)
		strhdr.rect_right = ToUInt32(width_)
		strhdr.dwEditCount = ToUInt32(0)
		strhdr.dwFormatChangeCount = ToUInt32(0)
		strhdr.szName0 = ToUInt16(0)
		strhdr.szName1 = ToUInt16(0)

		Dim hr As Integer = AVIFileCreateStream(pfile_, ps_, strhdr)

		If hr <> 0 Then
			Throw New AviException("AVIFileCreateStream")
		End If
	End Sub 'CreateStream


	Private Sub SetOptions()
		Dim opts As New AVICOMPRESSOPTIONS
		opts.fccType = ToUInt32(0) 'fccType_;
		opts.fccHandler = ToUInt32(0) 'fccHandler_;
		opts.dwKeyFrameEvery = ToUInt32(0)
		opts.dwQuality = ToUInt32(0) ' 0 .. 10000
		opts.dwFlags = ToUInt32(0) ' AVICOMRPESSF_KEYFRAMES = 4
		opts.dwBytesPerSecond = ToUInt32(0)
		opts.lpFormat = New IntPtr(0)
		opts.cbFormat = ToUInt32(0)
		opts.lpParms = New IntPtr(0)
		opts.cbParms = ToUInt32(0)
		opts.dwInterleaveEvery = ToUInt32(0)

		Dim p As AVICOMPRESSOPTIONS
		Dim pp As AVICOMPRESSOPTIONS

		Dim x As IntPtr = ps_
		Dim ptr_ps As IntPtr

		AVISaveOptions(0, ToUInt32(0), 1, ptr_ps, pp)

		' TODO: AVISaveOptionsFree(...)
		Dim hr As Integer = AVIMakeCompressedStream(psCompressed_, ps_, opts, 0)
		If hr <> 0 Then
			Throw New AviException("AVIMakeCompressedStream")
		End If

		Dim bi As New BITMAPINFOHEADER
		bi.biSize = ToUInt32(40)
		bi.biWidth = ToDecimal(width_)
		bi.biHeight = ToDecimal(height_)
		bi.biPlanes = 1
		bi.biBitCount = 24
		bi.biCompression = ToUInt32(0) ' 0 = BI_RGB
		bi.biSizeImage = ToUInt32(stride_ * height_)
		bi.biXPelsPerMeter = 0
		bi.biYPelsPerMeter = 0
		bi.biClrUsed = ToUInt32(0)
		bi.biClrImportant = ToUInt32(0)

		hr = AVIStreamSetFormat(psCompressed_, 0, bi, 40)
		If hr <> 0 Then
			Throw New AviException("AVIStreamSetFormat", hr)
		End If
	End Sub 'SetOptions

	Private Declare Sub AVIFileInit Lib "avifil32.dll" ()

	Private Declare Sub AVIFileExit Lib "avifil32.dll" ()

	Private Declare Function AVIFileOpen Lib "avifil32.dll" _
			 (ByRef ptr_pfile As Integer, ByVal fileName As String, _
			  ByVal flags As Integer, ByRef dummy As Integer) As Integer 'byval

	Private Declare Function AVIFileOpenW Lib "avifil32.dll" _
			 (ByRef ptr_pfile As Integer, ByVal fileName As String, _
			  ByVal flags As Integer, ByRef dummy As Integer) As Integer 'byval

	Private Declare Function AVIFileCreateStream Lib "avifil32.dll" _
			  (ByVal ptr_pfile As Integer, ByRef ptr_ptr_avi As IntPtr, _
			   ByRef ptr_streaminfo As AVISTREAMINFOW) As Long

	Private Declare Function AVIMakeCompressedStream Lib "avifil32.dll" _
			   (ByRef ppsCompressed As IntPtr, ByVal aviStream As IntPtr, _
				ByRef ao As AVICOMPRESSOPTIONS, ByVal dummy As Integer) As Integer

	Private Declare Function AVIStreamSetFormat Lib "avifil32.dll" _
			   (ByVal aviStream As IntPtr, ByVal lPos As Int32, _
				ByRef lpFormat As BITMAPINFOHEADER, ByVal cbFormat As Int32) As Integer

	Private Declare Function AVISaveOptions Lib "avifil32.dll" _
		  (ByVal hwnd As Integer, ByVal flags As UInt32, _
		   ByVal nStreams As Integer, _
		   ByRef ptr_ptr_avi As IntPtr, ByRef ao As AVICOMPRESSOPTIONS) As Integer 'byval

	Private Declare Function AVIStreamWrite Lib "avifil32.dll" _
		 (ByVal aviStream As IntPtr, ByVal lStart As Int32, _
		  ByVal lSamples As Int32, ByVal lpBuffer As IntPtr, _
		  ByVal cbBuffer As Int32, ByVal dwFlags As Int32, _
		  ByRef dummy1 As Int32, ByRef dummy2 As Int32) As Integer 'byval

	Private Declare Function AVIStreamRelease Lib "avifil32.dll" _
			   (ByVal aviStream As IntPtr) As Integer

	Private Declare Function AVIFileRelease Lib "avifil32.dll" _
			   (ByVal pfile As Integer) As Integer

	Private pfile_ As Integer = 0
	Private ps_ As New IntPtr(0)
	Private psCompressed_ As New IntPtr(0)
	Private frameRate_ As UInt32 = ToUInt32(0)
	Private count_ As Integer = 0
	Private width_ As Integer = 0
	Private stride_ As Integer = 0
	Private height_ As Integer = 0
	Private fccType_ As UInt32 = ToUInt32(1935960438) ' vids
	Private fccHandler_ As UInt32 = ToUInt32(808810089) ' IV50
	'1145656899;  // CVID
	Private bmp_ As Bitmap
End Class 'AviWriter


返信 編集キー/


管理者用

- Child Tree -