dcsimg
Results 1 to 33 of 33

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

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2010
    Posts
    483

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

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

    Is there an easy way of doing this?
    Please note that I don't need to save the thumbnail. I just need to display the thumbnail in a VB6 Picturebox on a form.

    Please advise.
    Thanks.

  2. #2
    PowerPoster
    Join Date
    Feb 2006
    Posts
    20,869

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

    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.

    Code:
    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
    Name:  sshot.png
Views: 421
Size:  22.9 KB

    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.
    Last edited by dilettante; Jun 2nd, 2019 at 08:30 PM.

  3. #3

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2010
    Posts
    483

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

    Quote Originally Posted by dilettante View Post
    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.

    Code:
       ......
    Private ImageFile As WIA.ImageFile
    Private ImageProcess As WIA.ImageProcess
       ......
    Thanks.
    On this line:
    Code:
    Private ImageFile As WIA.ImageFile
    it gives me an error: User defined type not defined.
    How can I fix it please?

    Also, if I have a Picturebox of fixed size, can I do away with the function Form_Resize?
    I am trying to have this functionality under a commandbutton (when the user clicks on a commandbutton (and not when the form loads). And the Picturebox on the form has a fixed size.
    So, I guess that whole function Form_Resize can be completely left out.
    Am I right?

    Please advise.
    Thanks.

  4. #4
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    2,096

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

    Quote Originally Posted by IliaPreston View Post
    User defined type not defined.
    How can I fix it please?
    Reference the Windows Image Acquisition?
    https://docs.microsoft.com/de-de/win...-wia-startpage
    One System to rule them all, One IDE to find them,
    One Code to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    For health reasons i try to avoid reading unformatted Code

  5. #5
    PowerPoster
    Join Date
    Feb 2006
    Posts
    20,869

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

    Yes, you need a reference to Microsoft Windows Image Acquisition Library v2.0 for this example.

    You only need to scale and position the thumbnail graphic if you want it sized to fit and aligned. Why would you expect Explorer/Shell to read your mind about the size you want and scale it for you?

  6. #6
    PowerPoster
    Join Date
    Feb 2006
    Posts
    20,869

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

    If you don't want to use WIA 2.0 you could always read the IStream, scale the image, and paint it using naked GDI+ Flat API calls. If your program might fetch more than one thumbnail you might want to cache an instance of the Shell object or the Desktop Folder object too rather than creating new ones each time.

  7. #7
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,410

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

    You can also just use the Explorer thumbnail...
    (with oleexp.tlb, and mIID.bas or IID_IShellItemImageFactory otherwise defined)
    Code:
    Private Function GetFileThumbnail(sFile As String, pidlFQ As Long, CX As Long, CY As Long) As Long
    'Specificy EITHER full path in sFile, OR fully qualified pidl in pidlFQ
    Dim isiif As IShellItemImageFactory
    Dim pidl As Long
    On Error GoTo e0
    
    If pidlFQ Then
        Call oleexp.SHCreateItemFromIDList(pidlFQ, IID_IShellItemImageFactory, isiif)
    Else
        oleexp.SHCreateItemFromParsingName StrPtr(sFile), Nothing, IID_IShellItemImageFactory, isiif
    End If
    isiif.GetImage CX, CY, SIIGBF_THUMBNAILONLY Or SIIGBF_RESIZETOFIT, GetFileThumbnail
    Set isiif = Nothing
    On Error GoTo 0
    Exit Function
    
    e0:
    Debug.Print "GetFileThumbnail.Error->" & Err.Description & " (" & Err.Number & ")"
    
    End Function
    Then you just need a standard HBITMAP->PictureBox routine...
    Code:
    Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
    Public Declare Function ImageList_Add Lib "comctl32.dll" (ByVal himl As Long, ByVal hbmImage As Long, ByVal hBMMask As Long) As Long
    Public Declare Function ImageList_Create Lib "comctl32.dll" (ByVal CX As Long, ByVal CY As Long, ByVal Flags As IL_CreateFlags, ByVal cInitial As Long, ByVal cGrow As Long) As Long
    Public Declare Function ImageList_Destroy Lib "comctl32.dll" (ByVal himl As Long) As Boolean
    Public Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hdcDst As Long, ByVal X As Long, ByVal Y As Long, ByVal fStyle As IL_DrawStyle) As Boolean
    Public Enum IL_CreateFlags
      ILC_MASK = &H1
      ILC_COLOR = &H0
      ILC_COLORDDB = &HFE
      ILC_COLOR4 = &H4
      ILC_COLOR8 = &H8
      ILC_COLOR16 = &H10
      ILC_COLOR24 = &H18
      ILC_COLOR32 = &H20
      ILC_PALETTE = &H800                  ' (no longer supported...never worked anyway)
      '5.0
      ILC_MIRROR = &H2000
      ILC_PERITEMMIRROR = &H8000
      '6.0
      ILC_ORIGINALSIZE = &H10000
      ILC_HIGHQUALITYSCALE = &H20000
    End Enum
    Public Enum IL_DrawStyle
      ILD_NORMAL = &H0
      ILD_TRANSPARENT = &H1
      ILD_MASK = &H10
      ILD_IMAGE = &H20
    '#If (WIN32_IE >= &H300) Then
      ILD_ROP = &H40
    '#End If
      ILD_BLEND25 = &H2
      ILD_BLEND50 = &H4
      ILD_OVERLAYMASK = &HF00
     
      ILD_SELECTED = ILD_BLEND50
      ILD_FOCUS = ILD_BLEND25
      ILD_BLEND = ILD_BLEND50
    End Enum
    
    Private Type BITMAP
        BMType As Long
        BMWidth As Long
        BMHeight As Long
        BMWidthBytes As Long
        BMPlanes As Integer
        BMBitsPixel As Integer
        BMBits As Long
    End Type
    
    Private Sub hBitmapToPictureBox(picturebox As Object, hBitmap As Long, Optional X As Long = 0&, Optional Y As Long = 0&)
    
    'This or similar is always given as the example on how to do this
    'But it results in transparency being lost
    'So the below method seems a little ackward, but it works. It can
    'be done without the ImageList trick, but it's much more code
    Dim himlBmp As Long
    Dim tBMP As BITMAP
    Dim CX As Long, CY As Long
    Call GetObject(hBitmap, LenB(tBMP), tBMP)
    CX = tBMP.BMWidth
    CY = tBMP.BMHeight
    If CX = 0 Then
        Debug.Print "no width"
        Exit Sub
    End If
    himlBmp = ImageList_Create(CX, CY, ILC_COLOR32, 1, 1)
    
    ImageList_Add himlBmp, hBitmap, 0&
        
    ImageList_Draw himlBmp, 0, picturebox.hDC, X, Y, ILD_NORMAL
    
    ImageList_Destroy himlBmp
    End Sub

    ------------------
    PS: Since you're using my control, if this is for a project with it, you can get video thumbs like above quicker...
    Code:
    Dim hbm As Long
    
    Dim psi As IShellItem
    Set psi = ucShellBrowse1.SelectedItem
    
    Dim isiif As IShellItemImageFactory
    Set isiif = psi
    isiif.GetImage 96, 96, SIIGBF_THUMBNAILONLY Or SIIGBF_RESIZETOFIT, hbm 'substitute whatever width/height for 96
    Set isiif = Nothing
    
    'Now you have an HBITMAP. You can set it to your own external PictureBox with the 
    'HBitmapToPictureBox function from this post, or set it as the preview in the ucShellBrowse
    'Preview Box (View->Preview Pane to turn it on at runtime, or .PreviewPane property to set 
    'via code or in the Design Time properties). Since the preview handler might load a video 
    'player with the first few seconds instead of a static image.
    
    ucShellBrowse1.SetPreviewPictureWithHBITMAP hbm

  8. #8

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2010
    Posts
    483

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

    Quote Originally Posted by dilettante View Post
    Bare minimum example with no error checking. ...

    Code:
    ...
    Thanks again for this.
    I implemented your code with some few modifications (removing labels, putting the whole thing into one procedure, etc.), but the main logic is exactly the same:
    Code:
    Private Sub cmdShowVidThumbnail_Click()
        
       Dim VIDEO_FILE As String
       VIDEO_FILE = "C:\MyFiles\MyVids\Music\Classical-Music\J.S. Bach - St. Matthew Passion, BWV 244 _ Aria- -Erbarme dich, mein Gott.mp4"
       
       Call Show_Video_Thumbnail(VIDEO_FILE, Picture1)
    End Sub
    
    Private Sub Show_Video_Thumbnail(ByVal VIDEO_FILE As String, ByRef PicBox As picturebox)
    
        Const ssfDESKTOP = 0
        Dim Stream As stdole.IUnknown
        Dim ui As Currency
        Dim Bytes() As Byte
    
        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
        
        
        Dim Picture As stdole.StdPicture
    
        If WindowState <> vbMinimized Then
            With ImageProcess
                With .Filters(1).Properties
                    .Item("MaximumWidth").Value = _
                        PicBox.ScaleX(PicBox.ScaleWidth, PicBox.ScaleMode, vbPixels)
                    .Item("MaximumHeight").Value = _
                        PicBox.ScaleY(PicBox.ScaleHeight, PicBox.ScaleMode, vbPixels)
                End With
                Set Picture = .Apply(ImageFile).FileData.Picture
            End With
            With PicBox
                .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
    And it works perfectly for me.
    There is only one tiny problem that I don't know how to fix:

    The above code properly resizes the thumbnail to best fit into the picturebox.
    However, just because the aspect ratio of the thumbnail may be different than the aspect ratio of the original picturebox, the best possible fit is not really perfect.
    The above code perfectly sizes the longest dimension (height or width) of the thumbnail to the corresponding fixed dimension of the picturebox (This is desireable and expected).
    But then the other dimension (width or height) of the thumbnail is smaller than the corresponding dimension of the picturebox (this is not desireable).
    So, a little bit of empty space (two strips of empty space) are left next to the thumbnail inside the picturebox.

    So, an additional resizing of the picturebox at the end of the above code is needed to eliminate those two strips of empty space inside the picturebox.

    I am trying to do that, but am not sure how to do it.
    Can you please help?
    Thanks.
    Ilia

  9. #9
    PowerPoster
    Join Date
    Feb 2006
    Posts
    20,869

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

    Calling .Apply(ImageFile) returns a new ImageFile. If you cache that you can use its Width and Height properties.

    Those are in pixels so you'll need to convert them to the Form's ScaleMode.

    After that you'll need to add the sizes of the PictureBox's borders to get sizes to assign to the PictureBox. Since border sizes don't change unless your program is fully aware of run time DPI changes you can grab and hold them for future use during Form_Load.

  10. #10
    PowerPoster
    Join Date
    Feb 2006
    Posts
    20,869

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

    Example:

    Code:
    Option Explicit
    
    'Here we assume that Label2.Width and Picture1.Width are both equal to Form.ScaleWidth.
    'We also assume that Picture1.Height is the maximum height we are after.
    
    'Hard-coded test value:
    Private Const VIDEO_FILE As String = "D:\DREAM - My Will Live.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 BordersWidth As Single 'ScaleMode.
    Private BordersHeight As Single 'ScaleMode.
    
    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
            With .Filters(1).Properties
                .Item("PreserveAspectRatio").Value = True
                .Item("MaximumWidth").Value = _
                    Picture1.ScaleX(Picture1.ScaleWidth, Picture1.ScaleMode, vbPixels)
                .Item("MaximumHeight").Value = _
                    Picture1.ScaleY(Picture1.ScaleHeight, Picture1.ScaleMode, vbPixels)
            End With
        End With
        With Picture1
            BordersWidth = .Width - .ScaleWidth
            BordersHeight = .Height - .ScaleHeight
        End With
    End Sub
    
    Private Sub Form_Resize()
        Dim Picture As stdole.StdPicture
        Dim NewWidth As Single
        Dim NewHeight As Single
    
        If WindowState <> vbMinimized Then
            With ImageProcess.Apply(ImageFile)
                Set Picture = .FileData.Picture
                NewWidth = ScaleX(.Width, vbPixels, ScaleMode) + BordersWidth
                NewHeight = ScaleY(.Height, vbPixels, ScaleMode) + BordersHeight
            End With
            With Picture1
                .Move (ScaleWidth - NewWidth) / 2, Label2.Top + Label2.Height, NewWidth, NewHeight
                .AutoRedraw = True
                .Cls
                .PaintPicture Picture, 0, 0
                .AutoRedraw = False
            End With
        End If
    End Sub
    This one doesn't support resizing Form1 because it caches the max width and height during Form_Load.

    Name:  sshot.png
