How can I display the thumbnail of a video file in a Picturebox?

[dilettante]

Bare minimum example with no error checking. Most of the code here is involved in scaling the thumbnail to fit maintaining the original aspect ratio and then rendering it centered in the PictureBox control.

Option Explicit

'Hard-coded test value:
Private Const VIDEO_FILE As String = _
    "D:\Mad World - Vintage Vaudeville - Style Cover ft. " _
  & "Puddles Pity Party & Haley Reinhart.mp4"

Private Declare Function IStream_Read Lib "shlwapi" ( _
    ByVal Stream As stdole.IUnknown, _
    ByRef v As Byte, _
    ByVal cb As Long) As Long 'HRESULT

Private Declare Function IStream_Size Lib "shlwapi" ( _
    ByVal Stream As stdole.IUnknown, _
    ByRef ui As Currency) As Long 'HRESULT

Private ImageFile As WIA.ImageFile
Private ImageProcess As WIA.ImageProcess

Private Sub Form_Load()
    Const ssfDESKTOP = 0
    Dim Stream As stdole.IUnknown
    Dim ui As Currency
    Dim Bytes() As Byte

    Label2.Caption = VIDEO_FILE
    With CreateObject("Shell.Application").NameSpace(ssfDESKTOP).ParseName(VIDEO_FILE)
        Set Stream = .ExtendedProperty("System.ThumbnailStream")
    End With
    IStream_Size Stream, ui
    ReDim Bytes(0 To CLng(ui * 10000@) - 1)
    IStream_Read Stream, Bytes(0), CLng(ui * 10000@)
    With New WIA.Vector
        .BinaryData = Bytes
        Set ImageFile = .ImageFile
    End With
    Set ImageProcess = New WIA.ImageProcess
    With ImageProcess
        .Filters.Add .FilterInfos.Item("Scale").FilterID
        .Filters(1).Properties.Item("PreserveAspectRatio").Value = True
    End With
End Sub

Private Sub Form_Resize()
    Dim Picture As stdole.StdPicture

    If WindowState <> vbMinimized Then
        With Label2
            .Width = ScaleWidth
            Picture1.Move 0, .Top + .Height, ScaleWidth, ScaleHeight - (.Top + .Height)
        End With
        With ImageProcess
            With .Filters(1).Properties
                .Item("MaximumWidth").Value = _
                    Picture1.ScaleX(Picture1.ScaleWidth, Picture1.ScaleMode, vbPixels)
                .Item("MaximumHeight").Value = _
                    Picture1.ScaleY(Picture1.ScaleHeight, Picture1.ScaleMode, vbPixels)
            End With
            Set Picture = .Apply(ImageFile).FileData.Picture
        End With
        With Picture1
            .AutoRedraw = True
            .Cls
            .PaintPicture Picture, _
                          (.ScaleWidth - .ScaleX(Picture.Width, vbHimetric)) / 2, _
                          (.ScaleHeight - .ScaleY(Picture.Height, vbHimetric)) / 2, _
                          .ScaleX(Picture.Width, vbHimetric), _
                          .ScaleY(Picture.Height, vbHimetric)
            .AutoRedraw = True
        End With
    End If
End Sub

Controls: Label1, Label2 (white with a border), Picture1 (pale cyan).


Oops!

Label2.UseMnemonic = False now, though the screenshot above was before I remembered to do that. That's where the "phantom underscore" came from.