网站公告列表

  没有公告

加入收藏
设为首页
联系站长
您现在的位置: 网络学院 >> 程序设计 >> VB编程 >> 文章正文
  透明位图            【字体:
透明位图
作者:佚名    文章来源:不详    点击数:    更新时间:2007-7-1    
正在装载数据……

 

'以下在form 需二个PictureBox,一个Image Control, 一个Command Box

vate Sub Command1_Click()
Dim dx As Long, dy As Long

Call GetInvertMaskPic(Picture1, Image1, RGB(255, 255, 255))
'注释:请确认相对pen.bmp图的背景颜色是什麽,本例中是白色,故使用RGB(255,255,255)
Call GetMaskPic(Picture1, Image1, RGB(255, 255, 255))

dx = Me.ScaleX(Image1.Picture.Width, vbHimetric, vbPixels)
dy = Me.ScaleY(Image1.Picture.Height, vbHimetric, vbPixels)

'注释: 以下将image1的图去除背景画在Picture2之上
Set Picture1.Picture = Image1.Picture
BitBlt Picture2.hDc, 0, 0, dx, dy, hMaskDC, 0, 0, vbSrcAnd
BitBlt Picture1.hDc, 0, 0, dx, dy, hInvertMaskDC, 0, 0, vbSrcAnd
BitBlt Picture2.hDc, 0, 0, dx, dy, Picture1.hDc, 0, 0, vbSrcPaint

End Sub

Private Sub Form_Load()
Picture1.Visible = False
Picture1.AutoRedraw = True
'注释:Picture1.Appearance = 0 注释:要事先设定
Picture1.BorderStyle = 0
Set Image1.Picture = LoadPicture("c:\1.wmf") '注释:请自行设定您的图
'Set Picture2.Picture = LoadPicture("c:\2.bmp")   '注释:请设定成自己的背景图
Picture2.Height = Image1.Height
Picture2.Width = Image1.Width
Picture2.Picture = Image1.Picture
End Sub

''module1---------------------------

