关于StretchDIBits的问题，谁能帮我写一个用这个函数显示图片的程序

Question

关于StretchDIBits的问题，谁能帮我写一个用这个函数显示图片的小程序，只要能显示就OK，关于这个函数的方法看了不是很明白。图片需要用picture控件显示，图片放在程序文件夹目录下。

Answer 1

利用API函数实现图像淡入淡出效果
    一般传统的实现两个PictureBox之间图像的淡入淡出效果都需要使用大量的API函数并进行复杂的调色板以及
绘图设备(Device Context)的操作。但是在Win98、Win2000中，微软提供了支持透明图像拷贝的AlphaBlend函数。
这篇文章就介绍如何通过API函数AlphaBlend实现PictureBox之间图像的淡入淡出效果。AlphaBlend函数的定义在
msimg32.dll中，一般Win98、Win2000都带了这个库，在编程之前你可以先察看一下该文件是否存在。
    打开VB建立一个新工程。选择菜单 Project | Add Module 添加一个模块到工程中，在其中输入以下代码：Public Type rBlendProps
    tBlendOp As Byte
    tBlendOptions As Byte
    tBlendAmount As Byte
    tAlphaType As Byte
End TypePublic Declare Function AlphaBlend Lib "msimg32" (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 widthSrc As Long, _
        ByVal heightSrc As Long, ByVal blendFunct As Long) As BooleanPublic Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (Destination As Any, Source As Any, ByVal Length As Long)    大家可以看到，AlphaBlend函数的定义同普通的复制函数Bitblt很相似，只是最后的参数blendFunct定义为一个
rBlendProps结构。那么为什么在函数定义中blendFunct 定义为Long类型呢？因为rBlendProps结构长度是4个字节。
而Long类型变量的长度也是4个字节，那么我们就可以程序中通过API函数CopyMemory将一个rBlendProps结构拷贝到
blendFunct 中。    在Form1中添加两个PictureBox控件，其中Picture2为源，Picture1为拷贝目标，将两者的ScaleMode都设置为3-Pixel
将两者的AutoRedraw属性都设置为True，然后分别添加图像。在加入一个Timer控件以及一个CommandButton控件，然后
在Form1的代码窗口中添加如下代码：Dim lTime As ByteSub ShowTransparency(cSrc As PictureBox, cDest As PictureBox, _
    ByVal nLevel As Byte)
    Dim LrProps As rBlendProps
    Dim LnBlendPtr As Long
    
    cDest.Cls
    LrProps.tBlendAmount = nLevel
    CopyMemory LnBlendPtr, LrProps, 4
    With cSrc
        AlphaBlend cDest.hDC, 0, 0, .ScaleWidth, .ScaleHeight, _
            .hDC, 0, 0, .ScaleWidth, .ScaleHeight, LnBlendPtr
    End With
    cDest.Refresh
End SubPrivate Sub Command1_Click()   
    lTime = 0
    Timer1.Interval = 100
    Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
    lTime = lTime + 1
    ShowTransparency Picture2, Picture1, lTime
    If lTime >= 255 Then
        Timer1.Enabled = False
    End If
    Me.Caption = Str(Int(lTime / 2.55)) + "%"
End Sub    运行程序，点击Command1，就可以看到Picture2图像拷贝到Picture1上的淡入淡出效果了。
    在结构rBlendProps中，最重要的参数就是tBlendAmount，该值决定了源与目标之间的透明程序。如果为0的话，源完全
透明，如果为255的话，源完全覆盖目标。
    另外AlphaBlend 函数不只用于两个PictureBox之间的拷贝，而且可以在两个Device Context之间的透明拷贝，也就是
说，象窗口等控件之间也可以实现透明效果。不过在编程过程中发现一个问题，不知是否是AlphaBlend的Bug，就是在我写完
程序后，并没有出现透明复制的效果。搞的我以为该函数不起作用，但是当我再打开VB运行上面的程序后，一切有正常了。
我在MSDN上也没有找到相关的Bug列表。http://www.applevb.com/art/alphablend.txt

Answer 2

根本用不着调用 API，如果单纯显示图片，用
Set Picture1.Picture = LoadPicture(App.Path & "\1.bmp")

Answer 3