Views: 346
Size:  20.8 KB
    Last edited by dilettante; Jun 9th, 2019 at 09:22 PM.

  11. #11
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    379

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

    Quote Originally Posted by dilettante View Post
    Example:

    Code:
    Option Explicit
    
    'Here we assume that Label2.Width and Picture1.Width are both equal to Form.ScaleWidth.
    'We also assume that Picture1.Height is the maximum height we are after.
    
    'Hard-coded test value:
    Private Const VIDEO_FILE As String = "D:\DREAM - My Will Live.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 BordersWidth As Single 'ScaleMode.
    Private BordersHeight As Single 'ScaleMode.
    
    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
            With .Filters(1).Properties
                .Item("PreserveAspectRatio").Value = True
                .Item("MaximumWidth").Value = _
                    Picture1.ScaleX(Picture1.ScaleWidth, Picture1.ScaleMode, vbPixels)
                .Item("MaximumHeight").Value = _
                    Picture1.ScaleY(Picture1.ScaleHeight, Picture1.ScaleMode, vbPixels)
            End With
        End With
        With Picture1
            BordersWidth = .Width - .ScaleWidth
            BordersHeight = .Height - .ScaleHeight
        End With
    End Sub
    
    Private Sub Form_Resize()
        Dim Picture As stdole.StdPicture
        Dim NewWidth As Single
        Dim NewHeight As Single
    
        If WindowState <> vbMinimized Then
            With ImageProcess.Apply(ImageFile)
                Set Picture = .FileData.Picture
                NewWidth = ScaleX(.Width, vbPixels, ScaleMode) + BordersWidth
                NewHeight = ScaleY(.Height, vbPixels, ScaleMode) + BordersHeight
            End With
            With Picture1
                .Move (ScaleWidth - NewWidth) / 2, Label2.Top + Label2.Height, NewWidth, NewHeight
                .AutoRedraw = True
                .Cls
                .PaintPicture Picture, 0, 0
                .AutoRedraw = False
            End With
        End If
    End Sub
    This one doesn't support resizing Form1 because it caches the max width and height during Form_Load.

    Name:  sshot.png
