Private Type AVI_COMPRESS_OPTIONS
fccType As Long
fccHandler As Long
dwKeyFrameEvery As Long
dwQuality As Long
dwBytesPerSecond As Long
dwFlags As Long
lpFormat As Long
cbFormat As Long
lpParms As Long
cbParms As Long
dwInterleaveEvery As Long
End Type
Private Type WAVEHDR
lpData As Long
dwBufferLen As Long
dwBytesRec As Long
dwUser As Long
dwFlags As Long
dwLoops As Long
lpNext As Long
Reserved As Long
End Type
Private Type WAVEFORMATEX
wFormatTag As Integer '波形聲音的格式,本人此處設定為WAVE_FORMAT_PCM
nChannels As Integer '通道數量，單聲道為1，立體聲為2
nSamplesPerSec As Long '樣本采樣率，對于 WAVE_FORMAT_PCM通常為8.0 kHz， 11.025 kHz， 22.05 kHz和44.1 kHz
nAvgBytesPerSec As Long ' for buffer estimation */
nBlockAlign As Integer 'block size of data
wBitsPerSample As Integer '//每個樣本的BIT數目，一般為16
biSize As Integer '// 額外資訊的大小,以位元組為單位,添加在
End Type
Const WAVE_FORMAT_PCM = 1 '這一塊的const 都是我寫的
Const WHDR_BEGINLOOP = 4
Const WHDR_DONE = 1
Const WHDR_ENDLOOP = 8
Const WHDR_INQUEUE = &H10
Const WHDR_PREPARED = 2
Global Const AVIERR_OK As Long = 0&
Global Const OF_WRITE As Long = &H1
Global Const OF_CREATE As Long = &H1000
Global Const AVIIF_KEYFRAME As Long = &H10
Global Const DATARATE As Long = &H280
Global Const ICMF_CHOOSE_KEYFRAME As Long = &H1
Global Const ICMF_CHOOSE_DATARATE As Long = &H2
Dim res As Long, pfile As Long, ps As Long, psCompressed As Long, pOpts As Long
Dim ps2 As Long, psCompressed2 As Long, pOpts2 As Long '這一行是自己寫的
Dim bmp As cDIB, strhdr As AVI_STREAM_INFO, BI As BITMAPINFOHEADER, opts As AVI_COMPRESS_OPTIONS, avifile As String
Dim wav As cWAV, WH As WAVEHDR, opts2 As AVI_COMPRESS_OPTIONS '這一行是自己寫的
Dim strhdr2 As WAVEFORMATEX 'AVI_STREAM_INFO '
'轉Integer陣列到 byte陣列用的
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'轉Integer陣列到 byte陣列用的
Public Function StartDecode(hwnd As Long, base As String, path As String, fps%) As Boolean
avifile = path: AVIFileInit: res = AVIFileOpen(pfile, path, OF_WRITE Or OF_CREATE, 0&)
If (res <> AVIERR_OK) Then
EndDecode
Exit Function
End If
Set bmp = New cDIB
If bmp.CreateFromFile(base) <> True Then
MsgBox "Could not load first bitmap file in list!", vbExclamation, App.title
EndDecode
Exit Function
End If
With strhdr
.fccType = mmioStringToFOURCC("vids", 0&)
.fccHandler = 0&
.dwScale = 1
.dwRate = Val(fps)
.dwSuggestedBufferSize = bmp.SizeImage
SetRect .rcFrame, 0, 0, bmp.Width, bmp.Height
End With
If strhdr.dwRate < 1 Then strhdr.dwRate = 1
If strhdr.dwRate > 30 Then strhdr.dwRate = 30
res = AVIFileCreateStream(pfile, ps, strhdr)
If (res <> AVIERR_OK) Then
EndDecode
Exit Function
End If
With strhdr2
.wFormatTag = 1
.nChannels = Val(2)
.wBitsPerSample = Val(16)
.nSamplesPerSec = Val(44100) '采樣率
.nAvgBytesPerSec = Val(176400) 'WAVE聲音中每秒的資料量 (CLng(cboSamplerate.Text) * (2 * (chkStereo.value + 1))) = 44100 * (2*(1+1))
.nBlockAlign = (10240) '資料塊的對齊標志
.biSize = 14 '此結構的大小
End With 'SetFormat VarPtr(wfx), Len(wfx),"44.1 kHz 16 Bit Stereo", "PCM"
Dim strhdr3 As AVI_STREAM_INFO
With strhdr3
.fccType = mmioStringToFOURCC("auds", 0&)
.fccHandler = 1&
.dwScale = Val(10240)
.dwRate = Val(176400)
.dwSuggestedBufferSize = bmp.SizeImage
'SetRect .rcFrame, 0, 0, bmp.Width, bmp.Height
End With
' update recorded time
'lngMSEncoded = lngMSEncoded + ((lngLen / lngBytesPerSec) * 1000)
res = AVIFileCreateStream(pfile, ps2, strhdr3)
If (res <> AVIERR_OK) Then
EndDecode
Exit Function
End If
Dim b() As Byte, i As Long
' ReDim b(Len(strhdr2) * 2 - 1)
' For i = 0 To UBound(intSamples)
' CopyMemory b(i * 2), intSamples(i), ByVal 2 'LenB(intSamples(i))
' Next
res = AVIStreamSetFormat(ps2, 0, ByVal VarPtr(strhdr2), Len(strhdr2))
If (res <> AVIERR_OK) Then
EndDecode
Exit Function
End If
pOpts = VarPtr(opts)
res = AVISaveOptions(hwnd, ICMF_CHOOSE_KEYFRAME Or ICMF_CHOOSE_DATARATE, 1, ps, pOpts)
If res <> 1 Then
AVISaveOptionsFree 1, pOpts
EndDecode
Exit Function
End If
res = AVIMakeCompressedStream(psCompressed, ps, opts, 0&)
If res <> AVIERR_OK Then
EndDecode
Exit Function
End If
With BI
.biBitCount = bmp.BitCount
.biClrImportant = bmp.ClrImportant
.biClrUsed = bmp.ClrUsed
.biCompression = bmp.Compression
.biHeight = bmp.Height
.biWidth = bmp.Width
.biPlanes = bmp.Planes
.biSize = bmp.SizeInfoHeader
.biSizeImage = bmp.SizeImage
.biXPelsPerMeter = bmp.XPPM
.biYPelsPerMeter = bmp.YPPM
End With
res = AVIStreamSetFormat(psCompressed, 0, ByVal bmp.PointerToBitmapInfo, bmp.SizeBitmapInfo)
If (res <> AVIERR_OK) Then
EndDecode
Exit Function
End If
'Set wav = New cWAV
'If wav.CreateFromFile(App.path & "\t.wav") = True Then
'EndDecode
'Exit Function
'End If
'Dim mWFeX As WAVEFORMATEX
' .nBlockAlign = .nSamplesPerSec * .wBitsPerSample 'block size of data (_wfx.wBitsPerSample * _wfx.nChannels) >> 3;
' .nAvgBytesPerSec = .nBlockAlign * .nSamplesPerSec '/* for buffer estimation */ _wfx.nBlockAlign * _wfx.nSamplesPerSec;
' .cbSize = 0 '額外資訊的大小,如果沒有額外資訊可為0'
StartDecode = 1
End Function
Public Sub Decode(ByVal Index As Integer, ByVal file As String)
bmp.CreateFromFile (file)
res = AVIStreamWrite(psCompressed, Index, 1, bmp.PointerToBits, bmp.SizeImage, AVIIF_KEYFRAME, ByVal 0&, ByVal 0&)
If res <> AVIERR_OK Then EndDecode
End Sub
Public Sub Decode2(ByVal Index As Integer, ii() As Integer) '我寫的 錄入音頻
'Dim b() As Byte, i As Long
'Dim Buffer(3) As Byte
'a = Val(Text1) CopyMemory Buffer(0), a, 4
'For i = 0 To UBound(ii)
' b(i) = CByte(ii)
'Next
Dim b() As Byte
Dim i As Long
ReDim b((UBound(intSamples) + 1) * 2 - 1)
For i = 0 To UBound(intSamples)
CopyMemory b(i * 2), intSamples(i), ByVal 2 'LenB(intSamples(i))
Next
res = AVIStreamWrite(ps2, Index, 1, b, intSamplesSize, AVIIF_KEYFRAME, ByVal 0&, ByVal 0&) 'AVIIF_KEYFRAME AVIIF_DATARATE
If res <> AVIERR_OK Then EndDecode
End Sub
uj5u.com熱心網友回復：
把圖片寫入avi檔案沒有問題可以顯示，就是把音頻寫入avi不會發聲，只有影像沒有聲音。誰能指點一下寫音頻的關健地方嗎uj5u.com熱心網友回復：
帥哥.音頻問題搞掂了沒?我下載了你的VB6實作螢屏和音頻都錄入 合成avi音影視聽的 原始碼實體,但沒表單.我想說的不是這個.我一直在找你的聯系方式,但沒有.音頻問題我也被搞瘋掉了.如果你搞掂了.麻煩跟我聯系一下.有謝禮啊.如果能將語言聊天保存為avi檔案(即電話錄音),一個遠程音頻采集傳輸到本機+本機采集.能入保存為avi檔案(時間線要統一).請與我聯系.Q452781589重謝uj5u.com熱心網友回復：
https://blog.csdn.net/jinboker/article/details/52128276?utm_source=distribute.wap_relevant.none-task轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/16852.html
標籤：多媒體
上一篇：下面代碼，在subb里寫個什么代碼能讓suba停止執行，謝謝各位
下一篇：VB和access開發系統