明晨网络

电话： 136-6532-7492 QQ: 给我发送消息 8507-0741

让VB的PictureBox控件支持透明图片

admin，2009-06-12 19:20， 文章标签: VB

    我们通常在VB中使用图片控件来做出漂亮的界面，但是PictureBox控件不能支持透明图片，就算放置一个透明的GIF图片，PictureBox空间的背景颜色依旧会挡住下面的Form窗体或者其他控件。使用Image控件虽然支持透明，但是Image控件是没有句柄的轻量级控件，功能比之PictureBox太弱了。明晨网络Mingchennet.com在国外收集到一段代码，较完美地实现了让PictureBox控件支持透明图片。

    使用时，先将目标PictureBox的BackColor设置为白色，再调用ShapeMe RGB(255, 255, 255), True, , PictureBox ，就可以让名称为PictureBox 的PictureBox 控件背景透明了。

 

代码如下
  1. '========================================
  2. '声明作用：透明化PictureBox，注意设置其背景颜色为纯白
  3. '========================================
  4. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  5. Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  6. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  7. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  8. Private Declare Sub ReleaseCapture Lib "user32" ()
  9. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  10. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  11. Private Const RGN_DIFF = 4
  12. Dim CurRgn As Long, TempRgn As Long  ' Region variables
  13.  
  14. '========================================
  15. '函数名称：ShapeMe
  16. '函数作用：透明化PictureBox背景
  17. '========================================
  18. Public Sub ShapeMe(Color As Long, HorizontalScan As Boolean, Optional Name1 As Form = Nothing, Optional Name2 As PictureBox = Nothing)
  19.    
  20.     Dim X As Integer, Y As Integer 'points on form
  21.    Dim dblHeight As Double, dblWidth As Double 'height and width of object
  22.    Dim lngHDC As Long 'the hDC property of the object
  23.    Dim booMiddleOfSet As Boolean 'used during the gathering of transparent points
  24.    Dim colPoints As Collection 'this will hold all usrPoints
  25.    Set colPoints = New Collection
  26.     Dim Z As Variant 'used during iteration through collection
  27.    Dim dblTransY As Double 'these 3 variables hold each point that will be made transparent
  28.    Dim dblTransStartX As Double
  29.     Dim dblTransEndX As Double
  30.     Dim Name As Object 'will hold the name of the object.  Late-bound and slower, but allows different types (in this case Form or PictureBox)
  31.    
  32.     'check out the name or names passed into the subroutine
  33.    If Name1 Is Nothing Xor Name2 Is Nothing Then 'we know there is a name in one of them
  34.        If Name1 Is Nothing Then 'set the name
  35.            Set Name = Name2
  36.         Else
  37.             Set Name = Name1
  38.         End If
  39.     Else 'both or none hold valid names
  40.        MsgBox "Must pass in the name of either a Form OR a PictureBox.  TransForm received NONE or BOTH.  Function failed.", vbOKOnly, "ShapeMe Subroutine"
  41.         Exit Sub
  42.     End If
  43.    
  44.     'initialization
  45.    With Name
  46.         .AutoRedraw = True 'object must have this setting
  47.        .ScaleMode = 3 'object must have this setting
  48.        lngHDC = .hdc 'faster to use a variable; VB help recommends using the property, but I didn't encounter any problems
  49.        If HorizontalScan = True Then 'look for lines of transparency horizontally
  50.            dblHeight = .ScaleHeight 'faster to use a variable
  51.            dblWidth = .ScaleWidth 'faster to use a variable
  52.        Else 'look vertically (note that the names "dblHeight" and "dblWidth" are non-sensical now, but this was an easy way to do this
  53.            dblHeight = .ScaleWidth 'faster to use a variable
  54.            dblWidth = .ScaleHeight 'faster to use a variable
  55.        End If 'HorizontalScan = True
  56.    End With
  57.     booMiddleOfSet = False
  58.    
  59.     'gather all points that need to be made transparent
  60.    For Y = 0 To dblHeight  ' Go through each column of pixels on form
  61.        dblTransY = Y
  62.         For X = 0 To dblWidth  ' Go through each line of pixels on form
  63.            'note that using GetPixel appears to be faster than using VB's Point
  64.            If TypeOf Name Is Form Then 'check to see if this is a form and use GetPixel function which is a little faster
  65.                If GetPixel(lngHDC, X, Y) = Color Then  ' If the pixel's color is the transparency color, record it
  66.                    If booMiddleOfSet = False Then
  67.                         dblTransStartX = X
  68.                         dblTransEndX = X
  69.                         booMiddleOfSet = True
  70.                     Else
  71.                         dblTransEndX = X
  72.                     End If 'booMiddleOfSet = False
  73.                Else
  74.                     If booMiddleOfSet Then
  75.                         colPoints.Add Array(dblTransY, dblTransStartX, dblTransEndX)
  76.                         booMiddleOfSet = False
  77.                     End If 'booMiddleOfSet = True
  78.                End If 'GetPixel(lngHDC, X, Y) = Color
  79.            ElseIf TypeOf Name Is PictureBox Then 'if a PictureBox then use Point; a little slower but works when GetPixel doesn't
  80.                If Name.Point(X, Y) = Color Then
  81.                     If booMiddleOfSet = False Then
  82.                         dblTransStartX = X
  83.                         dblTransEndX = X
  84.                         booMiddleOfSet = True
  85.                     Else
  86.                         dblTransEndX = X
  87.                     End If 'booMiddleOfSet = False
  88.                Else
  89.                     If booMiddleOfSet Then
  90.                         colPoints.Add Array(dblTransY, dblTransStartX, dblTransEndX)
  91.                         booMiddleOfSet = False
  92.                     End If 'booMiddleOfSet = True
  93.                End If 'Name.Point(X, Y) = Color
  94.            End If 'TypeOf Name Is Form
  95.            
  96.         Next X
  97.     Next Y
  98.    
  99.     CurRgn = CreateRectRgn(0, 0, dblWidth, dblHeight)  ' Create base region which is the current whole window
  100.    
  101.     For Each Z In colPoints 'now make it transparent
  102.        TempRgn = CreateRectRgn(Z(1), Z(0), Z(2) + 1, Z(0) + 1)  ' Create a temporary pixel region for this pixel
  103.        CombineRgn CurRgn, CurRgn, TempRgn, RGN_DIFF  ' Combine temp pixel region with base region using RGN_DIFF to extract the pixel and make it transparent
  104.        DeleteObject (TempRgn)  ' Delete the temporary region and free resources
  105.    Next
  106.    
  107.     SetWindowRgn Name.hWnd, CurRgn, True  ' Finally set the windows region to the final product
  108.    'I do not use DeleteObject on the CurRgn, going with the advice in Dan Appleman's book:
  109.    'once set to a window using SetWindowRgn, do not delete the region.
  110.    
  111.     Set colPoints = Nothing
  112.    
  113. End Sub
  114.  

文章源自:明晨网络，admin，《让VB的PictureBox控件支持透明图片》，http://www.mingchennet.com/tec/code/vb/29.htm