VB 6 Эскизы видеофайлов

Возможно IMediaDet Interface?
Ого, для получения эскизов 18-ти файлов придется их "вскрыть" для получения полноформатного скриншота, а потом их нужно будет уменьшить до размеров пикчуребоксов... долго будет. Или так оно и делается? Я просто ожидал, что заготовленный эскиз может храниться в самом файле
 
Вот,посмотрите вариант - стырил кажется на кибере.

Возможно @Dragokas еще что то подскажет,он в этом деле больше разбирается)
 
Вот,посмотрите вариант - стырил кажется на кибере.

Возможно @Dragokas еще что то подскажет,он в этом деле больше разбирается)
Похоже на исходник VisualBasic, но почему то много эксэмэля, у меня не открывается. Нужно создать проект и внедрить исходники?, или это не VB6?
 
Это VB.NET. И работа там ведется с библиотекой Interop.DexterLib.dll, которая идет в комплекте. К VB6 нативно ее не подключить.

Но это делать и незачем. В системе уже есть библиотека, в которой имеются и типы данных, и все необходимые методы.
Вы можете перевести код VB.NET практически один к одному, просто подключив к проекту библиотеку c:\windows\system32\qedit.dll
(или c:\windows\syswow64\qedit.dll, если ОС 64-битная)

В помощь о MediaDet эта книга.
 
Сергей, ну как успехи, еще примеры находили?

На основе того интерфейса, что давал Кирилл и системной библиотеки qedit.dll получается вот такой код:

VB.NET / VBA:
Option Explicit

Dim md          As MediaDet
Dim sFrameFile  As String
Dim iFrameCnt   As Integer
Dim lCurFrame   As Long
Dim FileName    As String
Dim StreamLen   As Double

Private Sub Form_Load()
    sFrameFile = App.Path & "\Frame.bmp"
    Slider1.Min = 0
    Slider1.Max = 1000
End Sub

Private Sub cmdOpenFile_Click()
    On Error GoTo ErrHandler
    With CommonDialog1
        .Filter = "Video files (*.*)|*.*"
        .DialogTitle = "Select File"
        .CancelError = True
        .ShowOpen
        FileName = .FileName
        Call Reload
        md.CurrentStream = 0
        lblFrame.Caption = "0 / " & md.StreamLength \ 1
        Slider1.Enabled = True
        lCurFrame = 0
    End With
    Exit Sub
ErrHandler:
End Sub
Function Reload() As Boolean
    If Len(FileName) = 0 Then Exit Function
    If Not (md Is Nothing) Then Reload = True: Exit Function
    Set md = New MediaDet
    md.FileName = FileName
    StreamLen = md.StreamLength
    Reload = True
End Function
Sub GoToFrame(lFrame As Long)
    If Not Reload() Then Exit Sub
    md.WriteBitmapBits lFrame, Picture1.Width \ Screen.TwipsPerPixelX, Picture1.Height \ Screen.TwipsPerPixelY, sFrameFile
    Picture1.Picture = LoadPicture(sFrameFile)
    Reload  ' reinit interface because of some bug in qEdit.dll with self-destruct of instance after each call
End Sub
Private Sub Slider1_Click()
    If Not Reload() Then Exit Sub
    lCurFrame = Slider1.Value / Slider1.Max * StreamLen \ 1
    lblFrame.Caption = "0 / " & lCurFrame
    GoToFrame lCurFrame
End Sub
Private Sub cmdSaveFrame_Click()
    If Not Reload() Then Exit Sub
    iFrameCnt = iFrameCnt + 1
    md.WriteBitmapBits lCurFrame, Picture1.Width \ Screen.TwipsPerPixelX, Picture1.Height \ Screen.TwipsPerPixelY, App.Path & "\Frame" & Right$("00" & iFrameCnt, 3) & ".bmp"
End Sub
Private Sub cmdNext_Click()
    If Not Reload() Then Exit Sub
    If lCurFrame <= (StreamLen - 1) Then lCurFrame = lCurFrame + 1
    lblFrame.Caption = "0 / " & lCurFrame
    GoToFrame lCurFrame
End Sub
Private Sub cmdPrev_Click()
    If lCurFrame >= 1 Then lCurFrame = lCurFrame - 1
    lblFrame.Caption = "0 / " & lCurFrame
    GoToFrame lCurFrame
End Sub

Frames.jpg


Только поддержка форматов сносная. И эта библиотека багованная (в отличие от той, что сделана на основе NET.Framework) - при каждом обращении к экземпляру объекта самоуничтожает его, из-за чего при пролистывании каждого кадра приходится заново создавать объект.
 

Вложения

  • FrameWorker.zip
    2.9 KB · Просмотры: 3
Назад
Сверху Снизу