'Start a new project, and to the form add two controls - a single command button and a single PictureBox containing the picture to make transparent (Source), as shown in the illustration. The 'Transparent Result' in this example is displayed on the form's hdc, not in another picture or image control.
'For the best effect, set the source picture (the one to make transparent) to a bitmap that has various colours on white background.  The Source PictureBox ScaleMode property should be set to to 3 - Pixel. The colour that will ultimately become the transparent colour is passed as the last parameter in the call to the TransparentBlt routine (vbWhite in this example).
'
' BAS Module Code
'Add the following code to a BAS module:Option ExplicitPublic Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End TypePublic Declare Function BitBlt Lib "gdi32" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop 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 SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject 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 CreateCompatibleDC Lib "gdi32" (ByVal hdc 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 Long
   ' Form Code
'Add the following code to the form:
Private Sub Command1_Click()
  Dim R As RECT  With R
   .Left = 0
   .Top = 0
   .Right = Picture1.ScaleWidth
   .Bottom = Picture1.ScaleHeight
  End With  TransparentBlt Form1.hdc, Form1.hdc, Picture1.hdc, R, 20, 20, vbWhiteEnd SubPrivate Sub TransparentBlt(OutDstDC As Long, DstDC As Long, SrcDC As Long, SrcRect As RECT, DstX As Integer, DstY As Integer, TransColor As Long)
   
  'DstDC- Device context into which image must be
  'drawn transparently
  'OutDstDC- Device context into image is actually drawn,
  'even though it is made transparent in terms of DstDC
  'Src- Device context of source to be made transparent
  'in color TransColor
  'SrcRect- Rectangular region within SrcDC to be made
  'transparent in terms of DstDC, and drawn to OutDstDC
  'DstX, DstY - Coordinates in OutDstDC (and DstDC)
  'where the transparent bitmap must go. In most
  'cases, OutDstDC and DstDC will be the same
   
  Dim nRet As Long, W As Integer, H As Integer
  Dim MonoMaskDC As Long, hMonoMask As Long
  Dim MonoInvDC As Long, hMonoInv As Long
  Dim ResultDstDC As Long, hResultDst As Long
  Dim ResultSrcDC As Long, hResultSrc As Long
  Dim hPrevMask As Long, hPrevInv As Long
  Dim hPrevSrc As Long, hPrevDst As Long  W = SrcRect.Right - SrcRect.Left + 1
  H = SrcRect.Bottom - SrcRect.Top + 1
   
 'create monochrome mask and inverse masks
  MonoMaskDC = CreateCompatibleDC(DstDC)
  MonoInvDC = CreateCompatibleDC(DstDC)
  hMonoMask = CreateBitmap(W, H, 1, 1, ByVal 0&)
  hMonoInv = CreateBitmap(W, H, 1, 1, ByVal 0&)
  hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
  hPrevInv = SelectObject(MonoInvDC, hMonoInv)
   
 'create keeper DCs and bitmaps
  ResultDstDC = CreateCompatibleDC(DstDC)
  ResultSrcDC = CreateCompatibleDC(DstDC)
  hResultDst = CreateCompatibleBitmap(DstDC, W, H)
  hResultSrc = CreateCompatibleBitmap(DstDC, W, H)
  hPrevDst = SelectObject(ResultDstDC, hResultDst)
  hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
   
'copy src to monochrome mask
  Dim OldBC As Long
  OldBC = SetBkColor(SrcDC, TransColor)
  nRet = BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top, vbSrcCopy)
  TransColor = SetBkColor(SrcDC, OldBC)
   
 'create inverse of mask
  nRet = BitBlt(MonoInvDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbNotSrcCopy)
   
 'get background
  nRet = BitBlt(ResultDstDC, 0, 0, W, H, DstDC, DstX, DstY, vbSrcCopy)
   
 'AND with Monochrome mask
  nRet = BitBlt(ResultDstDC, 0, 0, W, H, MonoMaskDC, 0, 0, vbSrcAnd)
   
 'get overlapper
  nRet = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top, vbSrcCopy)
   
 'AND with inverse monochrome mask
  nRet = BitBlt(ResultSrcDC, 0, 0, W, H, MonoInvDC, 0, 0, vbSrcAnd)
   
