This is example of work with AVI-files (cut section and save it to a file). Everything is commented:
Code:
Option Explicit
. . .
ДЕКЛАРАЦИИ
. . .
Dim currentFile As String ' Текущее имя файла
Dim hAvi As Long ' Текущий файл
Dim frameCount As Long ' Общее количество кадров в файле
Dim frameStart As Long ' Первый кадр
Dim vidStream As Long ' Видеопоток
Dim IGetFrame As Long ' Объект для рендеринга
Dim vidInfo As AVI_STREAM_INFO ' Информация о видеопотоке
' // Обновить фрейм
Private Sub Update()
Dim lpDIB As Long
Dim bi As BITMAPINFOHEADER
Dim x As Long
Dim y As Long
Dim dx As Long
Dim dy As Long
Dim aspect As Single
If IGetFrame = 0 Then Exit Sub
' Получаем фрейм
lpDIB = AVIStreamGetFrame(IGetFrame, sldFrame.Value)
' Получаем информацию о растре
memcpy bi, ByVal lpDIB, Len(bi)
' Центруем
aspect = bi.biHeight / bi.biWidth
If aspect < 1 Then
x = 0
dx = picOut.ScaleWidth
dy = picOut.ScaleWidth * aspect
y = (picOut.ScaleHeight - dy) / 2
Else
y = 0
dy = picOut.ScaleHeight
dx = picOut.ScaleHeight / aspect
x = (picOut.ScaleWidth - dx) / 2
End If
' Выводим
StretchDIBits picOut.hdc, x, y, dx, dy, 0, 0, bi.biWidth, bi.biHeight, ByVal lpDIB + bi.biSize, ByVal lpDIB, 0, vbSrcCopy
' Обновляем время
Dim tim As Date
tim = TimeSerial(0, 0, (sldFrame.Value - frameStart) / (vidInfo.dwRate / vidInfo.dwScale))
lblTime.Caption = tim
End Sub
' // Функция загружает AVI файл
Private Sub LoadAVI(fileName As String)
Dim ret As Long
' Очистка
Clear
' Открываем файл
ret = AVIFileOpen(hAvi, StrPtr(fileName), OF_READWRITE, ByVal 0&)
If ret Then GoTo ErrHandler
' Открываем поток
ret = AVIFileGetStream(hAvi, vidStream, streamtypeVIDEO, 0)
If ret Then GoTo ErrHandler
' Получаем информацию о потоке
AVIStreamInfo vidStream, vidInfo, Len(vidInfo)
' Узнаем кадры
frameStart = AVIStreamStart(vidStream)
frameCount = AVIStreamLength(vidStream)
If frameStart = -1 Or frameCount = -1 Then ret = 1: GoTo ErrHandler
' Получаем IGetFrame объект
IGetFrame = AVIStreamGetFrameOpen(vidStream, ByVal AVIGETFRAMEF_BESTDISPLAYFMT)
If IGetFrame = 0 Then GoTo ErrHandler
currentFile = fileName
sldFrame.Min = frameStart
sldFrame.Max = frameStart + frameCount - 1
sldFrame.SelStart = sldFrame.Min
sldFrame.SelLength = frameCount - 1
picOut.Cls
Update
Exit Sub
ErrHandler:
Clear
currentFile = vbNullString
MsgBox "Error"
End Sub
' // Очистка
Private Sub Clear()
If IGetFrame Then AVIStreamGetFrameClose IGetFrame: IGetFrame = 0
If vidStream Then AVIStreamRelease vidStream: vidStream = 0
If hAvi Then AVIFileRelease hAvi: hAvi = 0
End Sub
' // Сохранить изменения
Private Sub cmdSave_Click()
Dim hNewFile As Long
Dim hNewStream As Long
Dim newFileName As String
Dim ret As Long
Dim info As AVI_STREAM_INFO
Dim firstFrame As Long
Dim lastFrame As Long
Dim curFrame As Long
Dim nextKeyFr As Long
Dim index As Long
Dim sampleCount As Long
Dim dataSize As Long
Dim isKeyFrame As Boolean
Dim buffer() As Byte
If hAvi = 0 Then Exit Sub
' Мы не можем просто так скопировать стрим с любого места, т.к. данные в стриме
' могут быть зависимы и мы можем копировать стрим только если есть опорный кадр
' Ищем ближайший опорный кадр
firstFrame = AVIStreamFindSample(vidStream, sldFrame.SelStart, FIND_KEY Or FIND_NEXT)
lastFrame = AVIStreamFindSample(vidStream, sldFrame.SelStart + sldFrame.SelLength, FIND_KEY Or FIND_PREV)
' Корректируем
If firstFrame < 0 Then firstFrame = 0
If lastFrame < 0 Then lastFrame = 0
' Получаем параметры текущего видео стрима
AVIStreamInfo vidStream, info, Len(info)
' Корректируем количество кадров исходя из новой длины
info.dwLength = lastFrame - firstFrame + 1
' Имя результирующего файла
newFileName = left$(currentFile, Len(currentFile) - 4) & "_Edited.avi"
' Создаем новый файл
ret = AVIFileOpen(hNewFile, StrPtr(newFileName), OF_CREATE Or OF_READWRITE, ByVal 0&)
If ret Then GoTo ErrHandler
' Создаем новый видео стрим
ret = AVIFileCreateStream(hNewFile, hNewStream, info)
If ret Then GoTo ErrHandler
' Копируем формат
ret = AVIStreamReadFormat(vidStream, 0, ByVal 0, dataSize)
If ret Then GoTo ErrHandler
ReDim buffer(dataSize - 1)
ret = AVIStreamReadFormat(vidStream, 0, buffer(0), dataSize)
If ret Then GoTo ErrHandler
ret = AVIStreamSetFormat(hNewStream, 0, buffer(0), dataSize)
If ret Then GoTo ErrHandler
' Проход по кадрам и их копирование в новый файл
curFrame = firstFrame
nextKeyFr = curFrame
prgProgress.Visible = True
Do While index < info.dwLength
' Читаем данные
ret = AVIStreamRead(vidStream, index + firstFrame, AVISTREAMREAD_CONVENIENT, ByVal 0&, 0, dataSize, sampleCount)
If ret Then GoTo ErrHandler
ReDim Preserve buffer(dataSize - 1)
ret = AVIStreamRead(vidStream, index + firstFrame, AVISTREAMREAD_CONVENIENT, buffer(0), dataSize, dataSize, sampleCount)
If ret Then GoTo ErrHandler
' Если это опорный кадр, то
If curFrame = nextKeyFr Then
isKeyFrame = True
' Ищем следующий опорный кадр
nextKeyFr = AVIStreamFindSample(vidStream, nextKeyFr + 1, FIND_KEY Or FIND_NEXT)
End If
If dataSize Then
' Если текущий - опорный
If isKeyFrame Then
' Записываем опорный
ret = AVIStreamWrite(hNewStream, index, sampleCount, buffer(0), dataSize, AVIIF_KEYFRAME, sampleCount, dataSize)
isKeyFrame = False
Else
' Неопорный
ret = AVIStreamWrite(hNewStream, index, sampleCount, buffer(0), dataSize, 0, sampleCount, dataSize)
End If
If ret Then GoTo ErrHandler
End If
' Следующий кадр
curFrame = curFrame + sampleCount
index = index + sampleCount
' Обновляем прогрессбар
prgProgress.Value = (index / info.dwLength) * 50
Loop
' Освобождаем стрим
AVIStreamRelease hNewStream: hNewStream = 0
Dim audStream As Long
Dim firstSample As Long
Dim lastSample As Long
Dim timeStart As Single
Dim timeEnd As Single
Dim curSample As Long
Dim nextKeySmp As Long
' Получаем аудио стрим из файла
ret = AVIFileGetStream(hAvi, audStream, streamtypeAUDIO, 0)
If ret Then
' Аудио стрима нет
ret = 0
GoTo ErrHandler
End If
' Узнаем время кадров
timeStart = firstFrame / (info.dwRate / info.dwScale)
timeEnd = lastFrame / (info.dwRate / info.dwScale)
' Получаем параметры текущего аудио стрима
AVIStreamInfo audStream, info, Len(info)
' Определяем семплы
firstSample = AVIStreamFindSample(audStream, (info.dwRate / info.dwScale) * timeStart, FIND_KEY Or FIND_NEXT)
lastSample = AVIStreamFindSample(audStream, (info.dwRate / info.dwScale) * timeEnd, FIND_KEY Or FIND_PREV)
' Создаем новый аудио стрим
ret = AVIFileCreateStream(hNewFile, hNewStream, info)
If ret Then GoTo ErrHandler
info.dwLength = lastSample - firstSample
' Копируем формат
ret = AVIStreamReadFormat(audStream, 0, ByVal 0, dataSize)
If ret Then GoTo ErrHandler
ReDim buffer(dataSize - 1)
ret = AVIStreamReadFormat(audStream, 0, buffer(0), dataSize)
If ret Then GoTo ErrHandler
ret = AVIStreamSetFormat(hNewStream, 0, buffer(0), dataSize)
If ret Then GoTo ErrHandler
' Проход по семплам и их копирование в новый файл
curSample = firstSample
nextKeySmp = curSample
index = 0
Do While index < info.dwLength
' Читаем данные
ret = AVIStreamRead(audStream, index + firstSample, AVISTREAMREAD_CONVENIENT, ByVal 0&, 0, dataSize, sampleCount)
If ret Then GoTo ErrHandler
ReDim Preserve buffer(dataSize - 1)
ret = AVIStreamRead(audStream, index + firstSample, AVISTREAMREAD_CONVENIENT, buffer(0), dataSize, dataSize, sampleCount)
If ret Then GoTo ErrHandler
' Если это опорный семпл, то
If curSample = nextKeySmp Then
isKeyFrame = True
' Ищем следующий опорный кадр
nextKeySmp = AVIStreamFindSample(audStream, nextKeySmp + sampleCount, FIND_KEY Or FIND_NEXT)
End If
If dataSize Then
' Если текущий - опорный
If isKeyFrame Then
' Записываем опорный
ret = AVIStreamWrite(hNewStream, index, sampleCount, buffer(0), dataSize, AVIIF_KEYFRAME, sampleCount, dataSize)
isKeyFrame = False
Else
' Неопорный
ret = AVIStreamWrite(hNewStream, index, sampleCount, buffer(0), dataSize, 0, sampleCount, dataSize)
End If
If ret Then GoTo ErrHandler
End If
' Следующий семпл (группа семплов)
curSample = curSample + sampleCount
index = index + sampleCount
' Обновляем прогрессбар
prgProgress.Value = (index / info.dwLength) * 50 + 50
Loop
prgProgress.Visible = False
ErrHandler:
' Освобождаем ресурсы
If audStream Then AVIStreamRelease audStream
If hNewStream Then AVIStreamRelease hNewStream
If hNewFile Then AVIFileRelease hNewFile
If ret Then MsgBox "Error saving"
End Sub
' // Установить последний кадр
Private Sub cmdSetEnd_Click()
If sldFrame.Value < sldFrame.SelStart Then Exit Sub
sldFrame.SelLength = sldFrame.Value - sldFrame.SelStart
End Sub
' // Установить начальный кадр
Private Sub cmdSetStart_Click()
sldFrame.SelStart = sldFrame.Value
End Sub
Private Sub Form_Load()
AVIFileInit
SetStretchBltMode picOut.hdc, HALFTONE
End Sub
Private Sub Form_Unload(Cancel As Integer)
Clear
AVIFileExit
End Sub
' // Событие бросания файла на бокс
Private Sub picOut_OLEDragDrop(Data As DataObject, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
x As Single, _
y As Single)
If IsAviFile(Data) Then
LoadAVI Data.Files(1)
End If
End Sub
' // Проверяем AVI ли файл?
Private Sub picOut_OLEDragOver(Data As DataObject, _
Effect As Long, _
Button As Integer, _
Shift As Integer, _
x As Single, _
y As Single, _
State As Integer)
If IsAviFile(Data) Then Effect = ccOLEDropEffectMove Else Effect = ccOLEDropEffectNone
End Sub
' // Является ли AVI файлом
Private Function IsAviFile(Data As DataObject) As Boolean
If Data.Files.Count = 1 Then
Dim fileName As String
fileName = Data.Files(1)
IsAviFile = LCase(right(fileName, 4)) = ".avi"
End If
End Function
Private Sub picOut_Paint()
Update
End Sub
Private Sub sldFrame_Change()
Update
End Sub
Private Sub sldFrame_Scroll()
Update
End Sub