dcsimg
Results 1 to 1 of 1

Thread: [VB6] - Editing AVI-files without recompression.

  1. #1

    Thread Starter
    Frenzied Member
    Join Date
    Feb 2015
    Posts
    1,344

    [VB6] - Editing AVI-files without recompression.

    Hello everyone.
    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
    The files must drop on window from the explorer, the Start and End button make the selection.
    Attached Files Attached Files

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width