如何让picture里面图象黑色部分或者白色部分变成透明，在线等待！！！

如题！谢谢
我按照faq一直没有调试成功，今天脑子坏了，请大家帮忙！！

16 个解决方案

#1

如果你是用的SetLayeredWindowAttributes，那我很抱歉的告诉你，这个函数不能用来使子窗体变透明。
我也想知道如何可以使子窗体变成透明的，可是还没有找到方法。

#2

我想让picture里面图片的白色部分透明呀

#3

不能這樣做﹐因為它與你的圖片已經連接成一塊﹐它不是象素﹐如果是象素你可以控制

#4

如果是背景顏色的話可以變成透明的.

#5

难道我问的问题有问题吗
我的意思是把一张图片的白色部分去掉变成透明后放到picturebox中呀

#6

为什么非要Picture里的图像？直接在窗体上画透明的图像不行吗？

#7

这个函数不行吗？
Private Declare Function TransparentBlt Lib "msimg32.dll" (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 crTransparent As Long) As Long

#8

看这个，很详细，当然，你需要修改一下：
http://www.china-askpro.com/msg45/qa70.shtml

#9

rainstormmaster(暴风雨 v2.0)
谢谢，但是拖动的时候有严重的影子！！！

#10

先把PICTUREBOX的背景色存储在一个变量里，然后扫描PICTUREBOX里的图片的像素。把白色的部分替换成PICTUREBOX原先的背景色。

#11

我faq应该没整理错误啊，郁闷
http://community.csdn.net/Expert/FAQ/FAQ_Index.asp?id=198199

#12

提问不是很清楚：1，要透明的画还是要透明的镜框？2，居然要透明，为什么非要一个多余的镜框？

#13

//我faq应该没整理错误啊，郁闷
http://community.csdn.net/Expert/FAQ/FAQ_Index.asp?id=198199

呵呵，是没错，估计楼主做的有问题

#14

还有一种很简单的方法,安装PhotoStop 7.0以上版本,将你所要处理的图片处在透明的图层上,再点击帮助菜单里的导出透明图像,选上网,选GIF格式,选三原色或你认为可以的色彩,导出文件后,再用VB导入Picture控件,再用下面的模块处理:

Option Explicit

Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
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
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Function MakeRegion(picSkin As PictureBox) As Long
    Dim X As Long, Y As Long, StartLineX As Long
    Dim FullRegion As Long, LineRegion As Long
    Dim TransparentColor As Long
    Dim InFirstRegion As Boolean
    Dim InLine As Boolean
    Dim hDC As Long
    Dim PicWidth As Long
    Dim PicHeight As Long

    hDC = picSkin.hDC
    PicWidth = picSkin.ScaleWidth
    PicHeight = picSkin.ScaleHeight

    InFirstRegion = True: InLine = False
    X = Y = StartLineX = 0

    TransparentColor = GetPixel(hDC, 0, 0)

    For Y = 0 To PicHeight - 1
        For X = 0 To PicWidth - 1

            If GetPixel(hDC, X, Y) = TransparentColor Or X = PicWidth Then

                If InLine Then
                    InLine = False
                    LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1)

                    If InFirstRegion Then
                        FullRegion = LineRegion
                        InFirstRegion = False
                    Else
                        CombineRgn FullRegion, FullRegion, LineRegion, 2

                        DeleteObject LineRegion
                    End If
                End If
            Else

                If Not InLine Then
                    InLine = True
                    StartLineX = X
                End If
            End If
        Next
    Next

    MakeRegion = FullRegion
End Function

''''''''''''''''''''''''''''''''窗体部分'''''''''''''''''''''''''''''''''''''''''

Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private hBitmap As Long

Private Sub Form_Load()
Dim WindowRegion As Long

    picMainSkin.ScaleMode = vbPixels
    picMainSkin.AutoRedraw = True
    picMainSkin.AutoSize = True
    picMainSkin.BorderStyle = vbBSNone
    Me.BorderStyle = vbBSNone
    Me.Width = picMainSkin.Width
    Me.Height = picMainSkin.Height
    picMainSkin.Top = 0
    picMainSkin.Left = 0
    WindowRegion = MakeRegion(picMainSkin)
    SetWindowRgn Me.hWnd, WindowRegion, True

End Sub

Private Sub picMainSkin_DblClick()
  Unload Me
End Sub

Private Sub picMainSkin_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
           Dim ReturnVal As Long
           X = ReleaseCapture()
           ReturnVal = SendMessage(hWnd, &HA1, 2, 0)
    End If
End Sub

#15

api transparentblt

#16

最简单的办法就是做成图标不就行拉
现在做图标的软件功能很强大，多大尺寸的都可以

#1

#2