Views: 346
Size:  20.8 KB
    Code:
    IStream_Read Stream, Bytes(0), CLng(ui * 10000@)
        With New WIA.Vector
            .BinaryData = Bytes
            Set ImageFile = .ImageFile 。error  --2147024809 (80070057)'
    
        End With

  12. #12
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    379

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

    Quote Originally Posted by dilettante View Post
    Example:

    Code:
    Option Explicit
    
    'Here we assume that Label2.Width and Picture1.Width are both equal to Form.ScaleWidth.
    'We also assume that Picture1.Height is the maximum height we are after.
    
    'Hard-coded test value:
    Private Const VIDEO_FILE As String = "D:\DREAM - My Will Live.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 BordersWidth As Single 'ScaleMode.
    Private BordersHeight As Single 'ScaleMode.
    
    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
            With .Filters(1).Properties
                .Item("PreserveAspectRatio").Value = True
                .Item("MaximumWidth").Value = _
                    Picture1.ScaleX(Picture1.ScaleWidth, Picture1.ScaleMode, vbPixels)
                .Item("MaximumHeight").Value = _
                    Picture1.ScaleY(Picture1.ScaleHeight, Picture1.ScaleMode, vbPixels)
            End With
        End With
        With Picture1
            BordersWidth = .Width - .ScaleWidth
            BordersHeight = .Height - .ScaleHeight
        End With
    End Sub
    
    Private Sub Form_Resize()
        Dim Picture As stdole.StdPicture
        Dim NewWidth As Single
        Dim NewHeight As Single
    
        If WindowState <> vbMinimized Then
            With ImageProcess.Apply(ImageFile)
                Set Picture = .FileData.Picture
                NewWidth = ScaleX(.Width, vbPixels, ScaleMode) + BordersWidth
                NewHeight = ScaleY(.Height, vbPixels, ScaleMode) + BordersHeight
            End With
            With Picture1
                .Move (ScaleWidth - NewWidth) / 2, Label2.Top + Label2.Height, NewWidth, NewHeight
                .AutoRedraw = True
                .Cls
                .PaintPicture Picture, 0, 0
                .AutoRedraw = False
            End With
        End If
    End Sub
    This one doesn't support resizing Form1 because it caches the max width and height during Form_Load.

    Name:  sshot.png