不好意思，看错了。
请看这个：http://blog.csdn.net/kitegirl/archive/2007/07/11/1684894.aspx

Answer 4

回2楼的话，我主要的目的还是用StretchDIBits来显示，回3楼雨点的代码我看过了，好麻烦，有没有简单一点的只要显示不用任何效果就行。

Answer 5

两个 PictureBox，AutoRedraw 均为 True，一个按钮。Option ExplicitPrivate 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
Private Type BITMAPINFOHEADER '40 bytes
    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 Type
Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type
Private Const BI_RGB = 0&
Private Const BI_RLE4 = 2&
Private Const BI_RLE8 = 1&
Private Const BI_BITFIELDS = 3&
Private Const DIB_RGB_COLORS = 0Private Declare Function StretchDIBits 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 wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As LongPrivate Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
Private Type ICONINFO
    fIcon As Long
    xHotspot As Long
    yHotspot As Long
    hbmMask As Long
    hbmColor As Long
End Type
Private Declare Function GetObjectType Lib "gdi32" (ByVal hgdiobj As Long) As Long
Private Const OBJ_BITMAP = 7
Private Const OBJ_BRUSH = 2
Private Const OBJ_FONT = 6
Private Const OBJ_PAL = 5
Private Const OBJ_PEN = 1
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
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 TypePrivate Type Size
    cx As Long
    cy As Long
End Type
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = sourcePrivate Sub Command1_Click()
    Dim tBmpInfo As BITMAPINFO
    Dim tSize  As Size
    Dim hBmp As Long
    Dim byBits() As Byte
    Dim nbPerLine As Long
    
    hBmp = Picture1.Picture.Handle
    Call GetImageSize(hBmp, tSize)    '取得 Bmp 像素位
    With tBmpInfo.bmiHeader
        .biSize = Len(tBmpInfo.bmiHeader)
        .biWidth = tSize.cx
        .biHeight = tSize.cy
        .biPlanes = 1
        .biBitCount = 24
        .biCompression = BI_RGB
    End With
    nbPerLine = (tSize.cx * 3 + 3) And &HFFFFFFFC
    ReDim byBits(nbPerLine - 1, tSize.cy - 1) As Byte
    Call GetDIBits(Picture1.hdc, hBmp, 0, tSize.cy, byBits(0, 0), tBmpInfo, DIB_RGB_COLORS)
    
    Call StretchDIBits(Picture2.hdc, 0, 0, tSize.cx, tSize.cy, 0, 0, tSize.cx, tSize.cy, byBits(0, 0), tBmpInfo, DIB_RGB_COLORS, SRCCOPY)
    
    Picture2.Refresh
End Sub'得到图片尺寸
Private Sub GetImageSize(ByVal hObject As Long, tSize As Size)
    Dim tBMP  As BITMAP
    Dim tIcon As ICONINFO
    
    If GetObjectType(hObject) = OBJ_BITMAP Then
        Call GetObject(hObject, LenB(tBMP), tBMP)
    ElseIf GetIconInfo(hObject, tIcon) Then
        Call GetObject(tIcon.hbmMask, LenB(tBMP), tBMP)
    End If
    
    tSize.cx = tBMP.bmWidth
    tSize.cy = tBMP.bmHeight
End Sub

Answer 6

Box1 存放源位图，点击按钮显示在 Box2

Answer 7

感谢，经调试，可用，不过我还有个疑问，这个函数的api解释是“将一幅与设备无关位图的全部或部分数据直接复制到指定的设备场景。这个函数在设备场景中定义了一个目标矩形，用于接收位图数据。它也在DIB中定义了一个源矩形，以便从中提取数据。根据设备场景的StretchBlt模式（由SetStretchBltMode函数决定），源矩形会根据需要调整，以便符合目标矩形的要求”按照说明如果我采用2个不同大小的picture框用这个函数应该都会被填满，是不是跟SetStretchBltMode有关系？如何设置才能让picture1的图片适应picture2的大小呢？呵呵 不管怎样，我提出的问题解决了，感谢 Soyokaze ，感谢CSDN。

Answer 8

和SetStretchBltMode没有关系，这个只是控制缩放质量。
两个矩形可以随便指定，StretchDIBits可以将位图缩放后拷贝到目标。我的例程只是简单地是目标、源一样大。你可以自行修改。