怎样在PictureBox中把小图片的尺寸放大？？？（像用Image的Stretch属性）

Question

放一个Image在PICTUREXBOX里面，
使之和PICTUREBOX一样大。

Answer 1

Picture1.PaintPicture Picture1.Picture, _
    0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, _
    0, 0, Picture1.Picture.Width, Picture1.Picture.Height

Answer 2

用paintpicture()或bitblt,请查阅相关函数说明。

Answer 3

to:feihong0233(泓)
我用你的方法试过了，可是出错啊
提示“无效图片”
还有更好的方法吗？？？？

Answer 4

to : wiw(不只是VB)
怎样用BITBLT啊？把一个图复制到另外一个地方就行啊，可是我不知道怎样放大图形。
能教教我吗，谢谢咯。

Answer 5

  
   to : All !  对了，我要补充一点：    PICTUREBOX里边的图，我是用BITBLT画的，就会出现错误，提示“无效图片”
         直接用PICTURE=“PIC.BMP”就不会出错，
    为什么呢 ？？？？？？
    有什么解决办法？？？

Answer 6

请参考：
将2幅图片加载到内存中进行处理然后显示在PICTUREBOX上'模块中的代码
Option ExplicitPublic Type BITMAPINFOHEADER
        biSize As Long
        biWidth As Long
        biHeight As Long
        biPlanes As Integer
        biBitCount As Integer
        biCompression As Long
        biSizeImage As Long
        biXPelsPerMeter As Long
        biYPelsPerMeter As Long
        biClrUsed As Long
        biClrImportant As Long
End TypePublic Type RGBQUAD
        rgbBlue As Byte
        rgbGreen As Byte
        rgbRed As Byte
        rgbReserved As Byte
End TypePublic Type BITMAPINFO
        bmiHeader As BITMAPINFOHEADER
        bmiColors As RGBQUAD
End TypePublic 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
Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPublic Function ShadeColors(ByVal Dst As Long, ByVal Src As Long, ByVal Shade As Byte)
    Select Case Shade
    Case 0:  ShadeColors = Dst
    Case 255: ShadeColors = Src
    Case Else:
    ShadeColors = (Src And &HFF) * Shade / 255 + (Dst And &HFF) * (255 - Shade) / 255 Or _
            ((Src And &HFF00&) * Shade / 255 + (Dst And &HFF00&) * (255 - Shade) / 255) And &HFF00& Or _
            ((Src And &HFF0000) * (Shade / 255) + (Dst And &HFF0000) * ((255 - Shade) / 255)) And &HFF0000
    End Select
End FunctionPublic Function AlphaBlend(ByVal DstDC As Long, ByVal DstX As Long, ByVal DstY As Long, ByVal DstW As Long, ByVal DstH As Long, ByVal SrcDC As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Alpha As Byte, ByVal TransColor As Long, ByVal Flags As Long) As Long
    If Alpha = 0 Or DstW = 0 Or DstH = 0 Then Exit Function
    Dim B As Long, H As Long, F As Long, I As Long
    Dim TmpDC As Long, TmpBmp As Long, TmpObj As Long
    Dim Sr2DC As Long, Sr2Bmp As Long, Sr2Obj As Long
    Dim Data1() As Long, Data2() As Long
    Dim Info As BITMAPINFO
    
    
    TmpDC = CreateCompatibleDC(SrcDC)
    Sr2DC = CreateCompatibleDC(SrcDC)
    TmpBmp = CreateCompatibleBitmap(DstDC, DstW, DstH)
    Sr2Bmp = CreateCompatibleBitmap(DstDC, DstW, DstH)
    TmpObj = SelectObject(TmpDC, TmpBmp)
    Sr2Obj = SelectObject(Sr2DC, Sr2Bmp)
    ReDim Data1(DstW * DstH * 4 - 1)
    ReDim Data2(DstW * DstH * 4 - 1)
    Info.bmiHeader.biSize = Len(Info.bmiHeader)
    Info.bmiHeader.biWidth = DstW
    Info.bmiHeader.biHeight = DstH
    Info.bmiHeader.biPlanes = 1
    Info.bmiHeader.biBitCount = 32
    Info.bmiHeader.biCompression = 0    BitBlt TmpDC, 0, 0, DstW, DstH, DstDC, DstX, DstY, vbSrcCopy
    BitBlt Sr2DC, 0, 0, DstW, DstH, SrcDC, SrcX, SrcY, vbSrcCopy
    GetDIBits TmpDC, TmpBmp, 0, DstH, Data1(0), Info, 0
    GetDIBits Sr2DC, Sr2Bmp, 0, DstH, Data2(0), Info, 0
    
    For H = 0 To DstH - 1
        F = H * DstW
        For B = 0 To DstW - 1
            I = F + B
            If (Flags And &H1) And ((Data2(I) And &HFFFFFF) = TransColor) Then
            Else
                Data1(I) = ShadeColors(Data1(I), Data2(I), Alpha)
            End If
        Next B
    Next H    SetDIBitsToDevice DstDC, DstX, DstY, DstW, DstH, 0, 0, 0, DstH, Data1(0), Info, 0    Erase Data1
    Erase Data2
    DeleteObject SelectObject(TmpDC, TmpObj)
    DeleteObject SelectObject(Sr2DC, Sr2Obj)
    DeleteDC TmpDC
    DeleteDC Sr2DC