'XOR these two
  nRet = BitBlt(ResultDstDC, 0, 0, W, H, ResultSrcDC, 0, 0, vbSrcInvert)
   
 'output results
  nRet = BitBlt(OutDstDC, DstX, DstY, W, H, ResultDstDC, 0, 0, vbSrcCopy)
   
 'clean up
  hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
  DeleteObject hMonoMask  hMonoInv = SelectObject(MonoInvDC, hPrevInv)
  DeleteObject hMonoInv  hResultDst = SelectObject(ResultDstDC, hPrevDst)
  DeleteObject hResultDst  hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
  DeleteObject hResultSrc  DeleteDC MonoMaskDC
  DeleteDC MonoInvDC
  DeleteDC ResultDstDC
  DeleteDC ResultSrcDCEnd Sub

解决方案 »

  1.   

    在 VB 中,如果你试着把一只有鸟的图片放到背景的一棵树上,你就会发现树会被鸟遮
    住一个矩形的区域(即鸟的图片矩形)。我们可以通过以下方法使图片上非鸟的其它部
    分变透明:我们可以利用一个 WinAPI 函数 BitBlt 对图形进行一系列的位操作来达到
    此目的。
    函数声明: 
    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
    参数解释: 
    目标环境:hDestDC——目标设备环境;x——左上角;y——顶端;nWidth——宽;
            nHeight——高
    源环境:hSrcDC——源设备环境;xSrc——源左上角;ySrc——源顶端; 
    dwRop——位处理操作,如 vbSrcAnd;vbSrcAnd;vbSrcCopy;vbSrcErase;
    vbSrcInvert 等 
    (目标环境或源环境只能是 Picture, Form 或 Printer 对象。各单位为象素。) 
    进行处理之前,我们需要对鸟的图片进行处理:先复制一份相同的图形,将其应该透明
    之处(鸟的背景)设置为黑色(设此图为sPic),再将另一图做以下处理:要复制的地
    方(鸟)设置为黑色,其余地方设置(鸟的背景)为白色(设此图为Mask)。 
    设树的图形为名dPic。 
    最后,请加入以下代码: 
    R=BitBlt(dPic.hdc,0,0,sPic.Width,sPic.Height,Mask.hdc,0,0,vbScrCopy) 
    R=BitBlt(dPic.hdc,0,0,sPic.Width,sPic.Height,sPic.hdc,0,0,vbScrInvert) 
    后记: 
    1、VB 中的 PaintPicture 方法提供类似功能,但速度不及此方法; 
    2、在此方法上稍微加入一些代码,就不难实现动画的显示。 
    3、VB 例子中的 CallDlls 就使用此方法。
      

  2.   

    简单介绍透明位图的实现方法   
    作者:吴斌透明位图在VB中的实现方法及应用  在VB中显示位图,通常都是通过各种控件实现的。通过控件显示的位图,或全部或局部,始终是以一个规则的矩形图像出现在屏幕上,无法做到只显示位图中某个不规则的局部图像,而使位图的其它部分具有透明性以露出其下原有的屏幕显示,即所谓“透明位图”,因此透明位图的实现只能另辟蹊径。下面,笔者将向大家介绍一种方法。  原理  其实,Windows中随处可见的图标就是一个透明位图的典型实例。
      图标是由两个单独的位图组成的。第一个位图是由黑色(颜色位全为0)背景与彩色图标图案组成的,该位图将与当前屏幕显示通过异或(XOR)操作结合起来,故称其为XOR位图。第二个位图是由白色(颜色位全为1)背景与黑色(颜色位全为0)图标图案组成的,该位图将与当前屏幕显示通过与(AND)操作结合起来,故称其为AND位图。图标的显示是通过两个步骤完成的:  当前屏幕显示与AND位图通过AND操作结合起来;
      当前屏幕显示与XOR位图通过XOR操作结合起来。  大家知道,1与任何数值AND操作的结果将维持原数值,而0与任何数值AND操作的结果则是0,因此在步骤1中,AND位图中白色(1)与屏幕显示经过AND操作后被原色彩屏蔽,而黑色(0)则将原色彩屏蔽。步骤1结束后,屏幕上将留下一个黑色的图标图案。在随后的步骤2中,由于0与任何数值异或的结果都将是原数值,因此,XOR位图与屏幕显示经过异或操作后,位图和屏幕中的黑色部分都将被各自对应的彩色部分屏蔽。步骤2结束后,一个形状不规则的图标图案就出现在屏幕上了。这就是图标显示的原理。  方法  首先,根据源位图和应用需求,制作出AND位图和XOR位图,然后,按照上述步骤,依次将AND位图和XOR位图与屏幕显示结合起来,便可实现透明位图了。
      AND位图和XOR位图的制作,在许多图像处理软件中都可以轻而易举地完成,笔者不再详细描述。AND位图和XOR位图与屏幕显示的结合,可以通过像素迭加时的光栅操作完成,具体实现可以使用VB4中为Form和PictureBox新增的方法PaintPicture。该方法的功能是将一个图像文件的内容传送到Form或PictureBox的显示屏幕上,也就是将源图像中的像素与当前显示屏幕上对应的像素叠加在一起。PaintPicture的语法为:object.PaintPicturepicture,x1,y1,width1,height1,x2,y2,width2,height2,opcode。其中,object是调用方法的Form或PictureBox对象实例;picture指定源图像,该参数必须是Form或PictureBox控件的Picture属性;x1,y1指定目标对象中用于摆放被传送图像的矩形区域左上角的逻辑坐标点;width1,height1指定目标对象中用于摆放被传送图像的矩形区域的宽度和高度;x2,y2指定源图像中被传送的矩形区域左上角的逻辑坐标点;width2,height2指定源图像中被传送部分的宽度和高度;opcode指定传送过程中使用的光栅操作代码值,AND操作代码值为H8800C6,XOR操作代码值为H660046。  实例  下面,本文介绍一个透明位图的应用实例,实例演示一个卡通人物在窗口顶部循环地从左到右穿越窗口的动画。动画的播放采用PictureClip控件和Timer控件来实现,动画画面的显示则使用本文的透明位图技术。
      新建一个VB项目,在Form1中加入一个Timer控件Timer1,两个PictureClip控件bmpXOR和bmpAND,将它们的Picture属性分别设置为XOR.BMP和AND.BMP,这两个位图就是透明位图所使用的XOR位图和AND位图,如右所示。
      在Form的Generaldeclaration部分加入下列常量声明:  Const SRCAND As Long=&H8800C6
      Const SRCINVERT AsLong=&H660046
      Const StepLength = 10
      Const AnimateSpeed = 100  项目代码如下:
      Private Sub Form_Load()
       Me.ScaleMode=3
       With bmpAND
        .Cols=4
        .Rows=2
       End With
       With bmpXOR
        .Cols=4
        .Rows=2
        End With
       Timer1.Interval=AnimateSpeed
      EndSub  Private Sub Timer1_Timer()
       Static CurPic As Integer
       Static CurX As Single
       Me.Refresh
       If CurPic > bmpAND.Cols*bmpAND.Rows-1 Then CurPic=0
       If CurX > Me.ScaleWidth Then CurX=0
       Me.PaintPicture bmpAND.GraphicCell(CurPic),CurX,0,,,,,,,SRCAND
       Me.PaintPicture bmpXOR.GraphicCell(CurPic),CurX,0,,,,,,,SRCINVERT
       CurPic=CurPic+1
       CurX=CurX+StepLength
      End Sub  按F5运行,Form1中就会出现一个在窗口顶部从左到右循环地行走的卡通人物。人物行走的速度和步长可以通过常量AnimateSpeed和StepLength控制。为了检验透明位图的效果,可以为Form1设置各种背景。您会看到,使用透明位图技术显示的动画与各种背景都能自然地融合在一起,如同事先渲染生成的动画影片一样。这就是透明位图技术希望达到的目的。