使用alphablend的问题

Question

请问，如何把一张带有半透明通道(alpha channel)的bmp图片在窗体上画出来？我曾按照下边链接的第二个例子去做，但不能成功。请各位高手指教！http://www.vbaccelerator.com/home/VB/Code/vbMedia/DIB_Sections/Alpha_DIBSection/article.asp

Answer 1

下面是我所说的“第2个例子”部分。我按照他的方法去做，总不能成功。下文所涉及到的 alphalogo.bmp 文件可以在以下地址下载：
http://www.vbaccelerator.com/home/VB/Code/vbMedia/DIB_Sections/Alpha_DIBSection/VB6_Alpha_DIB_Section_Demonstration.zip“第2个例子”部分：
Assuming you have a bitmap in the correct format (alphalogo.bmp in the main download is suitable for this) then the simple way to draw it is as follows. To run this you need to create a PictureBox on the main form with AutoRedraw and AutoSize set True.'api声明部分已略去Private Sub Form_Load()
   Set Picture1.Picture = LoadPicture(App.Path & "\alphalogo.bmp")
End SubPrivate Sub Form_Paint()
   
   ' Draw a red background to demonstrate the alpha blend under
   ' the shadow:
   Me.Line _
      (8 + Picture1.ScaleHeight \ 2, 8 + Picture1.ScaleWidth \ 2) - _
      (8 + Picture1.ScaleHeight * 3 \ 2, 8 + Picture1.ScaleWidth * 3 \ 2), _
      RGB(255, 0, 0), BF
   
   ' Now draw the image using per-pixel alpha values:
   Dim lBlend As Long
   Dim bf As BLENDFUNCTION
   
   bf.BlendOp = AC_SRC_OVER
   bf.BlendFlags = 0
   bf.SourceConstantAlpha = 255
   bf.AlphaFormat = AC_SRC_ALPHA
   CopyMemory lBlend, bf, 4
   
   AlphaBlend Me.hDC, 8, 8, _
         Picture1.ScaleWidth \ Screen.TwipsPerPixelX, _
         Picture1.ScaleHeight \ Screen.TwipsPerPixelY, _
         Picture1.hDC, 0, 0, _
         Picture1.ScaleWidth \ Screen.TwipsPerPixelX, _
         Picture1.ScaleHeight \ Screen.TwipsPerPixelY, _
         lBlend
   
End Sub

Answer 2

我是这样用的，你试一下
BF.SourceConstantAlpha = CurrentGray
RtlMoveMemory lBF, BF, 4
AlphaBlend Me.hdc,0,0,W,H,Picture1.hdc,0,0, Picture1.ScaleWidth,Picture1.ScaleHeight, lBF
从PICTUREBOX上向ME窗体贴图，CurrentGray为透明度，窗体的AUTOREDRAW为FALSE可以立即看到效果，如果为TRUE则需要ME.REFRESH

Answer 3

请诸位注意，我的图片是带有半透明通道的。所以，我应该把 bf.AlphaFormat 设置为AC_SRC_ALPHA。但在如上执行AlphaBlend后，发现它返回了FALSE (就是失败了)。不知为什么。请各位见教！

Answer 4

你把　bf.SourceConstantAlpha = 255　改为　bf.SourceConstantAlpha = 127试试看

Answer 5

还是不行。我想，会不会这个bmp图片，在loadpicture时被vb删去了半透明通道，从而导致 AlphaBlend 返回false（bf.AlphaFormat=1 或 bf.AlphaFormat=AC_SRC_ALPHA）。如果用bf.alphaformat=0 来调用，却是可以画的。如果真的是上面的原因，那么怎么才能绕过vb而读取图片并获得dc呢？

Answer 6

还有一个问题要注意一下：AlphaBlend 在98下面是没有效果的，至少要在2000下才起作用。
还有要注意的是就是，只有32位的图像才是带ALPHA通道的，似乎只有PHOTOSHOP才支持，BMP位图是没有ALPHA通道的。
所以，我建议你还是用bf.alphaformat=0，并且在执行的速度上是一样的。

Answer 7

如果只能这样，那么我的程序就很不美观了。请看截图：
http://youngcat.crcoo.com/a.png所以，我还是希望能有什么办法绕过vb，读取图片，并取得图片的DC。

Answer 8

如果你认为vb删去了半透明通道的话，可以用GetObject API验证一下，如果你的BMP的确是32位的话，确认你的bmp的每一个像素的红、绿、蓝值都预先与像素的alpha值相乘过。

Answer 9