Declare Function CreateCompatibleBitmap Lib "GDI32" _
   (ByVal hDc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Declare Function CreateCompatibleDC Lib "GDI32" _
   (ByVal hDc As Long) As Long
Declare Function DeleteObject Lib "GDI32" _
   (ByVal hObject As Long) As Long
Declare Function SelectObject Lib "GDI32" _
   (ByVal hDc As Long, ByVal hObject As Long) As Long
Declare Function DeleteDC Lib "GDI32" _
   (ByVal hDc As Long) As Long
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
Declare Function SetBkColor Lib "GDI32" _
   (ByVal hDc As Long, ByVal crColor As Long) As Long

Public hMaskDC As Long, hBmpMask As Long
Public hInvertMaskDC As Long, hBmpInvertMask As Long

'注释:取得 hMaskDC 的自订函数,该hMaskDC内的图像是souImg图之背景为白色
'注释:              而souImg的前景图是黑色
'注释:PicBack 叁数: 用来制作 Mask 图的图片盒
'注释:souImg 叁数: 摆放原图的影像之物件,可以是 image/picturebox
'注释:TColor 叁数: 欲去除的颜色,即souImg的背景色
Public Sub GetMaskPic(picBack As PictureBox, _
    souImg As Control, ByVal TColor As Long)
Dim hdcMono, hbmpMono, hbmpOld
Dim ColorBack As Long
Dim dx As Long, dy As Long

    With picBack
    '注释:取得该图的大小, by Pixels
    dx = .ScaleX(souImg.Picture.Width, vbHimetric, vbPixels)
    dy = .ScaleY(souImg.Picture.Height, vbHimetric, vbPixels)
'注释:     设定pictureBox的大小与Source Image的大小相同
    .Width = souImg.Width
    .Height = souImg.Height
    Set .Picture = souImg.Picture
    End With
  
    hdcMono = CreateCompatibleDC(0)
    hbmpMono = CreateCompatibleBitmap(hdcMono, dx, dy)
    hbmpOld = SelectObject(hdcMono, hbmpMono)
  
    picBack.AutoRedraw = True
    picBack.BackColor = RGB(255, 255, 255)
  
    ColorBack = SetBkColor(picBack.hDc, TColor)
    BitBlt hdcMono, 0, 0, dx, dy, picBack.hDc, 0, 0, vbSrcCopy
    Call SetBkColor(picBack.hDc, ColorBack)
    BitBlt picBack.hDc, 0, 0, dx, dy, hdcMono, 0, 0, vbSrcCopy
  
    hMaskDC = CreateCompatibleDC(0)
    hBmpMask = CreateCompatibleBitmap(picBack.hDc, dx, dy)
    Call SelectObject(hMaskDC, hBmpMask)
    BitBlt hMaskDC, 0, 0, dx, dy, picBack.hDc, 0, 0, vbSrcCopy
 
    Call SelectObject(hdcMono, hbmpOld)
    Call DeleteDC(hdcMono)
    Call DeleteObject(hbmpMono)
  
End Sub

'注释:取得 hInvertMaskDC 的自订函数,该hMaskDC内的图像是souImg图之背景为白色
'注释:              而souImg的前景图是黑色
'注释:PicBack 叁数: 用来制作 Mask 图的图片盒
'注释:souImg 叁数: 摆放原图的影像之物件,可以是 image/picturebox
'注释:TColor 叁数: 欲去除的颜色,即souImg的背景色
Public Sub GetInvertMaskPic(picBack As PictureBox, _
    souImg As Control, ByVal TColor As Long)
Dim hdcMono, hbmpMono, hbmpOld
Dim ColorBack As Long
Dim dx As Single, dy As Single

    With picBack
    dx = .ScaleX(souImg.Picture.Width, vbHimetric, vbPixels)
    dy = .ScaleY(souImg.Picture.Height, vbHimetric, vbPixels)
'注释:     设定pictureBox的大小与Source Image的大小相同
    .Width = souImg.Width
    .Height = souImg.Height
    Set .Picture = souImg.Picture
    End With
  
    hdcMono = CreateCompatibleDC(0)
    hbmpMono = CreateCompatibleBitmap(hdcMono, dx, dy)
    hbmpOld = SelectObject(hdcMono, hbmpMono)
  
    picBack.AutoRedraw = True
    picBack.BackColor = RGB(255, 255, 255)
  
    ColorBack = SetBkColor(picBack.hDc, TColor)
    BitBlt hdcMono, 0, 0, dx, dy, picBack.hDc, 0, 0, vbSrcCopy
    Call SetBkColor(picBack.hDc, ColorBack)
    BitBlt picBack.hDc, 0, 0, dx, dy, hdcMono, 0, 0, vbNotSrcCopy
    
    hInvertMaskDC = CreateCompatibleDC(0)
    hBmpInvertMask = CreateCompatibleBitmap(picBack.hDc, dx, dy)
    Call SelectObject(hInvertMaskDC, hBmpInvertMask)
    BitBlt hInvertMaskDC, 0, 0, dx, dy, picBack.hDc, 0, 0, vbSrcCopy

    Call SelectObject(hdcMono, hbmpOld)
    Call DeleteDC(hdcMono)
    Call DeleteObject(hbmpMono)
  
End Sub

 

站内文章搜索 高级搜索
文章录入:admin    责任编辑:admin 
  • 上一篇文章:

  • 下一篇文章:
  • 发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
    最新热点 最新推荐 相关文章
     如何在ado中使用connect…
     vb 贪吃蛇 单人版游戏 (…
     关于在vb中进行com组件的…
     用vb6.0编写自我升级的程…
     vb自动登陆网络站点详解…
     vb打造超酷个性化菜单(…
  • 半透明或过滤某种颜色的实现

  • 透明文本的实现

  • 一种简单的方法在程序中实现…

  • 在GUI控件上放置图片,并在图…

  • 使用Mascot Capsule Micro3D…

  • Swing破局:打造半透明窗口

  • Swing 破局:打造半透明窗口

  • 在java的gui上放置图片,并在…

  • 在jaxp中透明的缓存xsl转换器

  • 用java实现颜色透明值混算的…

  •   网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)
    网络学院©2007 www.23book.net
    为您提供web编程,vb编程,vc编程,服务器架设管理,数据库设计等方面的知识 站长:David