End Function
'----------------------------------------'窗体中的代码
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 GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Dim CurX As Single, CurY As Single
Dim WH As Long, WD As LongDim TPPX As Integer
Dim TPPY As IntegerPrivate Sub Form_Load()
    Picture3.Picture = LoadPicture("back.bmp")
    Width = Picture3.Width
    Height = Picture3.Height
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Picture1_MouseDown Button, Shift, x, y
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Picture1_MouseMove Button, Shift, x, y
End SubPrivate Sub Image1_Click()
    Me.WindowState = vbMinimized
End SubPrivate Sub Image2_Click()
    Unload Me
End SubPrivate Sub Image3_Click()
    MsgBox "Test"
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        CurX = x
        CurY = y
    End If
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim DeltaX As Long, DeltaY As Long
    Dim WH As Long, WD As Long
    If Button = 1 Then
        WH = GetDesktopWindow
        WD = GetDC(WH)
        DeltaX = x - CurX
        DeltaY = y - CurY
        BitBlt Picture2.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, Picture2.hdc, DeltaX \ TPPX, DeltaY \ TPPY, vbSrcCopy
        If DeltaX > 0 Then
            BitBlt Picture2.hdc, (ScaleWidth - DeltaX) \ TPPX, 0, DeltaX \ TPPX, ScaleHeight \ TPPY, WD, (Left + Width) \ TPPX, (Top + DeltaY) \ TPPX, vbSrcCopy
        ElseIf DeltaX < 0 Then
            BitBlt Picture2.hdc, 0, 0, -DeltaX \ TPPX, ScaleHeight \ TPPY, WD, (Left + DeltaX) \ TPPX, (Top + DeltaY) \ TPPY, vbSrcCopy
        End If
        If DeltaY > 0 Then
            BitBlt Picture2.hdc, 0, (ScaleHeight - DeltaY) \ TPPY, ScaleWidth \ TPPX, DeltaY \ TPPY, WD, (Left + DeltaX) \ TPPX, (Top + Height) \ TPPY, vbSrcCopy
        ElseIf DeltaY < 0 Then
            BitBlt Picture2.hdc, 0, 0, ScaleWidth \ TPPX, -DeltaY \ TPPY, WD, (Left + DeltaX) \ TPPX, (Top + DeltaY) \ TPPY, vbSrcCopy
        End If
        'Picture2.Refresh
        BitBlt Picture1.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, Picture2.hdc, 0, 0, vbSrcCopy
        AlphaBlend Picture1.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, Picture3.hdc, 0, 0, 128, &HFF00FF, 1
        Move Left + DeltaX, Top + DeltaY
        Picture1.Refresh
        BitBlt Me.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, Picture1.hdc, 0, 0, vbSrcCopy
        ReleaseDC WH, WD
    End If
End SubPrivate Sub Form_Resize()
    TPPX = Screen.TwipsPerPixelX
    TPPY = Screen.TwipsPerPixelY
    Picture1.Move 0, 0, Width, Height
    Picture2.Move 0, 0, Width, Height
    WH = GetDesktopWindow
    WD = GetDC(WH)
    BitBlt Picture2.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, WD, Left \ TPPX, Top \ TPPY, vbSrcCopy
    BitBlt Picture1.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, Picture2.hdc, 0, 0, vbSrcCopy    AlphaBlend Picture1.hdc, 0, 0, ScaleWidth \ TPPX, ScaleHeight \ TPPY, Picture3.hdc, 0, 0, 128, &HFF00FF, 1
    ReleaseDC WH, WD
End Sub

Answer 7

试试这个，
Picture1.PaintPicture Picture1.image, _
    0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, _
    0, 0, Picture1.Picture.Width, Picture1.Picture.Height
如果是图形方法画上去的话会存在image属性中，
注意：想要得到image属性picturebox的autoredraw要改成true