|
> あなたが書いた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
|