我确认我的 alphalogo.bmp 是一个 32 位的 bmp 文件，用 photoshop 打开也可以看到其透明通道。但是我还不知道如何获取这个图片。按照你的意思，我尝试了下列语句：Dim hBitmap As Long, aBitmap As BITMAPhBitmap = LoadImage(App.hInstance, "C:\alphalogo.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_LOADTRANSPARENT)GetObject hBitmap, Len(aBitmap), aBitmapDebug.Print aBitmap.bmBitsPixel显示是24，而不是32。期待着你（们）的答复！

Answer 10

LoadImage 时不要用 LR_LOADTRANSPARENT ，然后加上 LR_CREATEDIBSECTION。然后，如果不麻烦你的话，你可以把你的bmp文件发给我吗？ [email protected]  谢谢
这样的话我可以在我的机子上帮你测试。

Answer 11

修改后，aBitmap.bmBitsPixel=32，终于弄好了。但是，alphablend 函数要使用一个 DC。请问我应该怎样把这个 DIB 放到一个 DC 里边呢？

Answer 12

不知为什么，LoadPicture在我的WinXP机子上完全可以。不知同样的代码你那里行不行。
（我用vbaccelerator的那个bmp和我自己做的bmp都行）窗口代码：Option ExplicitPrivate Declare Function AlphaBlend Lib "msimg32" (ByVal hdcDest As Long, ByVal nXOriginDest As Long, ByVal nYOriginDest As Long, ByVal nWidthDest As Long, ByVal nHeightDest As Long, ByVal hdcSrc As Long, ByVal nXOriginSrc As Long, ByVal nYOriginSrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal blendFunc As Long) As Long
Private Const AC_SRC_OVER = &H0
Private Const AC_SRC_ALPHA = &H1
Private Declare Function CreateCompatibleDC 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 DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetObjectA Lib "gdi32" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
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 TypeDim pix As IPictureDisp, pixdc As Long, pixbmp As BITMAPPrivate Sub Form_Load()
  Set pix = LoadPicture("alphalogo.bmp")
  pixdc = CreateCompatibleDC(0&)
  SelectObject pixdc, pix.Handle
  GetObjectA pix.Handle, LenB(pixbmp), pixbmp
End SubPrivate Sub Form_Paint()
  AlphaBlend Me.hdc, 0&, 0&, pixbmp.bmWidth, pixbmp.bmHeight, _
    pixdc, 0&, 0&, pixbmp.bmWidth, pixbmp.bmHeight, _
    MakeBlendFunction(AC_SRC_OVER, 0&, 255&, AC_SRC_ALPHA)
End SubPrivate Function MakeBlendFunction(ByVal blendOp As Long, ByVal blendFlags As Long, ByVal SourceConstantAlpha As Long, ByVal alphaFormat As Long) As Long
  MakeBlendFunction = (blendOp And &HFF&) Or ((blendFlags And &HFF&) * &H100&) Or _
    ((SourceConstantAlpha And &HFF&) * &H10000) Or ((alphaFormat And &H7F&) * &H1000000)
  If alphaFormat And &H80& Then MakeBlendFunction = MakeBlendFunction Or &H80000000
End FunctionPrivate Sub Form_Unload(Cancel As Integer)
  DeleteDC pixdc
End Sub

Answer 13

非常感谢 James0001 同志！尽管他/她的方法在我的机子上还不能完全成功，但他/她教与了我如何把图片放到DC中，这恰恰是我原来不懂的。到此结贴。
---------------------------------------------------------在 James0001 的机子上用 loadpicture 能行得通，但在我这里却不行，我想这也许是VB的版本问题，我用的的 VB 是 SP6 的。后来，我结合了上边用 LoadImage 读取图片的方法，之后按照 James0001 的方法，CreateCompatibleDC，SelectObject，GetObject，然后再 alphablend，成功了。下边是我的源码：'API声明在此略过
Dim pixdc As Long, hBitmap As Long, aBitmap As BITMAPPrivate Sub form_load()
  hBitmap = LoadImage(App.hInstance, App.Path + "\alphalogo.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_DEFAULTSIZE Or LR_CREATEDIBSECTION)
  pixdc = CreateCompatibleDC(0&)
  SelectObject pixdc, hBitmap
  GetObject hBitmap, Len(aBitmap), aBitmap
End SubPrivate Sub Form_Paint()
  AlphaBlendMe.hdc, 0&, 0&, aBitmap.bmWidth, aBitmap.bmHeight, _
    pixdc, 0&, 0&, aBitmap.bmWidth, aBitmap.bmHeight, _
    MakeBlendFunction(AC_SRC_OVER, 0&, 255&, AC_SRC_ALPHA)
End SubPrivate Function MakeBlendFunction(...) As Long
  '请见上贴
end Function