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