List1有数千张图片地址
For I = 0 To List1.ListCount - 1
                If CC1 Then
                    Exit For
                Else
                    Image1.Picture = LoadPicture(List1.List(I))
                End If
                Me.Caption = CStr(I + 1) & "/" & List1.ListCount
                DoEvents
            Next I
以上代码可执行，就是太慢。

For I = 0 To List1.ListCount - 1
                If CC1 Then
                    Exit For
                Else
                    Image1.Picture = LoadPicture(List1.List(I))          载入图像
                End If
                Me.Caption = CStr(I + 1) & "/" & List1.ListCount        显示当前是第几个图像
                DoEvents
            Next I          继续循环？？？

你要干什么？  看代码是每次把这几千张图像全部重新加载一遍。能不慢吗

浏览图片，相当于看视频的效果。我相过预加载入内存，但太大了。

那没办法。这样做的码率太高了，硬盘、内存、CPU，什么的跟不上。
你可以计算一下，1张1080p的图像的大小，大约在1.85M左右。
按每秒25帧计算，每小时共3600秒，数据总量约 166500M，约为 162G
而一小时的1080p mp4 视频多大呢？ 约1.2G。

这也就是为什么要开发运动图像压缩算法的原因之一，所以你想加载图像来相当于看视频的方式是不可行的，速度太慢了。
--------------
你电脑上测试一下你这个方案可行不可行。使用Windows自带的看图软件打开第一张图，然后按住 键盘上的 翻页键 不放，意思就是图像载入完成后立即向后翻页，
然后你看一下，与视频还是有差跟吧。这个看图软件效果基本上就是你这个电脑使用载入图像来相当于看视频 的最快速度了。

为什么游戏素材是每个图像占一张，然后拼成一个大格子，而不是每次都是 临时从硬盘上读呢，也是这个原因，根本读不过来。

谢谢您了！
测试过存入PropertyBag最多只能300张。

窗体一个Image，一个Lits。代码如下：
Option Explicit
Dim CC1 As Boolean

Private Sub Find1(MyPath As String)
    On Error Resume Next
    Dim Myname As String
    Dim dir_i() As String
    Dim I As Long
    Dim S As String
    Dim idir As Long
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath + "\"
    Myname = Dir(MyPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
    Do While Myname <> ""
        If Myname <> "." And Myname <> ".." Then
            If (GetAttr(MyPath & Myname) And vbDirectory) = vbDirectory Then
                idir = idir + 1
                ReDim Preserve dir_i(idir) As String
                dir_i(idir - 1) = Myname
            Else
                S = UCase$(Right$(Myname, Len(Myname) - InStrRev(Myname, ".")))
                If S = "JPG" Then List1.AddItem MyPath & Myname
                If List1.ListCount > 32760 Then Exit Sub
            End If
        End If
        Myname = Dir
        'DoEvents
    Loop
    For I = 0 To idir - 1
        Call Find1(MyPath + dir_i(I))
    Next I
    ReDim dir_i(0) As String
End Sub

Private Sub Form_Load()
    List1.Visible = False
    CC1 = True
End Sub

Private Sub Form_Resize()
    If Me.WindowState <> 1 Then
        Image1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
        List1.Move 0, 0
    End If
    Me.Caption = CStr(Me.ScaleWidth \ 10) & "x" & CStr(Me.ScaleHeight \ 10)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    CC1 = True
End Sub

Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim I As Integer
    If Button = 1 Then
        CC1 = Not CC1
        If List1.ListCount > 0 Then
            For I = 0 To List1.ListCount - 1
                If CC1 Then
                    Exit For
                Else
                    Image1.Picture = LoadPicture(List1.List(I))
                End If
                Me.Caption = CStr(I + 1) & "/" & List1.ListCount
                DoEvents
            Next I
        End If
        CC1 = True
    ElseIf Button = 2 Then
        List1.Visible = Not List1.Visible
    End If
End Sub

Private Sub Image1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    Dim T1 As String
    Dim S As String
    Dim I As Integer
    For I = 1 To Data.Files.Count
        T1 = Data.Files(I)
        If (GetAttr(T1) And vbDirectory) = vbDirectory Then
            Find1 T1
        Else
            S = UCase$(Right$(T1, Len(T1) - InStrRev(T1, ".")))
            If S = "JPG" Then List1.AddItem T1
        End If
    Next
    Me.Caption = List1.ListCount
End Sub


Private Sub List1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        CC1 = True
        List1.Clear
        Me.Caption = "0"
    End If
End Sub