Views: 346
Size:  20.8 KB
    Code:
    IStream_Read Stream, Bytes(0), CLng(ui * 10000@)
        With New WIA.Vector
            .BinaryData = Bytes
            Set ImageFile = .ImageFile 。error  --2147024809 (80070057)'
    
        End With

  13. #13
    PowerPoster
    Join Date
    Feb 2006
    Posts
    20,869

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

    The sample code doesn't have any error checking. I suspect there is something about the file you provided that prevents fetching System.ThumbnailStream, such as an inappropriate file type or a missing codec.

    Try checking what gets returned from .ExtendedProperty("System.ThumbnailStream") which might be Nothing, Empty, or Null.

  14. #14
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    379

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

    Quote Originally Posted by dilettante View Post
    The sample code doesn't have any error checking. I suspect there is something about the file you provided that prevents fetching System.ThumbnailStream, such as an inappropriate file type or a missing codec.

    Try checking what gets returned from .ExtendedProperty("System.ThumbnailStream") which might be Nothing, Empty, or Null.
    you are right .thanks

  15. #15

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2010
    Posts
    483

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

    I have tried the solution provided by dilettante and it works perfectly for me. (Thanks dilettante)
    It takes 160 milliseconds on average to show the thumbnail of a video.

    I may also want to try the other solution provided by fafalone (post #7), as he says it would be faster. (Thanks fafalone)
    Before I go ahead and try fafalone's proposed solution, does anybody know how much faster it would be?

    For example if dilettante's solution shows a video thumbnail in 160 milliseconds, will fafalone's solution show the same thumbnail in 100 milliseconds? 50 milliseconds? 10 milliseconds? or what?
    Any rough idea would be good.

    Also, how stable is that mIID.bas?
    How often does it change?

    Please advise.
    Thanks.
    Ilia

  16. #16
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,410

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

    It will probably depend more on the size and format of the video more than anything else.

    Explorer caches thumbnails, so if the cached thumbnail is available the IShellItemImageFactory->HBitmapToPictureBox method in mine will show it in <=15ms.

    AVI's were all over the place for new generation, but close enough to be negligible for one offs (are you going to adapt this to bulk generation or something? displaying to a user in a picturebox one at a time it won't much matter if its 1500ms or 1800ms).

    MP4s I couldn't compare, guess I don't have the right codec. (Explorer thumbnails are entirely disabled on my system so there's no image being generated there either)



    My code earlier in the thread is really about the Preview Pane inside the browser control. If your system thumbnails are enabled I don't think you even need to do anything extra to see the video thumbnails (besides have ExtendedThumbnails property = True, which it is by default).

    If you need to render to a picturebox outside the control, this is the method that it uses:

    Code:
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
    Private Declare Function ImageList_Create Lib "comctl32.dll" (ByVal CX As Long, ByVal CY As Long, ByVal Flags As IL_CreateFlags, ByVal cInitial As Long, ByVal cGrow As Long) As Long
    Private Declare Function ImageList_Add Lib "comctl32.dll" (ByVal himl As Long, ByVal hbmImage As Long, ByVal hBMMask As Long) As Long
    Private Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hdcDst As Long, ByVal X As Long, ByVal Y As Long, ByVal fStyle As IL_DrawStyle) As Boolean
    Private Declare Function ImageList_Destroy Lib "comctl32.dll" (ByVal himl As Long) As Boolean
    Private Enum IL_CreateFlags
      ILC_MASK = &H1
      ILC_COLOR = &H0
      ILC_COLORDDB = &HFE
      ILC_COLOR4 = &H4
      ILC_COLOR8 = &H8
      ILC_COLOR16 = &H10
      ILC_COLOR24 = &H18
      ILC_COLOR32 = &H20
      ILC_PALETTE = &H800                  ' (no longer supported...never worked anyway)
      '5.0
      ILC_MIRROR = &H2000
      ILC_PERITEMMIRROR = &H8000
      '6.0
      ILC_ORIGINALSIZE = &H10000
      ILC_HIGHQUALITYSCALE = &H20000
    End Enum
    
    Private Enum IL_DrawStyle
      ILD_NORMAL = &H0
      ILD_TRANSPARENT = &H1
      ILD_MASK = &H10
      ILD_IMAGE = &H20
    '#If (WIN32_IE >= &H300) Then
      ILD_ROP = &H40
    '#End If
      ILD_BLEND25 = &H2
      ILD_BLEND50 = &H4
      ILD_OVERLAYMASK = &HF00
     
      ILD_SELECTED = ILD_BLEND50
      ILD_FOCUS = ILD_BLEND25
      ILD_BLEND = ILD_BLEND50
    End Enum
    
    
    Private Type BITMAP
        BMType As Long
        BMWidth As Long
        BMHeight As Long
        BMWidthBytes As Long
        BMPlanes As Integer
        BMBitsPixel As Integer
        BMBits As Long
    End Type
    
    Public Sub SetPreviewPictureWithHBITMAP(picturebox As Object, hBmp As Long, Optional bDestroy As Boolean = False)
    picturebox.Cls
    hBitmapToPictureBox picturebox, hBmp
    picturebox.Refresh
    If bDestroy Then
        DeleteObject hBmp
    End If
    End Sub
    Private Sub hBitmapToPictureBox(picturebox As Object, hBitmap As Long, Optional X As Long = 0&, Optional Y As Long = 0&)
    
    'This or similar is always given as the example on how to do this
    'But it results in transparency being lost
    'So the below method seems a little awkward, but it works. It can
    'be done without the ImageList trick, but it's much more code
    Dim himlBmp As Long
    Dim tBMP As BITMAP
    Dim CX As Long, CY As Long
    Call GetObject(hBitmap, LenB(tBMP), tBMP)
    CX = tBMP.BMWidth
    CY = tBMP.BMHeight
    If CX = 0 Then
        Debug.Print "Invalid Image"
        Exit Sub
    End If
    himlBmp = ImageList_Create(CX, CY, ILC_COLOR32, 1, 1)
    
    ImageList_Add himlBmp, hBitmap, 0&
    If (X = 0) And (Y = 0) Then
        'not manually specified, so center
        If CY < picturebox.ScaleHeight Then
            Y = ((picturebox.ScaleHeight - CY) / 2) '* Screen.TwipsPerPixelY
        End If
        If CX < picturebox.ScaleWidth Then
            X = ((picturebox.ScaleWidth - CX) / 2) '* Screen.TwipsPerPixelX
        End If
    End If
    
    ImageList_Draw himlBmp, 0, picturebox.hDC, X, Y, ILD_NORMAL
    
    ImageList_Destroy himlBmp
    End Sub

  17. #17
    Frenzied Member
    Join Date
    Apr 2012
    Posts
    1,113

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

    Just did some testing with this (nothing extensive, I'll add - about half a dozen files). Dil's method is faster, it seems (factor ~2?).

    That is...

    Dil: Extract image in its native size and then resize to target dimensions
    versus
    faf: Extract image in the target dimensions

    None of the files tested had thumbnail images cached. In cases where they were, faf's code is much faster (naturally enough). Also, when calling faf's method with the target dimensions deliberately set to the native width and height (thereby eliminating the resizing element, presumably), Dil's code remains ~twice as fast...
    If you don't know where you're going, any road will take you there...

    My VB6 love-children: Vee-Hive and Vee-Launcher

  18. #18

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2010
    Posts
    483

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

    Quote Originally Posted by fafalone View Post
    It will probably depend more on the size and format of the video more than anything else.
    ...
    I am also experimenting with Fafalone's code.
    I copied GetFileThumbnail from his post #7 and hBitmapToPictureBox from his post #16 (because the one in post #16 looks more complete).
    And I call them as follows (Not sure what those two parameters CX and CY are.):

    Code:
       Dim hBitmap         As Long
       VIDEO_FILE = "C:\MyFiles\MyVids\Music\Classical-Music\J.S. Bach - St. Matthew Passion, BWV 244 _ Aria- -Erbarme dich, mein Gott.mp4"
       hBitmap = GetFileThumbnail(VIDEO_FILE, 0, Picture1.Width, Picture1.Height)
       Call hBitmapToPictureBox(Picture1, hBitmap)
    This does NOTHING. The picturebox doesn't show anything.

    I then change it to the following:
    Code:
       Dim hBitmap         As Long
       VIDEO_FILE = "C:\MyFiles\MyVids\Music\Classical-Music\J.S. Bach - St. Matthew Passion, BWV 244 _ Aria- -Erbarme dich, mein Gott.mp4"
       hBitmap = GetFileThumbnail(VIDEO_FILE, 0, 0, 0)
       Call hBitmapToPictureBox(Picture1, hBitmap)
    This one too does NOTHING. The picturebox doesn't show anything
    Please help.
    Thanks.

  19. #19
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,410

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

    Did you change the picturebox's AutoRedraw property to True? Probably want to change ScaleMode to vbPixel as well. These are on the design-time Properties box like where the Name is.


    And also see the SetPreviewPictureWithHBITMAP function that's setting it in my code?
    Code:
    picturebox.Cls
    hBitmapToPictureBox picturebox, hBmp
    picturebox.Refresh
    (Don't forget the DeleteObject call when you're done with the hbitmap as well.)

    And cx and cy are width/height. You definitely don't want a 0x0 image. Gotta change that picturebox scalemode to vbPixels if you're using picturebox.width/height as the size too, or you'll get a giant image.

  20. #20

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2010
    Posts
    483

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

    Quote Originally Posted by fafalone View Post
    Did you change the picturebox's AutoRedraw property to True? Probably want to change ScaleMode to vbPixel as well. These are on the design-time Properties box like where the Name is.


    And also see the SetPreviewPictureWithHBITMAP function that's setting it in my code?
    Code:
    picturebox.Cls
    hBitmapToPictureBox picturebox, hBmp
    picturebox.Refresh
    (Don't forget the DeleteObject call when you're done with the hbitmap as well.)

    And cx and cy are width/height. You definitely don't want a 0x0 image. Gotta change that picturebox scalemode to vbPixels if you're using picturebox.width/height as the size too, or you'll get a giant image.
    Thanks.
    I did all the above.
    I changed Picturebox's AutoRedraw to True.
    I changed its scalemode to Pixels.
    And changed the code as follows:
    Code:
       VIDEO_FILE = "C:\MyFiles\MyVids\Music\Classical-Music\J.S. Bach - St. Matthew Passion, BWV 244 _ Aria- -Erbarme dich, mein Gott.mp4"
    
       Picture1.Cls
       hBitmap = GetFileThumbnail(VIDEO_FILE, 0, Picture1.Width, Picture1.Height)
       Call hBitmapToPictureBox(Picture1, hBitmap)
       Picture1.Refresh
       DeleteObject hBitmap
    This produces a very large thumbnail (far larger than the Picturebox). Therefore the Picturebox shows only a small part of the thumbnail's top-left corner.

    Now, if I go to design mode and hugely enlarge the Picturebox in design mode, and run again, it again produces a very large thumbnail. This time the thumbnail shows completely inside the Picturebox, but the thumbnail's size is smaller than the Picturebox (because now the Picturebox is huge)

    I don't know how to get it to show the thumbnail properly resized to fit the Picturebox.
    Please note that the Picturebox's dimensions are to remain fixed. The thumbnail should be produced in the right size to fit the Picturebox.

    Please advise.
    Thanks.

  21. #21
    PowerPoster
    Join Date
    Feb 2006
    Posts
    20,869

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

    Here's a version wrapped around the OleLoadPicture() API call and VB's PaintPicture() method for scaling the thumbnail. This might fail if a PNG video thumbnail gets returned but that doesn't seem to be the case, at least in my tests. See the comments.

    In case I wasn't clear: This is just a demonstration, but one you don't want to rely on. OleLoadPicture() is too limited for general use with thumbnails. For example a folder containing PNG image files won't work.

    It also dumps a number of thumbnails for a folder of videos into a one-column MSHFlexGrid (instead of just one into a PictureBox).

    So no WIA 2.0, and no GDI+ usage at all.

    Code:
    Option Explicit
    
    'NOTES
    '
    '   o Picture1: Appearance flat, BorderStyle none, Visible false (used as a canvas for
    '               image resizing via PaintPicture).
    '
    '               Could be visible if you use it for displaying a single thumbnail and
    '               skip the MSHFlexGrid.
    '
    '   o Could use a ListView with ImageList instead of the MSHFlexGrid to display
    '     multiple thumbs.  The FlexGrid was just a simpler alternative for demo purposes.
    '
    '   o The call to OleLoadPicture() might fail if Shell32 returned an unsupported image
    '     type like PNG!  So far I haven't see it fail though.
    '
    '   o Form1 and MSHFlexGrid1 have the same Font so we can use Form1.TextHeight() to
    '     measure text to put into cells.
    
    'Hard-coded test values:
    Private Const VIDEO_FOLDER As String = "D:\Some Videos"
    Private Const THUMB_WIDTH As Single = 276 'Pixels, just a size that fit my Form1.
    Private Const THUMB_HEIGHT As Single = 207
    
    Private Const S_OK As Long = 0
    
    Private Type IID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(0 To 7) As Byte
    End Type
    
    Private Declare Function CLSIDFromString Lib "ole32" ( _
        ByVal psz As Long, _
        ByRef clsid As IID) As Long
    
    Private Declare Function OleLoadPicture Lib "oleaut32" ( _
        ByVal IStream As stdole.IUnknown, _
        ByVal Size As Long, _
        ByVal Runmode As Long, _
        ByRef IID As IID, _
        ByRef IPicture As stdole.IPicture) As Long
    
    Private ThumbWidthTwips As Single
    Private ThumbHeightTwips As Single
    
    Private Sub Form_Load()
        Dim iidIPicture As IID
        Dim Folder As Object
        Dim ShellFolderItem As Object
        Dim IStream As stdole.IUnknown
        Dim IPicture As stdole.IPicture
        Dim AspectRatio As Double
        Dim Row As Long
    
        CLSIDFromString StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), iidIPicture
        ThumbWidthTwips = ScaleX(THUMB_WIDTH, vbPixels, vbTwips)
        ThumbHeightTwips = ScaleY(THUMB_HEIGHT, vbPixels, vbTwips)
    
        With MSHFlexGrid1
            .Cols = 1
            .FixedCols = 0
            .Rows = 1
            .FixedRows = 0
            .ColWidth(0) = ThumbWidthTwips + ScaleX(4, vbPixels, vbTwips) 'Borders.
            Set Folder = CreateObject("Shell.Application").NameSpace(VIDEO_FOLDER)
            For Each ShellFolderItem In Folder.Items
                If Not (ShellFolderItem.IsFolder Or ShellFolderItem.IsLink) Then
                    Set IStream = Nothing
                    On Error Resume Next
                    Set IStream = ShellFolderItem.ExtendedProperty("System.ThumbnailStream")
                    On Error GoTo 0
                    If Not IStream Is Nothing Then
                        If OleLoadPicture(IStream, 0, False, iidIPicture, IPicture) = S_OK Then
                            If Row > 0 Then .Rows = Row + 1
                            .Row = Row
                            .CellPictureAlignment = flexAlignCenterBottom
                            With Picture1
                                AspectRatio = CDbl(IPicture.Width) / CDbl(IPicture.Height)
                                If ThumbWidthTwips / AspectRatio > ThumbHeightTwips Then
                                    .Width = Int(ThumbHeightTwips * AspectRatio + 0.5)
                                    .Height = ThumbHeightTwips
                                Else
                                    .Width = ThumbWidthTwips
                                    .Height = Int(ThumbWidthTwips / AspectRatio + 0.5)
                                End If
                                .AutoRedraw = True
                                .Cls
                                .PaintPicture IPicture, 0, 0, .ScaleWidth, .ScaleHeight
                                .AutoRedraw = False
                                MSHFlexGrid1.RowHeight(Row) = _
                                        .ScaleHeight _
                                      + ScaleY(4, vbPixels, vbTwips) _
                                      + ScaleY(TextHeight("Wgyj"), ScaleMode, vbTwips)
                                Set MSHFlexGrid1.CellPicture = .Image
                            End With
                            .CellAlignment = flexAlignCenterTop
                            .Text = ShellFolderItem.Name
                            Row = Row + 1
                        End If
                    End If
                End If
            Next
        End With
        Caption = "Thumb count = " & CStr(Row)
    End Sub
    
    Private Sub Form_Resize()
        If WindowState <> vbMinimized Then
            MSHFlexGrid1.Move 0, 0, ScaleWidth, ScaleHeight
        End If
    End Sub
    Last edited by dilettante; Jun 17th, 2019 at 04:08 PM. Reason: added warning

  22. #22
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,410

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

    Quote Originally Posted by IliaPreston View Post
    Thanks.
    I did all the above.
    I changed Picturebox's AutoRedraw to True.
    I changed its scalemode to Pixels.
    And changed the code as follows:
    Code:
       VIDEO_FILE = "C:\MyFiles\MyVids\Music\Classical-Music\J.S. Bach - St. Matthew Passion, BWV 244 _ Aria- -Erbarme dich, mein Gott.mp4"
    
       Picture1.Cls
       hBitmap = GetFileThumbnail(VIDEO_FILE, 0, Picture1.Width, Picture1.Height)
       Call hBitmapToPictureBox(Picture1, hBitmap)
       Picture1.Refresh
       DeleteObject hBitmap
    This produces a very large thumbnail (far larger than the Picturebox). Therefore the Picturebox shows only a small part of the thumbnail's top-left corner.

    Now, if I go to design mode and hugely enlarge the Picturebox in design mode, and run again, it again produces a very large thumbnail. This time the thumbnail shows completely inside the Picturebox, but the thumbnail's size is smaller than the Picturebox (because now the Picturebox is huge)

    I don't know how to get it to show the thumbnail properly resized to fit the Picturebox.
    Please note that the Picturebox's dimensions are to remain fixed. The thumbnail should be produced in the right size to fit the Picturebox.

    Please advise.
    Thanks.
    Instead of Picture1.Width and Picture1.Height, pass Picture1.ScaleWidth and Picture1.ScaleHeight

  23. #23

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2010
    Posts
    483

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

    Quote Originally Posted by fafalone View Post
    Instead of Picture1.Width and Picture1.Height, pass Picture1.ScaleWidth and Picture1.ScaleHeight
    I did the above (I used Picture1.ScaleWidth and Picture1.ScaleHeight), and the problem is solved.
    The thumbnail is displayed with its width perfectly fitting the PictureBox's width.

    However a tiny bit of an issue is that the thumbnail's height is slightly shorter than the Picturebox's height.
    This is because the thumbnail image's aspect ratio is not the same as the Picturebox's aspect ratio.
    This code always makes the width of the thumbnail fit the Picturebox's width

    Then if the thumbnail's height is less than the Picturebox's height, two empty strips of horizontal space appear above and below the thumbnail inside the Picturebox.
    The other way around is that if the thumbnail's height is greater than the Picturebox's height, the thumbnail is cut-off vertically by the borders of the Picturebox.

    Now, I have to put some additional code at the end if the above code to change the Picturebox's height to fit the thumbnail's height
    But, I don't know how.
    Can you please help?

    Thanks.

  24. #24
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    18,597

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

    Then if the thumbnail's height is less than the Picturebox's height, two empty strips of horizontal space appear above and below the thumbnail inside the Picturebox.

    The other way around is that if the thumbnail's height is greater than the Picturebox's height, the thumbnail is cut-off vertically by the borders of the Picturebox.
    Since the image returned from IShellItemImageFactory is using the flag to proportionally scale the bitmap, sounds like it only cares about aspect ratio and not necessarily scaling to passed dimensions. Otherwise, the returned bitmap should never be larger than the requested dimensions. That 2nd statement above should never happen otherwise.

    You may want to tweak the hBitmapToPictureBox routine to ensure the passed bitmap is scaled to the passed picturebox, i.e.
    - get bitmap dimensions (already being done)
    - get picturebox dimensions (already being done)
    - scale bitmap to picturebox and create image list based on those scaled dimensions (not being done)

    untested, changes in blue...
    Code:
    Private Sub hBitmapToPictureBox(picturebox As Object, hBitmap As Long, _
                         Optional X As Long = 0&, Optional Y As Long = 0&, _
                         Optional CanUpScale As Boolean = False)
    
    'This or similar is always given as the example on how to do this
    'But it results in transparency being lost
    'So the below method seems a little awkward, but it works. It can
    'be done without the ImageList trick, but it's much more code
    Dim himlBmp As Long
    Dim tBMP As BITMAP
    Dim CX As Long, CY As Long
    Dim dblPri As Double, dblAlt As Double
    
    Call GetObject(hBitmap, LenB(tBMP), tBMP)
    CX = tBMP.BMWidth
    CY = tBMP.BMHeight
    If CX = 0 Then
        Debug.Print "Invalid Image"
        Exit Sub
    End If
    
    dblPri = picturebox.ScaleWidth / CX
    dblAlt = picturebox.ScaleHeight / CY
    If dblAlt < dblPri Then dblPri = dblAlt 
    If CanUpScale = False Then
        If dblPri > 1 Then dblPri = 1 ' keep 1:1 scale
    End If
    CX = CX * dblPri: CY = CY * dblPri
    
    himlBmp = ImageList_Create(CX, CY, ILC_COLOR32, 1, 1)
    
    ImageList_Add himlBmp, hBitmap, 0&
    If (X = 0) And (Y = 0) Then
        'not manually specified, so center
        If CY < picturebox.ScaleHeight Then
            Y = ((picturebox.ScaleHeight - CY) / 2) '* Screen.TwipsPerPixelY
        End If
        If CX < picturebox.ScaleWidth Then
            X = ((picturebox.ScaleWidth - CX) / 2) '* Screen.TwipsPerPixelX
        End If
    End If
    
    ImageList_Draw himlBmp, 0, picturebox.hDC, X, Y, ILD_NORMAL
    
    ImageList_Destroy himlBmp
    End Sub
    If the image is smaller than the picturebox, then the original code above centers it when X,Y passed as zero. Recommend setting the picturebox backcolor to some solid color to act as a border when image is smaller. If you absolutely need to resize the picturebox, you can do that. Ignore the modifications in blue above, and add code in there something like this, right before or after the "himlBmp = ImageList_Create(..)" line:
    Code:
    Dim cntCx As Single, cntCy As Single
    Dim cntSM As ScaleModeConstants
    
    With picturebox   ' assumption is that the picbox container is a form or another picbox
        cntSM = .Container.ScaleMode    ' handle User-defined scalemodes
        If cntSM = vbUser Then          ' cache current scale dimensions
            cntCx = .Container.ScaleWidth: cntCy = .Container.ScaleHeight
        End If
        .Container.ScaleMode = .ScaleMode
        .Move .Left, .Top, CX + .Width - .ScaleWidth, CY + .Height - .ScaleHeight
        If cntSM = vbUser Then          ' restore original scale dimensions
            .Container.ScaleWidth = cntCx: .Container.ScaleHeight = cntCy
        Else
            .Container.ScaleMode = cntSM ' restore original scalemode
        End If
    End With
    Edited: I personally would opt to scale the image. I don't like the idea of resizing controls based on measurements outside of my control, unless you add code to prevent unreasonable sizes.
    Last edited by LaVolpe; Jun 17th, 2019 at 10:22 AM.
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  25. #25

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2010
    Posts
    483

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

    Quote Originally Posted by fafalone View Post
    ......

    And also see the SetPreviewPictureWithHBITMAP function that's setting it in my code?
    Code:
    picturebox.Cls
    hBitmapToPictureBox picturebox, hBmp
    picturebox.Refresh
    (Don't forget the DeleteObject call when you're done with the hbitmap as well.)

    ......
    I am using the code that you provided in post #16.
    Thanks for your help.

    Let me see if I have understood this right or not.
    Here is how I use DeleteObject:
    Code:
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Code:
    Public Sub SetPreviewPictureWithHBITMAP(picturebox As Object, hBmp As Long, Optional bDestroy As Boolean = False)
    picturebox.Cls
    hBitmapToPictureBox picturebox, hBmp
    picturebox.Refresh
    If bDestroy Then
        DeleteObject hBmp
    End If
    End Sub
    Code:
          Thumbnail_P_B.Cls
          hBitmap = GetFileThumbnail(Video_File_Path, 0, Thumbnail_P_B.ScaleWidth, Thumbnail_P_B.ScaleHeight)
          Call hBitmapToPictureBox(Thumbnail_P_B, hBitmap)
          Thumbnail_P_B.Refresh
          DeleteObject hBitmap
    Is that all you mean?
    Or should I call it elsewhere as well?


    Also, somebody suggested that I can cache the thumbnails, and re-use them, and that at the end when I no longer need to re-use them, I need to delete those cached thumbnails.
    I don't know how to do that.
    A. How can I cache thumbnails for later re-use?
    B. How do I re-use cached thumbnails?
    C. How do I delete cached thumbnails in the end?

    Please advise.
    Thanks.
    Ilia

  26. #26

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2010
    Posts
    483

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

    Any comment or response to my post #25 (the post right above this) would be greatly appreciated.

    Thanks in advance.
    Ilia

  27. #27
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,601

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

    Quote Originally Posted by IliaPreston View Post
    Any comment or response to my post #25 (the post right above this) would be greatly appreciated.
    You might want to test the cGDIPlusCache-Class (which is not dependent on RC5).
    It comes with support for ShellItem-Image-Rendering - and (as the Class-name states already),
    will support caching of Image-Resources under arbitrary String-Keys.

    http://www.vbforums.com/showthread.p...-cls-revisited

    Just include cGDIPlusCache.cls into your project, and then try whether the following works
    (untested on my end)...

    Code:
    Option Explicit
    
    Private GC As New cGDIPlusCache
    
    Private Sub Form_Click()
      Const Video_File_Path As String = "c:\temp\test.mp4"
      
      Thumbnail_P_B.AutoRedraw = True
      Thumbnail_P_B.ScaleMode = vbPixels
      Thumbnail_P_B.Cls
        GC.AddFromShell "My_MP4_Vid_Key", Video_File_Path, Thumbnail_P_B.ScaleHeight
        GC.DrawImage Thumbnail_P_B.hDC, "My_MP4_Vid_Key"
      Thumbnail_P_B.Refresh
    End Sub
    HTH

    Olaf

  28. #28

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2010
    Posts
    483

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

    Quote Originally Posted by Schmidt View Post
    You might want to test the cGDIPlusCache-Class (which is not dependent on RC5).
    It comes with support for ShellItem-Image-Rendering - and (as the Class-name states already),
    will support caching of Image-Resources under arbitrary String-Keys.

    http://www.vbforums.com/showthread.p...-cls-revisited

    Just include cGDIPlusCache.cls into your project, and then try whether the following works
    (untested on my end)...

    Code:
    Option Explicit
    
    Private GC As New cGDIPlusCache
    
    Private Sub Form_Click()
      Const Video_File_Path As String = "c:\temp\test.mp4"
      
      Thumbnail_P_B.AutoRedraw = True
      Thumbnail_P_B.ScaleMode = vbPixels
      Thumbnail_P_B.Cls
        GC.AddFromShell "My_MP4_Vid_Key", Video_File_Path, Thumbnail_P_B.ScaleHeight
        GC.DrawImage Thumbnail_P_B.hDC, "My_MP4_Vid_Key"
      Thumbnail_P_B.Refresh
    End Sub
    HTH

    Olaf
    Thanks a lot for the great help and the great GDI class module.

    I just used it and copied your code (with minuscule changes such as name of the picturebox, name of the video file, etc.)
    Code:
    Private Sub cmdShowVidThumbnail_Click()
      Const Video_File_Path      As String = "D:\MyFiles\MyVids\Music\Classical-Music\D.Scarlatti - Fandango.mp4"
      
      picThumbnail1.AutoRedraw = True
      picThumbnail1.ScaleMode = vbPixels
      picThumbnail1.Cls
        GC.AddFromShell "My_MP4_Vid_Key", Video_File_Path, picThumbnail1.ScaleHeight
        GC.DrawImage picThumbnail1.hDC, "My_MP4_Vid_Key"
      picThumbnail1.Refresh
    End Sub
    It works.
    It shows the thumbnail. But there are two problems:
    1. It does not resize the image to fit the picture box.
    2. It does not center-justify the image inside the picturebox.
    Here is a screen print:
    https://i.imgur.com/s8u0aJ5.jpg

    How can I change my code to show the thumbnail in the right size (to fit perfectly inside the picturebox) and center-justified inside the picturebox?
    Please note that what I want to do may leave two horizontal strips of empty space below and above the thumbnail if the thumanail's width is greater than its height, or will leave two vertical strips of empty space to the left and right of the thumbnail if the thumanail's height is greater than its width.
    And those two strips of empty space inside the picturebox are ok with me.

    Please advise.
    thanks.
    Ilia

  29. #29
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    2,410

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

    Quote Originally Posted by IliaPreston View Post
    I am using the code that you provided in post #16.
    Thanks for your help.

    Let me see if I have understood this right or not.
    Here is how I use DeleteObject:
    Code:
    Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    Code:
    Public Sub SetPreviewPictureWithHBITMAP(picturebox As Object, hBmp As Long, Optional bDestroy As Boolean = False)
    picturebox.Cls
    hBitmapToPictureBox picturebox, hBmp
    picturebox.Refresh
    If bDestroy Then
        DeleteObject hBmp
    End If
    End Sub
    Code:
          Thumbnail_P_B.Cls
          hBitmap = GetFileThumbnail(Video_File_Path, 0, Thumbnail_P_B.ScaleWidth, Thumbnail_P_B.ScaleHeight)
          Call hBitmapToPictureBox(Thumbnail_P_B, hBitmap)
          Thumbnail_P_B.Refresh
          DeleteObject hBitmap
    Is that all you mean?
    Or should I call it elsewhere as well?


    Also, somebody suggested that I can cache the thumbnails, and re-use them, and that at the end when I no longer need to re-use them, I need to delete those cached thumbnails.
    I don't know how to do that.
    A. How can I cache thumbnails for later re-use?
    B. How do I re-use cached thumbnails?
    C. How do I delete cached thumbnails in the end?

    Please advise.
    Thanks.
    Ilia
    You don't need to call DeleteObject twice.

    To reuse it, you just create the handle once and don't use DeleteObject until you're done with it.

  30. #30

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2010
    Posts
    483

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

    Quote Originally Posted by fafalone View Post
    You don't need to call DeleteObject twice.

    To reuse it, you just create the handle once and don't use DeleteObject until you're done with it.
    Thanks for the help.
    And:
    A. How can I cache thumbnails for later re-use?
    B. How do I re-use cached thumbnails?
    C. How do I delete cached thumbnails in the end?

    Thanks.
    Ilia

  31. #31

  32. #32

    Thread Starter
    Hyperactive Member
    Join Date
    Mar 2010
    Posts
    483

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

    Any response to my post #28 would be greatly appreciated.
    I am trying to fix this problem:
    https://i.imgur.com/s8u0aJ5.jpg
    That is, (using the technique that was provided in post#27) I need to make the thumbnail show center-justified and be the correct size (fit the picturebox).
    I don't know how to do that.

    Please help.
    Thanks

  33. #33
    PowerPoster
    Join Date
    Jun 2013
    Posts
    4,601

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

    Quote Originally Posted by IliaPreston View Post
    Any response to my post #28 would be greatly appreciated.
    ...
    I need to make the thumbnail show center-justified and be the correct size (fit the picturebox).
    I don't know how to do that.
    The cGDIPlusCache.DrawImage method has additional (optional x, y, ...) Params to offer.
    IMO you need to play around more with IntelliSense.
    (I often just "type an extra space" in between Params for a fast lookup of a Method-Defs ParamList).

    And as for "how to calculate centered Offsets".
    I think you're programming long enough, to have seen this "halfed-difference" thing a few times:
    x = (ContainerObj.Width - ObjToCenter.Width) / 2 'same for y-Offsets with the Heights

    Here's the caching-code again, which now does that...

    Code:
    Option Explicit
    
    Private GC As New cGDIPlusCache
    
    Private Sub Form_Click()
      CacheAndRenderThumb "c:\temp\test.avi", Thumbnail_P_B
    End Sub
    
    Private Sub CacheAndRenderThumb(FileName As String, PB As PictureBox)
      PB.AutoRedraw = True
      PB.Cls
      PB.ScaleMode = vbPixels
        Dim Key As String, x As Long, y As Long
            Key = Mid$(FileName, InStrRev(FileName, "\") + 1)
        If Not GC.Exists(Key) Then GC.AddFromShell Key, FileName, PB.ScaleWidth
        x = (PB.ScaleWidth - GC.Width(Key)) / 2
        y = (PB.ScaleHeight - GC.Height(Key)) / 2
        GC.DrawImage PB.hDC, Key, x, y
      PB.Refresh
    End Sub
    Olaf

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