VB.net实际带Alpha通道的PNG图片不规格控件

[skigil]

有一张带不透明通道的PNG图片，当然有一些位置是全透明的。
要求：做一个控件，如picturebox,panel,label,button等，在上面放png，要求png图片透明的地方，该控件要挖空。
注意：是挖空控件，则不是简单的不显示透明区域。即对不透明的区域，鼠标点击是不响应点击事件的。
100求助，不够可再加100分，目前有一些例子是C#或者C++，看不明白，专业不同啊，唉。。。。

[足球中国]

c#的代码完全可以转为vb.net的。 有在线的也有安装的。安装的转换的比较好一些。

[skigil]

Imports System.Collections.Generic Imports System.ComponentModel Imports System.Data Imports System.Drawing Imports System.Linq Imports System.Text Imports System.Windows.Forms Imports System.Drawing.Imaging Imports System.Drawing.Drawing2D Imports System.Runtime.InteropServices Partial Public Class Form1 Inherits Form <DllImport("gdi32.dll")> _ Public Shared Function ExtCreateRegion(ByVal lpXform As IntPtr, ByVal nCount As UInteger, ByRef lpRgnData As Byte) As IntPtr End Function Public Shared RGN_AND As Integer = 1 Public Shared RGN_OR As Integer = 2 Public Shared RGN_XOR As Integer = 3 Public Shared RGN_DIFF As Integer = 4 Public Shared RGN_COPY As Integer = 5 Public Shared RGN_MIN As Integer = RGN_AND Public Shared RGN_MAX As Integer = RGN_COPY <DllImport("gdi32.dll")> _ Public Shared Function CombineRgn(ByVal hrgnDest As IntPtr, ByVal hrgnSrc1 As IntPtr, ByVal hrgnSrc2 As IntPtr, ByVal fnCombineMode As Integer) As Integer End Function <DllImport("gdi32.dll")> _ Public Shared Function DeleteObject(ByVal hObject As IntPtr) As Boolean End Function Public Sub New() InitializeComponent() End Sub Private Sub Form1_Load_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim box1 As New Bitmap(pictureBox1.Image) '设置PicturBox图片源 Dim color As Color = box1.GetPixel(0, 0) pictureBox1.Region = ImageToRegion(pictureBox1.Image, color) End Sub Public Function ImageToRegion(ByVal AImage As Image, ByVal ATransparent As Color) As Region '转贴请注明出处ZswangY37(wjhu111#21cn.com) 时间2007-05-25 If AImage Is Nothing Then Return Nothing End If Dim vBitmap As New Bitmap(AImage) Dim vBitmapData As BitmapData = vBitmap.LockBits(New System.Drawing.Rectangle(0, 0, vBitmap.Width, vBitmap.Height), ImageLockMode.[ReadOnly], PixelFormat.Format32bppRgb) Dim vAddress As Integer = CInt(vBitmapData.Scan0) Dim vOffset As Integer = vBitmapData.Stride - vBitmap.Width * 4 ' 每行多出的字节数 Dim h As Integer = vBitmap.Height, w As Integer = vBitmap.Width Dim vTransparent As Integer = ColorTranslator.ToWin32(ATransparent) ' 透明色 Dim vAllocRect As Integer = (&H100000 - 4 * 8) \ 4 ' 预分配的矩形数 If h * w < vAllocRect Then vAllocRect = h * w End If Dim vBuffer As [Byte]() = New Byte(4 * 8 + (4 * 4 * vAllocRect - 1)) {} '头信息dwSize\iType\nCount\nRegSize Dim vCount As UInteger = 0 vBuffer(0) = 4 * 8 'dwSize//头信息大小 vBuffer(4) = 1 'iType//int RDH_RECTANGLES = 1;//数据类型 Dim vResult As IntPtr = IntPtr.Zero Dim vPointer As UInteger = 4 * 8 Dim vWriteRect As Boolean = False Dim vWriteAlways As Boolean = False For y As Integer = 0 To h - 1 Dim vBlockStart As Integer = 0 Dim vLastMaskBit As Boolean = False For x As Integer = 0 To w - 1 Dim i As Integer = Marshal.ReadInt32(CType(vAddress, IntPtr)) And &HFFFFFF If vTransparent = i Then ' 透明色 If vLastMaskBit Then vWriteRect = True End If Else If Not vLastMaskBit Then vBlockStart = x vLastMaskBit = True End If End If If x = w - 1 Then If y = h - 1 Then vWriteRect = True vWriteAlways = True ElseIf vLastMaskBit Then vWriteRect = True End If x += 1 End If If vWriteRect Then If vLastMaskBit Then vCount += 1 WriteRect(vBuffer, vPointer, New System.Drawing.Rectangle(vBlockStart, y, x - vBlockStart, 1)) End If If vCount = vAllocRect OrElse vWriteAlways Then vBuffer(8) = CByte(vCount) vBuffer(9) = CByte(vCount >> 8) vBuffer(10) = CByte(vCount >> 16) vBuffer(11) = CByte(vCount >> 24) Dim hTemp As IntPtr = ExtCreateRegion(IntPtr.Zero, 4 * 8 + 4 * 4 * vCount, vBuffer(0)) If vResult = IntPtr.Zero Then vResult = hTemp Else CombineRgn(vResult, vResult, hTemp, RGN_OR) DeleteObject(hTemp) End If vCount = 0 vPointer = 4 * 4 vWriteAlways = False End If vWriteRect = False vLastMaskBit = False End If vAddress += 4 Next vAddress += vOffset Next vBitmap.UnlockBits(vBitmapData) Return Region.FromHrgn(vResult) End Function Private Sub WriteRect(ByVal ARGNData As Byte(), ByRef ptr As UInteger, ByVal r As System.Drawing.Rectangle) ARGNData(ptr) = CByte(r.X) ARGNData(ptr + 1) = CByte(r.X >> 8) ARGNData(ptr + 2) = CByte(r.X >> 16) ARGNData(ptr + 3) = CByte(r.X >> 24) ARGNData(ptr + 4) = CByte(r.Y) ARGNData(ptr + 5) = CByte(r.Y >> 8) ARGNData(ptr + 6) = CByte(r.Y >> 16) ARGNData(ptr + 7) = CByte(r.Y >> 24) ARGNData(ptr + 8) = CByte(r.Right) ARGNData(ptr + 9) = CByte(r.Right >> 8) ARGNData(ptr + 10) = CByte(r.Right >> 16) ARGNData(ptr + 11) = CByte(r.Right >> 24) ARGNData(ptr + 12) = CByte(r.Bottom) ARGNData(ptr + 13) = CByte(r.Bottom >> 8) ARGNData(ptr + 14) = CByte(r.Bottom >> 16) ARGNData(ptr + 15) = CByte(r.Bottom >> 24) ptr += 16 End Sub End Class 再建以下模块 Imports System.Collections.Generic Imports System.Linq Imports System.Windows.Forms Namespace WindowsFormsApplication1 NotInheritable Class Program Private Sub New() End Sub ''' <summary> ''' 应用程序的主入口点。 ''' </summary> <STAThread()> _ Private Shared Sub Main() Application.EnableVisualStyles() Application.SetCompatibleTextRenderingDefault(False) Application.Run(New Form1()) End Sub End Class End Namespace

[skigil]

上述代码只能实现小图片获取不规则形状，对于大图片无法得出结果，求解释

[skigil]

问题已解决，放上PICTUREBOX的图片需透明的颜色改为白色即可了

[以专业开发人员为伍]

引用 楼主 skigil 的回复:

100求助，不够可再加100分，目前有一些例子是C#或者C++，看不明白，专业不同啊，唉。。。。

不是什么“专业不同”，是观念不同。 谁还跟winform、GDI+较劲？ wpf/silverlight根本不是GDI+。 对你来说整这些所谓的GDI+绘图，只能自慰，而不是搞项目。

[以专业开发人员为伍]

在我们的服务器端，早期有过一点点GDI+画图的代码。可是随着需要进行各种地图处理，我们还是在服务器端引入WPF了（注意是服务器端，而不是客户端）。当你因为需求太复杂而不得不用了WPF，才知道原来的所谓“绘图”全都是瞎耽误工夫。

[沐NeMo]

照sp哥说，以后编程越来越容易拉。 发展趋势也应如此。

[dylike]

存在，则必有其优势之处。