将图片扩展后拷到picturebox无法显示，是何原因？

Question

程序代码如下，请高手帮忙看看问题出在哪里。
Public Sub FullShowPic(BoxPic As PictureBox, strPicName As String)Dim oPic As Object
Dim rectPic As RECT
Dim bmp As BITMAP
Dim hStretch&, hStretchBmp&, hbmpOld&, dx&, dy&Set oPic = LoadPicture(strPicName)If GetObjectAPI(oPic, Len(bmp), bmp) Then
    
    
    dx = BoxPic.ScaleX(BoxPic.Width, vbTwips, vbPixels)
    dy = BoxPic.ScaleY(BoxPic.Height, vbTwips, vbPixels)
    
    hStretch = CreateCompatibleDC(BoxPic.hdc)
    hbmpOld = SelectObject(hStretch, CreateCompatibleBitmap(hStretch, dx, dy))
    StretchBlt hStretch, 0&, 0&, dx, dy, oPic.Handle, 0&, 0&, bmp.bmWidth, bmp.bmHeight, vbSrcCopy
    BitBlt BoxPic.hdc, 0, 0, dx, dy, hStretch, 0, 0, vbNotSrcCopy
    
    DeleteObject SelectObject(hStretch, hbmpOld)
    
    BoxPic.Refresh
Else
    MsgBox "无法正常加载图片! "
End IfSet oPic = Nothing

Answer 1

高手都不在吗？已经做好了，还是自己给出答案吧，希望对想让图片适应picturebox的编者有用。
代码如下，API函数，还有rect结构自己声明好啦。
Dim oPic As Object, bmp As BITMAP, rc As RECT
Dim hcleintArea&, hStretch&, hbmpOld&, dx&, dy&, hBackgroundDc&, hPrBackgroundDc& ', hStretchBmp&
Set oPic = LoadPicture(strPicName)If GetObjectAPI(oPic, Len(bmp), bmp) Then
    hcleintArea = BoxPic.hwnd
    
    Call GetClientRect(hcleintArea, rc)  '失效区域信息放入rc
    
    Call InvalidateRect(hcleintArea, rc, API_TRUE) '失效（重绘前将先清除）
    dx = rc.right - rc.left
    dy = rc.bottom - rc.top
    
    hStretch = CreateCompatibleDC(BoxPic.hdc)
    hBackgroundDc = CreateCompatibleDC(BoxPic.hdc)
    
    hbmpOld = SelectObject(hStretch, CreateCompatibleBitmap(hStretch, dx, dy))
    
    hPrBackgroundDc = SelectObject(hBackgroundDc, oPic.Handle)
    Call SelectObject(hStretch, CreateCompatibleBitmap(hBackgroundDc, dx, dy))
    
    Call StretchBlt(hStretch, 0&, 0&, dx, dy, hBackgroundDc, 0&, 0&, bmp.bmWidth, bmp.bmHeight, vbSrcCopy)
    Call BitBlt(BoxPic.hdc, 0, 0, dx, dy, hStretch, 0, 0, vbSrcCopy)
    
    DeleteObject SelectObject(hStretch, hbmpOld)
    DeleteObject SelectObject(hBackgroundDc, hPrBackgroundDc)
    
    Call InvalidateRect(hcleintArea, rc, API_TRUE)
    'BoxPic.Refresh
Else
    MsgBox "无法正常加载图片! "
End IfSet oPic = Nothing
VB6.0中调试过啦，能用但有损失哟。