高分请教：如何能在PictureBox中飞快的画出图片

private picP as picture
set picP = loadpicture(......)
picture1.picture = picP
picture2.picture = picP
....
....
.....
试试这样行吗?

有人建议我用bitblt。可是我不会用啊。请教一下：
我现在有个图片变量，一个PictureBox：
Dim pTempPic As StdPicture1.Form_Load时，我将一副图片给pTempPic；
2.我怎么用bitblt这个方法把pTempPic的图片画到PictureBox里去？

创建一个与picturebox兼容的内存dc
hmemdc=CreateCompatibleDC(picture1.hdc)
创建一个与memdc兼容的位图
hbmp=CreateCompatibleBitmap(hmemdc, nWidth, nHeight）
将位图选入该设备
holdbmp=SelectObject( hmemdc, hbmp)
调用画图函数
drawxx
将memdc内容复制到picturebox上
BitBlt picturebox1.hdc, 0,0, nWidth, nHeight, hmemdc, 0, 0, SRCCOPY
释放相关资源
DeleteObject hbmp
DeleteObject hmemdc

写错了,picturebox1与picture1应该一样

【声明】
Public Declare Function BitBlt Lib "gdi32" Alias "BitBlt" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
【说明】
将一幅位图从一个设备场景复制到另一个。源和目标DC相互间必须兼容
【返回值】
Long，非零表示成功，零表示失败。会设置GetLastError
【参数表】
hDestDC -------- Long，目标设备场景 x,y ------------ Long，对目标DC中目标矩形左上角位置进行描述的那个点。用目标DC的逻辑坐标表示 nWidth,nHeight - Long，欲传输图象的宽度和高度 hSrcDC --------- Long，源设备场景。如光栅运算未指定源，则应设为0 xSrc,ySrc ------ Long，对源DC中源矩形左上角位置进行描述的那个点。用源DC的逻辑坐标表示 dwRop ---------- Long，传输过程要执行的光栅运算
【其它】
在NT环境下，如在一次世界传输中要求在源设备场景中进行剪切或旋转处理，这个函数的执行会失败
如目标和源DC的映射关系要求矩形中像素的大小必须在传输过程中改变，那么这个函数会根据需要自动伸缩、旋转、折叠、或切断，以便完成最终的传输过程

在我的机器上加载１００个同样的位图只要　13　毫秒左右
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Option Explicit
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop 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 timeGetTime Lib "winmm.dll" () As LongConst LR_LOADFROMFILE = &H10
Const IMAGE_BITMAP = 0
Const LR_CREATEDIBSECTION = &H2000
Private Type BITMAP '14 bytes
        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 Form_Click()
Dim hMemdc As Long, hbmp As Long, holdbmp As Long, hBitmap As Long
Dim bm As BITMAP
Dim i As Integer
Dim oTime As String
oTime = timeGetTimehBitmap = LoadImage(App.hInstance, App.Path + "\1.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
For i = 0 To 99
    hMemdc = CreateCompatibleDC(Picture1(i).hdc)
    SelectObject hMemdc, hBitmap
    GetObject hBitmap, Len(bm), bm
    BitBlt Picture1(i).hdc, 0, 0, bm.bmWidth, bm.bmHeight, hMemdc, 0, 0, vbSrcCopy
    DoEvents
    DeleteDC hMemdc
NextMsgBox "耗时" + CStr(timeGetTime - oTime) + "毫秒"
End SubPrivate Sub Form_Load()
Dim i As Integer
For i = 1 To 99
    Load Picture1(i)
    Picture1(i).Left = Picture1(i - 1).Left + 100
    Picture1(i).Top = Picture1(i - 1).Top + 100
    Picture1(i).Width = Picture1(i - 1).Width
    Picture1(i).Height = Picture1(i - 1).Height
    Picture1(i).BackColor = &H8000000F
    Picture1(i).Visible = True
    DoEvents
Next
End Sub

wxy_xiaoyu(☆然也☆╭∩╮(︶︿︶)╭∩╮)的代码我研究过了。好像这种用BitBlt画上去的图片和我的需求还有一些出入。
情况如下：
我有十几个PictureBox是叠加的。我在Form_load()事件里写了上面的代码，然后用Command1_Click()事件来控制这十几个PictureBox的Zorder的位置。出现一个问题，就是当原先置后的PictureBox变为置前时，原先画上去的Picture都没有了！

老大，我只是给你个例子，你就不会融会贯通？？？
你把它写在 picturebox 的paint 事件里呀方法总会有的，我又不能给你做好

估计只要设置AutoRedraw为True即可。另外，如果是全部打开，然后设置可见属性，似乎根本没有必要那么做的，又浪费资源，又使程序过于复杂，效果未必理想的。

to : lazycat818(lazycat818) 复杂吗？浪费资源吗？你仔细看过了？有时候在特定的情况下，提高程序运行效率是个很重要的事情．你可以用我的代码试试花费的时间和系统资源到底有多少．你可以自己去写个代码加载100个图片所需要的时间和资源．比较一下再得结论，不要信口雌黄

共用图片！！！让一个PICTUREBOX先调用，然后其他=PICTUREBOX1。PICTURE

wxy_xiaoyu(☆然也☆╭∩╮(︶︿︶)╭∩╮) 你知道Paint方法的使用，会占用多少系统资源哇！？
其实，你说的意思我明白的。但是我的窗体里的名称一点都不相同，我没有办法去循环或根据Index进行处理。我总不能在每一个PictureBox的.Zorder事件下面都调用这个方法吧？所以，希望有更简便的方法啊。谢啦！

Dickson(沧海冷心)及所有朋友，我的图片是一定要画上去的。所以，得不到.picture这个值的。

to exiong:
    如何得到.picture,你可以在画图时设置AutoRedraw为True，画好后，如果想马上看，应该refresh一下(不看的画，比如它本身就是不可见的，根据你的意思，它本来应该是不可见的)。然后最好设置AutoRedraw为false(节约资源！).然后在单击按钮时，设置Picture2.Picture = Picture1(0).Image  （picture2为需要显示的图片），由于你的图片一样，每次虽然有点闪动，但应该很不明显的。另外在第一次赋值后可以设置Picture2.tag=1.
表示已经加载图片，在第二次显示时检查tag值，就可以不用重新加载。
     采用这种办法，就可以省去用API的烦恼。
     我认为VB程序员离不开API，但也绝不是让API充斥你的程序！！！
     我的观点：慢，就让它分散执行.███████████████████████████████████████to wxy_xiaoyu(☆然也☆╭∩╮(︶︿︶)╭∩╮):
阁下的程序我本来根本没有看过，上次的发言也没有征对阁下。看了您狂妄的言语以及特地发的短信。才看了一下。水平也不过尔尔，如果您还具有一个程序员应有的谦虚,请看: 1。为什么要反复调用
    hMemdc = CreateCompatibleDC(Picture1(i).hdc)
    SelectObject hMemdc, hBitmap
    GetObject hBitmap, Len(bm), bm以及DeleteDC hMemdc
    难道一次不行吗？
2。为什么要用设置top、left、width、height属性，而不用move一次完成？知道效率差多少吗？
3。难道代码的长短，就表示复杂与否？至少引入API降低了VB的安全性。
4。难道从根本方法上解决问题不如在局部代码上优化？
5。不说明机器配置和图片的大小，说个执行时间有什么意思？所以说，我是菜鸟，你也远非高手！奉劝阁下：谦虚！谦虚！再谦虚！！！，不要一上来左一个问号，右一个问号，最后加上一句“信口雌黄”，好像除了bill gates，就是阁下您了（我想您老人家还不至于认为自己是第一吧？）。
大力提倡谦虚！！！学习，学习，再学习！！！心平气和，探讨问题。

to exiong:放在paint事件中肯定不行，我试过的，但我放弃了，原因已经记不清楚了，好像是如果它被覆盖，比如一个msgBox，移动msgBox，图形会被擦调，但还是不会马上重绘。直到窗口又被激活时才重绘。Dim p As IPictureDisp

Set p = LoadPicture(App.Path + "\1.bmp")

Picture2.Picture = p试一下？如果要做到保存图片，这种方法说不定还快过API.

to lazycat818(lazycat818):
你这个人真是莫名其妙！我不谦虚？好！就算我不谦虚，你知道我为什么要对你说这样的话？
“估计只要设置AutoRedraw为True即可。另外，如果是全部打开，然后设置可见属性，似乎根本没有必要那么做的，又浪费资源，又使程序过于复杂，效果未必理想的。”因为见多了象你这样没有实际作过就在这里发表意见的人，实在是有点看不惯！你说到现在根本就没有看懂我的代码，即使没有什么难度，你不得不承认你还是看不懂！！ 1。为什么要反复调用
    hMemdc = CreateCompatibleDC(Picture1(i).hdc)
    SelectObject hMemdc, hBitmap
    GetObject hBitmap, Len(bm), bm以及DeleteDC hMemdc
    难道一次不行吗？
=================================================================
你不知道是针对每个图片框画图？？你看不懂Picture1(i).hdc里这个i的意思？你给我说说每句代码的意思然后写个不重复的的有效代码试试？“看了您狂妄的言语以及特地发的短信。才看了一下。水平也不过尔尔”，本来就是个及其简单的程序，能让你得出这样的结论，况且你还看不懂，到底谁的水平有问题？
2。为什么要用设置top、left、width、height属性，而不用move一次完成？知道效率差多少吗？
=================================================================
连这个帖子的问题都没有看清楚！！你知道楼主的问题是什么？是加载图片的效率！你完全可以手动在FORM上放100个图片框，那里需要写什么代码。我只是想免去手动的麻烦，让图片摆放整齐点才写的这些，当然可以用MOVE，但是这个跟本问题没有关系，所以不算在计时内。你非要咬文嚼字，可惜连问题的所在都没搞清楚，真是笑话！由此可见你逻辑思维糊涂！ 3。难道代码的长短，就表示复杂与否？至少引入API降低了VB的安全性。
=================================================================
谁告诉你“代码的长短，就表示复杂与否”？我说的？难道你理解的优化就是指代码的长短？井底之蛙！ “引入API降低了VB的安全性”，可笑的“一棍子打死”观点！孰不知没有API某些功能无法完成？孰不知楼主要求的就是用 API ？ 4。难道从根本方法上解决问题不如在局部代码上优化？
=================================================================
此观点根本就是风马牛不相及！这两点有在这里体现出矛盾么？我所说的都是“有些”情况，我从来没有一棍子打死什么东西。 5。不说明机器配置和图片的大小，说个执行时间有什么意思？
=================================================================
机器配置和图片大小这是必然的影响因素，楼主会不知道？我只说在我的机器上是这样的情况，实际你也看到了，是很快，意思就是让楼主试试在他那里的情况如何。本来就是讨论效率问题，不说执行时间说什么？我真的觉得你有必要加强逻辑锻炼，辩论场上你肯定是个败军之将！
所以说，我是菜鸟，你也远非高手！
=========================================
这是我唯一同意你的观点！实在是莫名其妙！明明是自己有问题，容不得别人说一句话！到底是谁不谦虚才会写上上面那些话？让你试试代码是给你一个好的治学习惯，凡是自己先做做，然后得结论。我说话是直了点，CSDN的朋友都知道我的风格，我看不惯只会纸上谈兵的人！

to exiong (悠扬) :
你只要在上面，的代码中再加上下面的就行：
========================================================================
Private Sub Picture1_Click(Index As Integer)
Picture1(Index).ZOrder 0
Dim hMemdc As Long, hbmp As Long, holdbmp As Long, hBitmap As Long
Dim bm As BITMAP
Dim i As Integer
Picture1(Index).Cls
hBitmap = LoadImage(App.hInstance, App.Path + "\1.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
hMemdc = CreateCompatibleDC(Picture1(Index).hdc)
SelectObject hMemdc, hBitmap
GetObject hBitmap, Len(bm), bm
BitBlt Picture1(Index).hdc, 0, 0, bm.bmWidth, bm.bmHeight, hMemdc, 0, 0, vbSrcCopy
DeleteDC hMemdc

End Sub

我想还是介绍一下我这PictureBox的用处。我用PictureBox作为容器，里面放了很多Image。点击这些Image，弹出其它窗口。就像lazycat818(lazycat818)所说，用BitBlt方法在PictureBox画的图片，会因为我弹出的窗口而被擦除。（虽然我可以在弹出窗口关闭后重画界面，但是如果用户移动弹出窗口的话，还是会产生图片被擦除的景象。）所以我想问问有没有更好的方法？谢啦！

用 bitblt 方法画出来的似乎无法避免这个问题，如果在 PAINT 事件里写的话会很耗资源

就是这样：Private Sub Picture1_Paint(Index As Integer)Dim hMemdc As Long, hbmp As Long, holdbmp As Long, hBitmap As Long
Dim bm As BITMAP
Dim i As Integer
Picture1(Index).Cls
hBitmap = LoadImage(App.hInstance, "D:\ftphome\wxy\pic\无标题.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
hMemdc = CreateCompatibleDC(Picture1(Index).hdc)
SelectObject hMemdc, hBitmap
GetObject hBitmap, Len(bm), bm
BitBlt Picture1(Index).hdc, 0, 0, bm.bmWidth, bm.bmHeight, hMemdc, 0, 0, vbSrcCopy
DeleteDC hMemdcEnd Sub当控件太多的时候会有明显的停顿，还不如直接 APINTPICTURE 了

还可以尝试把 PICTUREBOX 的 DC 给直接替换成你的图片，相当于 PAINTPICTURE 的效果等我回头试试

to wxy_xiaoyu(☆然也☆╭∩╮(︶︿︶)╭∩╮):
  1.要在一系列相同的图片框上绘图是否必须反复调用CreateCompatibleDC，你试过了吗？你真理解了CreateCompatibleDC创建的是什么吗？
  2.你的水平也许比我高，但在这个问题上，100％肯定是没体现出来。至少你用的那些API我碰巧全会，也全用过，在VB和VC里，以及用VC在VB的图片框里绘图。
  3.我把API毙了吗？告诉你，我自己的程序里就有一大堆的API但我肯定要考虑VB是不是能实现相同的功能，差别到底多大？盲目崇拜API是可笑的！还好，我庆幸自己已经从这种“高水平”回归到了平淡。
  4.我说用API是将程序复杂化，难道错了？你一再否定，难道不是因为程序短？因为你的程序确实也不算很长。除此以外，似乎看不出说这段程序不复杂的理由了。
  5.代码无论如何优化，总是有限的。难道我们不能想一想，“我是不是必须那样做吗”？
  6.既然要说明具体时间，就得说明测试环境，难道阁下这么初浅得道理还不懂？
  7."我只是想免去手动的麻烦，让图片摆放整齐点才写的这些，当然可以用MOVE"，可笑，可说要手动了吗？简直滑天下之大稽！看来我还是高估了你得VB水平。告诉你吧，用move方法不但代码短，而且速度快。
估计只要设置AutoRedraw为True即可

to wxy_xiaoyu(☆然也☆╭∩╮(︶︿︶)╭∩╮):（续）这句话是征对楼主不能保存图象说的，难道阁下看不明白？
当然，下一句话我说的不清楚，“然后设置可见属性”，应该说成，“然后通过设置可见属性来达到显示与否的要求”。
我本来根本没想和你探讨的意思。还不是因为你的短消息？我自然会试自己认为精致的，深奥的代码，但对于那些一眼看懂，且质量不高的代码，我好像还是比较懒的。我承认自己只会纸上谈兵，只不过写了十几万行VB代码而已。所以我自认菜鸟。我到这里来是抱着学习的态度而来的。斗嘴不是我的强项，至于逻辑吗？呵呵，说来惭愧，我自从上了高中，几乎没得过满分，唯一记得的那一次满分，恰恰是逻辑. 我崇拜高手，渴望认识高手！但我鄙视那些懂些皮毛，到处炫耀的“高手”！

to exiong:
以下是你的原话：我现在有个图片变量，一个PictureBox：
Dim pTempPic As StdPicture
1.Form_Load时，我将一副图片给pTempPic；
2.我怎么用bitblt这个方法把pTempPic的图片画到PictureBox里去？那我现在：
Dim p As IPictureDisp‘p为保存图象的变量

在form_load中：

Set p = LoadPicture(App.Path + "\1.bmp")

然后在你的Command1_Click中
if val（ Picture2.tag)=0 then
   Picture2.Picture = p
   Picture2.tag=1
end if
picture2.zorder 0将Picture2显示出来。应该不慢的。为什么一定要一次性画好呢？也别抱着API不放了。
我的方法图片框AutoRedraw全是False的。最节约资源。用bitblt你的图片框AutoRedraw必须是TRUE,这是比较浪费内存的。画好后又要重新设置AutoRedraw为False，可能还得Refresh一下才能显示出来，这样一来，API的优势荡然无存。仅供参考，建议考虑。

......不想和你争什么了以下是我测试下来的结果，你自己看吧，等你能拿出实际解决的方法来再说话吧。
=======================================================================
Private Sub Command1_Click()
Dim oTime As String, i As Integer
oTime = timeGetTimeFor i = 0 To 99
    Picture1(i).Picture = LoadPicture(App.Path + "\1.bmp")
    DoEvents
Next
MsgBox "耗时" + CStr(timeGetTime - oTime) + "毫秒"
End Sub在我家里的同一台机器上实际测试下来是1730毫秒左右===============================================================
Private Sub Form_Click()
Dim hMemdc As Long, hbmp As Long, holdbmp As Long, hBitmap As Long
Dim bm As BITMAP
Dim i As Integer
Dim oTime As String
oTime = timeGetTimehBitmap = LoadImage(App.hInstance, App.Path + "\1.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
For i = 0 To 99
    hMemdc = CreateCompatibleDC(Picture1(i).hdc)
    SelectObject hMemdc, hBitmap
    GetObject hBitmap, Len(bm), bm
    BitBlt Picture1(i).hdc, 0, 0, bm.bmWidth, bm.bmHeight, hMemdc, 0, 0, vbSrcCopy
    DoEvents
    DeleteDC hMemdc
NextMsgBox "耗时" + CStr(timeGetTime - oTime) + "毫秒"
End Sub同一台机器上的结果是 25 毫秒左右。对了，因为楼主说是多个图片框，所以用了100个来测试
你什么时候实际解决楼主问题了再来听你说，否则就请不要出声了

还有：
“将Picture2显示出来。应该不慢的。为什么一定要一次性画好呢？也别抱着API不放了。
我的方法图片框AutoRedraw全是False的。最节约资源。用bitblt你的图片框AutoRedraw必须是TRUE,这是比较浪费内存的。画好后又要重新设置AutoRedraw为False，可能还得Refresh一下才能显示出来，这样一来，API的优势荡然无存。
”没有听说过bitblt使用的时候AutoRedraw必须是TRUE再一次验证了你没有实际试过就下结论的习惯

^_^，那我到想请教如何将图片保存？难道非要在paint事件里反复重画吗？老兄，别那么武断！

还有，你的那段程序公平吗？
纯VB方法，每次到硬盘去读图像文件，而API方法则只读一次，看看时间都花在什么地方了？我说的是这个方法吗？到底是谁随便下结论？我才懒得和那么无赖的人理论！STOP!!!

我无语ing
然也的方法是对的，唉
如果你有兴趣，给你一个DIB类看看，是我写的读取32位位图的，对楼主我无语....
Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongConst IMAGE_BITMAP As Long = 0
Const LR_LOADFROMFILE As Long = &H10
Const LR_CREATEDIBSECTION As Long = &H2000
Const LR_DEFAULTCOLOR As Long = &H0
Const LR_COLOR As Long = &H2Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long'保持属性值的局部变量
Private mvarhDC As Long '局部复制
Private mvarmHeight As Long '局部复制
Private mvarmWidth As Long '局部复制
Private mvarSizeImage As Long '局部复制
Private mvariBitmap As Long '局部复制
Private mvarbitCounts As Integer '局部复制
Private mvarAlphaDC As Long '局部复制
Private mvarImagePtr As Long '局部复制Private AlphaPtr As Long
Private AlphaBitmap As Long
Private AlphaOldMap As Long
Private biAlphaBitInfo As BITMAPINFO
Private bi32BitInfo As BITMAPINFO
Private hOldMap As Long
'保持属性值的局部变量
'保持属性值的局部变量
Public Property Let ImagePtr(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.ImagePtr = 5
    mvarImagePtr = vData
End Property
Public Property Get ImagePtr() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.ImagePtr
    ImagePtr = mvarImagePtr
End Property
Public Property Let AlphaDC(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.AlphaDC = 5
    mvarAlphaDC = vData
End Property
Public Property Get AlphaDC() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.AlphaDC
    AlphaDC = mvarAlphaDC
End Property
Public Property Let bitCounts(ByVal vData As Integer)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.bitCounts = 5
    mvarbitCounts = vData
End PropertyPublic Property Get bitCounts() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.bitCounts
    bitCounts = mvarbitCounts
End PropertyPublic Property Let iBitmap(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.iBitmap = 5
    mvariBitmap = vData
End PropertyPublic Property Get iBitmap() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.iBitmap
    iBitmap = mvariBitmap
End PropertyPublic Property Let SizeImage(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.SizeImage = 5
    mvarSizeImage = vData
End PropertyPublic Property Get SizeImage() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.SizeImage
    SizeImage = mvarSizeImage
End PropertyPublic Function CreateDIB(MyWidth As Long, MyHeight As Long, Optional ByVal IsAlpha As Boolean = False) As Boolean
Dim APtr As Long
Dim PicBits() As Byte
Dim i As LongWith bi32BitInfo.bmiHeader
    .biSize = Len(bi32BitInfo.bmiHeader)
    .biBitCount = 32
    .biCompression = BI_RGB
    .biPlanes = 1
    .biWidth = MyWidth
    .biHeight = MyHeight
    .biSizeImage = .biWidth * 4 * .biHeight
End WithiDC = CreateCompatibleDC(0)
iBitmap = CreateDIBSection(iDC, bi32BitInfo, DIB_RGB_COLORS, APtr, 0, 0)ImagePtr = APtr
mWidth = bi32BitInfo.bmiHeader.biWidth
mHeight = bi32BitInfo.bmiHeader.biHeight
SizeImage = bi32BitInfo.bmiHeader.biSizeImageIf IsAlpha = True Then
  ReDim PicBits(SizeImage)  For i = 0 To SizeImage
    PicBits(i) = 255
  Next i  UnMapArray PicBits
End IfCreateAlphaDC
If iBitmap Then
  hOldMap = SelectObject(iDC, iBitmap)
  CreateDIB = True
Else
  DeleteObject iDC
  CreateDIB = False
  Exit Function
End If
End FunctionPublic Function SaveDIB(FileName As String, BitCount As Long) As Boolean
Dim FileNum As Integer
Dim hDC As Long, hBitmap As Long
Dim hhOldMap As Long
Dim biBitInfo As BITMAPINFO
Dim TempBmpFile As BITMAPFILEHEADER
Dim TCB() As RGBQUAD
Dim TempBytes() As ByteIf (ChkFileWrite(FileName) = False) Or (iDC = 0) Then Exit FunctionWith biBitInfo.bmiHeader
    .biBitCount = BitCount
    .biCompression = BI_RGB
    .biPlanes = 1
    .biSize = Len(biBitInfo.bmiHeader)
    .biWidth = bi32BitInfo.bmiHeader.biWidth
    .biHeight = bi32BitInfo.bmiHeader.biHeight
    Select Case BitCount
    Case 32
      .biSizeImage = .biWidth * 4 * .biHeight
    Case 24
      .biSizeImage = ((.biWidth * 3 + 3) And &H7FFFFFFC) * .biHeight
    Case 16
       .biSizeImage = ((.biWidth * 2 + 2) And &H7FFFFFFC) * .biHeight
    End Select
End WithhDC = CreateCompatibleDC(0)
hBitmap = CreateDIBSection(hDC, biBitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)If hBitmap Then
  hhOldMap = SelectObject(hDC, hBitmap)
Else
  DeleteObject hDC
  SaveDIB = False
  Exit Function
End If  BitBlt hDC, 0, 0, bi32BitInfo.bmiHeader.biWidth, bi32BitInfo.bmiHeader.biHeight, iDC, 0, 0, vbSrcCopyTempBmpFile.bfType(1) = Asc("B")
TempBmpFile.bfType(2) = Asc("M")
TempBmpFile.bfOffBits = Len(TempBmpFile) + Len(biBitInfo.bmiHeader)
If biBitInfo.bmiHeader.biBitCount <= 8 Then
   TempBmpFile.bfOffBits = TempBmpFile.bfOffBits + 4 * 2 ^ biBitInfo.bmiHeader.biBitCount

   ReDim TCB(1 To 2 ^ biBitInfo.bmiHeader.biBitCount)
   GetDIBColorTable iDC, 0, 2 ^ biBitInfo.bmiHeader.biBitCount, TCB(1)
End IfTempBmpFile.bfSize = TempBmpFile.bfOffBits + biBitInfo.bmiHeader.biSizeImageReDim TempBytes(1 To biBitInfo.bmiHeader.biSizeImage)If BitCount <> 32 Then
  GetDIBits hDC, hBitmap, 0, biBitInfo.bmiHeader.biHeight, TempBytes(1), biBitInfo, DIB_RGB_COLORS
Else
  GetDIBits iDC, iBitmap, 0, biBitInfo.bmiHeader.biHeight, TempBytes(1), biBitInfo, DIB_RGB_COLORS
End IfFileNum = FreeFile

Open FileName For Binary As #FileNum

  Put #FileNum, , TempBmpFile
  Put #FileNum, , biBitInfo.bmiHeader
  If biBitInfo.bmiHeader.biBitCount <= 8 Then Put #FileNum, , TCB
  Put #FileNum, , TempBytes

Close #FileNumIf hhOldMap Then DeleteObject SelectObject(hDC, hhOldMap)
DeleteObject hDCSaveDIB = True
End Function

Public Function LoadDIB(FileName As String) As Boolean
Dim FileBitmap As BITMAP
Dim hhOldMap As Long
Dim hDC As Long, hBitmap As Long
Dim PicBits() As Byte
Dim FileNum As Integer
'If Dir(FileName) = False Then Exit FunctionhDC = CreateCompatibleDC(0)
hBitmap = LoadImage(0, FileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)If hBitmap Then
  hhOldMap = SelectObject(hDC, hBitmap)
Else
  DeleteObject hDC
  LoadDIB = False
  Exit Function
End IfGetObjectAPI hBitmap, Len(FileBitmap), FileBitmap'With bi32BitInfo.bmiHeader
'    .biBitCount = 32
'    .biCompression = BI_RGB
'    .biPlanes = 1
'    .biSize = Len(bi32BitInfo.bmiHeader)
'    .biWidth = FileBitmap.bmWidth
'    .biHeight = FileBitmap.bmHeight
'    .biSizeImage = .biWidth * 4 * .biHeight
'End With'iDC = CreateCompatibleDC(0)
'iBitmap = CreateDIBSection(iDC, bi32BitInfo, DIB_RGB_COLORS, ByVal 0&, ByVal 0&, ByVal 0&)'If iBitmap Then
'  hOldMap = SelectObject(iDC, iBitmap)
'Else
'  DeleteObject iDC
'  LoadDIB = False
'  Exit Function
'End IfCreateDIB FileBitmap.bmWidth, FileBitmap.bmHeightIf FileBitmap.bmBitsPixel = 32 Then
  ReDim PicBits(bi32BitInfo.bmiHeader.biSizeImage)
  GetBitmapBits hBitmap, bi32BitInfo.bmiHeader.biSizeImage, PicBits(0)
  SetBitmapBits iBitmap, bi32BitInfo.bmiHeader.biSizeImage, PicBits(0)
'  ReDim PicBits(1 To bi32BitInfo.bmiHeader.biSizeImage)
'  FileNum = FreeFile
'  Open FileName For Binary As #FileNum
'    Get #FileNum, 55, PicBits
'  Close #FileNum
'  SetDIBits iDC, iBitmap, 0, bi32BitInfo.bmiHeader.biHeight, PicBits(1), bi32BitInfo, DIB_RGB_COLORS
Else
  BitBlt iDC, 0, 0, bi32BitInfo.bmiHeader.biWidth, bi32BitInfo.bmiHeader.biHeight, hDC, 0, 0, vbSrcCopy
End If
bitCounts = FileBitmap.bmBitsPixelmWidth = bi32BitInfo.bmiHeader.biWidth
mHeight = bi32BitInfo.bmiHeader.biHeight
SizeImage = bi32BitInfo.bmiHeader.biSizeImageIf hhOldMap Then DeleteObject SelectObject(hDC, hhOldMap)
DeleteObject hhDC
FreeAlphaDC
CreateAlphaDC
SetAlphaDC
LoadDIB = True
End FunctionPublic Function UnMapArray(Bits() As Byte) As Boolean
SetBitmapBits iBitmap, SizeImage, Bits(0)
Erase Bits
UnMapArray = True
End FunctionPublic Function MapArray(Bits() As Byte) As Boolean
ReDim Bits(SizeImage)
GetBitmapBits iBitmap, SizeImage, Bits(0)
MapArray = True
End FunctionPublic Function FreeDIB() As Boolean
On Error Resume Next
If hOldMap Then DeleteObject SelectObject(iDC, hOldMap)
DeleteObject iDC
With bi32BitInfo.bmiHeader
.biBitCount = 0
.biHeight = 0
.biSizeImage = 0
.biWidth = 0
End With
FreeAlphaDC
FreeDIB = True
End FunctionPrivate Function CreateAlphaDC() As Boolean
With biAlphaBitInfo.bmiHeader
    .biSize = Len(biAlphaBitInfo.bmiHeader)
    .biBitCount = 32
    .biCompression = BI_RGB
    .biPlanes = 1
    .biWidth = mWidth
    .biHeight = mHeight
      .biSizeImage = .biWidth * 4 * .biHeight
End WithAlphaDC = CreateCompatibleDC(0)
AlphaBitmap = CreateDIBSection(AlphaDC, biAlphaBitInfo, DIB_RGB_COLORS, AlphaPtr, 0, 0)If AlphaBitmap Then
  AlphaOldMap = SelectObject(AlphaDC, AlphaBitmap)
Else
  DeleteObject AlphaDC
  CreateAlphaDC = False
  Exit Function
End If
CreateAlphaDC = True
End FunctionPrivate Function FreeAlphaDC() As Boolean
If AlphaOldMap Then DeleteObject SelectObject(AlphaDC, AlphaOldMap)
DeleteObject AlphaDC
With biAlphaBitInfo.bmiHeader
.biBitCount = 0
.biHeight = 0
.biSizeImage = 0
.biWidth = 0
End With
FreeAlphaDC = True
End FunctionPublic Function SetAlphaDC() As Boolean
Dim i As Long, j As Long
Dim Alpha As Single
Dim AlphaColor As Long
Dim dWidth As Long, dHeight As Long
Dim BackColor As LongIf SizeImage = 0 Then Exit FunctionPointInitdWidth = mWidth - 1: dHeight = mHeight - 1
CopyMemory ByVal AlphaPtr, ByVal ImagePtr, SizeImage
'BitBlt AlphaDC, 0, 0, mWidth, mHeight, iDC, 0, 0, vbSrcCopyp4Byte0Ptr(0) = AlphaPtr
p4Byte1Ptr(0) = ImagePtrFor i = 0 To dHeight
  For j = 0 To dWidth
    If p4Byte1(3) <> 0 Then
      If ((Int(i / 16) Mod 2) + (Int(j / 16) Mod 2)) Mod 2 = 1 Then
        BackColor = &HCC
      Else
        BackColor = &HFF
      End If
      AlphaColor = BackColor * p4Byte1(3) / 255
      Alpha = 1 - p4Byte1(3) / 255
      p4Byte0(0) = p4Byte1(0) * Alpha + AlphaColor
      p4Byte0(1) = p4Byte1(1) * Alpha + AlphaColor
      p4Byte0(2) = p4Byte1(2) * Alpha + AlphaColor
    End If
    p4Byte0Ptr(0) = p4Byte0Ptr(0) + 4
    p4Byte1Ptr(0) = p4Byte1Ptr(0) + 4
  Next j
Next iPointFreeSetAlphaDC = True
End FunctionPublic Function DrawAlphaDC(hDC As Long, X As Long, Y As Long, Width As Long, Height As Long, SrcX As Long, SrcY As Long) As Boolean
BitBlt hDC, X, Y, Width, Height, AlphaDC, SrcX, SrcY, vbSrcCopy
DrawAlphaDC = True
End FunctionPublic Property Let mWidth(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.mWidth = 5
    mvarmWidth = vData
End Property
Public Property Get mWidth() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.mWidth
    mWidth = mvarmWidth
End PropertyPublic Property Let mHeight(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.mHeight = 5
    mvarmHeight = vData
End Property
Public Property Get mHeight() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.mHeight
    mHeight = mvarmHeight
End PropertyPublic Property Let iDC(ByVal vData As Long)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.hDC = 5
    mvarhDC = vData
End Property
Public Property Get iDC() As Long
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.hDC
    iDC = mvarhDC
End PropertyPrivate Sub Class_Terminate()
FreeAlphaDC
FreeDIB
End Sub

这个类里面用了模拟指针：
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As LongPublic Type SAFEARRAY
    cDims As Integer         '这个数组有几维？
    fFeatures As Integer     '这个数组有什么特性？
    cbElements As Long       '数组的每个元素有多大？
    cLocks As Long           '这个数组被锁定过几次？
    pvData As Long           '这个数组里的数据放在什么地方？
    'rgsabound() As SFArrayBOUND
End TypePublic Type SAFEARRAYBOUND
    cElements As Long      '这一维有多少个元素？
    lLbound As Long        '它的索引从几开始？
End TypePublic Type SAFEARRAY1
    cDims As Integer         '这个数组有几维？
    fFeatures As Integer     '这个数组有什么特性？
    cbElements As Long       '数组的每个元素有多大？
    cLocks As Long           '这个数组被锁定过几次？
    pvData As Long           '这个数组里的数据放在什么地方？
    CE0 As Long              '这一维有多少个元素？
    LB0 As Long              '它的索引从几开始？
End TypePublic Type SAFEARRAY2
    cDims As Integer         '这个数组有几维？
    fFeatures As Integer     '这个数组有什么特性？
    cbElements As Long       '数组的每个元素有多大？
    cLocks As Long           '这个数组被锁定过几次？
    pvData As Long           '这个数组里的数据放在什么地方？
    CE0 As Long              '这一维有多少个元素？
    LB0 As Long              '它的索引从几开始？
    CE1 As Long
    LB1 As Long
End TypePublic Const pvDataPtrAdd As Long = 12&
Public Type Color32Bit
    B As Byte
    G As Byte
    R As Byte
    A As Byte
End Type'-- 关键变量 --------------------------------------
Public InitPtrFlag As BooleanPublic pLongAll(0 To 0) As Long
Public pLongAllPtr(0 To 0) As Long
Public OldpLongAll As Long
Public OldpLongAllPtr As Long'-- 2个4Byte指针 ----------------------------------
Public p4Byte0(0 To 3) As Byte
Public p4Byte0Ptr(0 To 0) As Long
Public Oldp4Byte0 As Long
Public Oldp4Byte0Ptr As LongPublic p4Byte1(0 To 3) As Byte
Public p4Byte1Ptr(0 To 0) As Long
Public Oldp4Byte1 As Long
Public Oldp4Byte1Ptr As Long'-- 2个Long指针 -----------------------------------
Public pLong0(0 To 0) As Long
Public pLong0Ptr(0 To 0) As Long
Public OldpLong0 As Long
Public OldpLong0Ptr As LongPublic pLong1(0 To 0) As Long
Public pLong1Ptr(0 To 0) As Long
Public OldpLong1 As Long
Public OldpLong1Ptr As Long'-- 2个Color32Bit指针 -----------------------------
Public pC32B0(0 To 0) As Color32Bit
Public pC32B0Ptr(0 To 0) As Long
Public OldpC32B0 As Long
Public OldpC32B0Ptr As LongPublic pC32B1(0 To 0) As Color32Bit
Public pC32B1Ptr(0 To 0) As Long
Public OldpC32B1 As Long
Public OldpC32B1Ptr As Long'-- 2个自定义指针 ---------------------------------
Public pxByte0(0 To 15) As Byte
Public pxByte0Ptr(0 To 0) As Long
Public OldpxByte0 As Long
Public OldpxByte0Ptr As LongPublic pxByte1(0 To 15) As Byte
Public pxByte1Ptr(0 To 0) As Long
Public OldpxByte1 As Long
Public OldpxByte1Ptr As LongPublic pxByte2(0 To 15) As Byte
Public pxByte2Ptr(0 To 0) As Long
Public OldpxByte2 As Long
Public OldpxByte2Ptr As LongPublic pxByte3(0 To 15) As Byte
Public pxByte3Ptr(0 To 0) As Long
Public OldpxByte3 As Long
Public OldpxByte3Ptr As Long
Public Sub MakePoint(ByVal DataArrPtr As Long, ByVal pDataArrPtr As Long, ByRef OldArrPtr As Long, ByRef OldpArrPtr As Long)
    Dim TempLng As Long
    Dim TempPtr As Long

    If InitPtrFlag Then
        Dim OldPtr As Long

        OldPtr = pLongAllPtr(0)
        pLongAllPtr(0) = DataArrPtr
        TempLng = pLongAll(0) + pvDataPtrAdd
        pLongAllPtr(0) = pDataArrPtr
        TempPtr = pLongAll(0) + pvDataPtrAdd
        pLongAllPtr(0) = TempPtr
        OldpArrPtr = pLongAll(0)
        pLongAll(0) = TempLng
        pLongAllPtr(0) = TempLng
        OldArrPtr = pLongAll(0)
        pLongAllPtr(0) = OldPtr

    Else
        CopyMemory TempLng, ByVal DataArrPtr, 4 '得到DataArrPtr的SAFEARRAY结构的地址
        TempLng = TempLng + pvDataPtrAdd '这个指针偏移12个字节后就是pvData指针
        CopyMemory TempPtr, ByVal pDataArrPtr, 4 '得到pDataArrPtr的SAFEARRAY结构的地址
        TempPtr = TempPtr + pvDataPtrAdd '这个指针偏移12个字节后就是pvData指针
        CopyMemory OldpArrPtr, ByVal TempPtr, 4  '保存旧地址
        CopyMemory ByVal TempPtr, TempLng, 4  '使pDataArrPtr指向DataArrPtr的SAFEARRAY结构的pvData指针
        CopyMemory OldArrPtr, ByVal TempLng, 4 '保存旧地址

    End If

End SubPublic Sub FreePoint(ByVal DataArrPtr As Long, ByVal pDataArrPtr As Long, ByVal OldArrPtr As Long, ByVal OldpArrPtr As Long)
    Dim TempPtr As Long

    If InitPtrFlag Then
        pLongAllPtr(0) = DataArrPtr
        pLongAllPtr(0) = pLongAll(0) + pvDataPtrAdd
        pLongAll(0) = OldArrPtr
        pLongAllPtr(0) = pDataArrPtr
        pLongAllPtr(0) = pLongAll(0) + pvDataPtrAdd
        pLongAll(0) = OldpArrPtr

    Else
        CopyMemory TempPtr, ByVal DataArrPtr, 4 '得到DataArrPtr的SAFEARRAY结构的地址
        CopyMemory ByVal (TempPtr + pvDataPtrAdd), OldArrPtr, 4 '恢复旧地址
        CopyMemory TempPtr, ByVal pDataArrPtr, 4 '得到pDataArrPtr的SAFEARRAY结构的地址
        CopyMemory ByVal (TempPtr + pvDataPtrAdd), OldpArrPtr, 4 '恢复旧地址

    End If

End SubPublic Sub PointInit()
    If InitPtrFlag Then Exit Sub

    MakePoint VarPtrArray(pLongAll), VarPtrArray(pLongAllPtr), OldpLongAll, OldpLongAllPtr
    InitPtrFlag = True

    MakePoint VarPtrArray(p4Byte0), VarPtrArray(p4Byte0Ptr), Oldp4Byte0, Oldp4Byte0Ptr
    MakePoint VarPtrArray(p4Byte1), VarPtrArray(p4Byte1Ptr), Oldp4Byte1, Oldp4Byte1Ptr

    MakePoint VarPtrArray(pLong0), VarPtrArray(pLong0Ptr), OldpLong0, OldpLong0Ptr
    MakePoint VarPtrArray(pLong1), VarPtrArray(pLong1Ptr), OldpLong1, OldpLong1Ptr

    MakePoint VarPtrArray(pC32B0), VarPtrArray(pC32B0Ptr), OldpC32B0, OldpC32B0Ptr
    MakePoint VarPtrArray(pC32B1), VarPtrArray(pC32B1Ptr), OldpC32B1, OldpC32B1Ptr

    MakePoint VarPtrArray(pxByte0), VarPtrArray(pxByte0Ptr), OldpxByte0, OldpxByte0Ptr
    MakePoint VarPtrArray(pxByte1), VarPtrArray(pxByte1Ptr), OldpxByte1, OldpxByte1Ptr
    MakePoint VarPtrArray(pxByte2), VarPtrArray(pxByte2Ptr), OldpxByte2, OldpxByte2Ptr
    MakePoint VarPtrArray(pxByte3), VarPtrArray(pxByte3Ptr), OldpxByte3, OldpxByte3Ptr

End SubPublic Sub PointFree()
    If InitPtrFlag = False Then Exit Sub

    FreePoint VarPtrArray(p4Byte0), VarPtrArray(p4Byte0Ptr), Oldp4Byte0, Oldp4Byte0Ptr
    FreePoint VarPtrArray(p4Byte1), VarPtrArray(p4Byte1Ptr), Oldp4Byte1, Oldp4Byte1Ptr

    FreePoint VarPtrArray(pLong0), VarPtrArray(pLong0Ptr), OldpLong0, OldpLong0Ptr
    FreePoint VarPtrArray(pLong1), VarPtrArray(pLong1Ptr), OldpLong1, OldpLong1Ptr

    FreePoint VarPtrArray(pC32B0), VarPtrArray(pC32B0Ptr), OldpC32B0, OldpC32B0Ptr
    FreePoint VarPtrArray(pC32B1), VarPtrArray(pC32B1Ptr), OldpC32B1, OldpC32B1Ptr

    FreePoint VarPtrArray(pxByte0), VarPtrArray(pxByte0Ptr), OldpxByte0, OldpxByte0Ptr
    FreePoint VarPtrArray(pxByte1), VarPtrArray(pxByte1Ptr), OldpxByte1, OldpxByte1Ptr
    FreePoint VarPtrArray(pxByte2), VarPtrArray(pxByte2Ptr), OldpxByte2, OldpxByte2Ptr
    FreePoint VarPtrArray(pxByte3), VarPtrArray(pxByte3Ptr), OldpxByte3, OldpxByte3Ptr

    InitPtrFlag = False
    FreePoint VarPtrArray(pLongAll), VarPtrArray(pLongAllPtr), OldpLongAll, OldpLongAllPtr

End Sub

报告楼主：wxy_xiaoyu(☆然也☆╭∩╮(︶︿︶)╭∩）的方法：临近午夜，timeGetTime改成了GetTickCount，另外加了设置AutoRedraw的代码，不在计时范围内。Private Sub Command1_Click()
    Dim hMemdc As Long, hbmp As Long, holdbmp As Long, hBitmap As Long
    Dim bm As BITMAP
    Dim i As Integer
    Dim oTime As Long

    For i = 0 To 99
        Picture1(i).AutoRedraw = True
    Next

    hBitmap = LoadImage(App.hInstance, App.Path + "\1.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
    oTime = timeGetTime

    For i = 0 To 99
        hMemdc = CreateCompatibleDC(Picture1(0).hdc)
        SelectObject hMemdc, hBitmap
        GetObject hBitmap, Len(bm), bm

        BitBlt Picture1(i).hdc, 0, 0, bm.bmWidth, bm.bmHeight, hMemdc, 0, 0, vbSrcCopy

        'Picture1(i).Refresh
        'Picture1(i).AutoRedraw = False
        DeleteDC hMemdc
    Next
    MsgBox "耗时" + CStr(GetTickCount - oTime) + "毫秒"
End Sub我改动的方法：考虑到所有图片框一样，只创建一次hMemdc
Private Sub Command2_Click()
    Dim hMemdc As Long, hbmp As Long, holdbmp As Long, hBitmap As Long
    Dim bm As BITMAP
    Dim i As Integer
    Dim oTime As Long

    For i = 0 To 99
        Picture1(i).AutoRedraw = True
    Next

    hBitmap = LoadImage(App.hInstance, App.Path + "\1.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_CREATEDIBSECTION)
    oTime = timeGetTime
        hMemdc = CreateCompatibleDC(Picture1(0).hdc)
        SelectObject hMemdc, hBitmap
        GetObject hBitmap, Len(bm), bm
    For i = 0 To 99

        BitBlt Picture1(i).hdc, 0, 0, bm.bmWidth, bm.bmHeight, hMemdc, 0, 0, vbSrcCopy
        'Picture1(i).Refresh
        'Picture1(i).AutoRedraw = False
    Next
    DeleteDC hMemdc
    MsgBox "耗时" + CStr(GetTickCount - oTime) + "毫秒"
End Sub纯VB方法：
Private Sub Command3_Click()
    Dim i As Integer
    Dim oTime As Long
    Dim p As IPictureDisp    Set p = LoadPicture(App.Path + "\1.bmp")

    For i = 0 To 99        Picture1(i).AutoRedraw = True
    Next    oTime = GetTickCount

    For i = 0 To 99
        Picture1(i).Picture = p
        'Picture1(i).AutoRedraw = False
    Next

    MsgBox "耗时" + CStr(GetTickCount - oTime) + "毫秒"End Sub在赛扬2-900上经反复测试，取平均值
在AutoRedraw全部为False时：方法1＝11ms,方法2＝10ms,方法3＝22ms在AutoRedraw全部为True时：方法1＝2000ms,方法2＝1900ms,方法3＝22ms所得结果差别：方法1和方法2一样，图象是临时的，会被擦除，而方法3不管AutoRedraw属性，图象都是永久的。方法1和方法2要想保存图象，必须设置AutoRedraw＝True，然后Refresh,然后设置AutoRedraw＝False.要么另外想办法处理重画问题。自己比较一下吧。累了。这是我关于这个问题的最后发言。

没有想到我的问题能给两位带来这么多的“交流”机会，万分感激的同时，也亿分的害臊（只有我不懂）。不过还是要强调一下，可能是我一开始没有说清楚，我要的不是简单的把一张图片画到PictureBox里，我是要按一定比例切割图片的（应为支持动态换图片）。所以，我的图片是一定要一定规则画到PictureBox里去的。还有什么问题，大家尽管提出，不行，可以把源码发送。谢谢！

调试易

高分请教：如何能在PictureBox中飞快的画出图片

解决方案 »