Ого, для получения эскизов 18-ти файлов придется их "вскрыть" для получения полноформатного скриншота, а потом их нужно будет уменьшить до размеров пикчуребоксов... долго будет. Или так оно и делается? Я просто ожидал, что заготовленный эскиз может храниться в самом файле
Это VB.NET. И работа там ведется с библиотекой Interop.DexterLib.dll, которая идет в комплекте. К VB6 нативно ее не подключить.
Но это делать и незачем. В системе уже есть библиотека, в которой имеются и типы данных, и все необходимые методы.
Вы можете перевести код VB.NET практически один к одному, просто подключив к проекту библиотеку c:\windows\system32\qedit.dll
(или c:\windows\syswow64\qedit.dll, если ОС 64-битная)
На основе того интерфейса, что давал Кирилл и системной библиотеки 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
Только поддержка форматов сносная. И эта библиотека багованная (в отличие от той, что сделана на основе NET.Framework) - при каждом обращении к экземпляру объекта самоуничтожает его, из-за чего при пролистывании каждого кадра приходится заново создавать объект.