使用GetBitmapBits函數,將圖片的顏色信息讀到一個數組中,然后就對數組的數據進行掃描,使用CreateRectRgn函數生成每一個有用點的圖窗體,再使用CombineRgn函數對有用的圖象合并,組成所要的窗體,最后使用SetWindowRgn來設定窗體
程序代碼:
Module1
Public Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Const RGN_OR = 2
Public Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Public Type BITMAP 注釋：14 bytes
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Dim bmByte() As Byte
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
注釋：Public Const WM_SYSCOMMAND = &H112
注釋：Public Const SC_MOVE = &HF012
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Sub SetAutoRgn(hForm As Form, Optional transColor As Byte = vbNull)
Dim X As Long, Y As Long
Dim Rgn1 As Long, Rgn2 As Long
Dim SPos As Long, EPos As Long
Dim bm As BITMAP
Dim hbm As Long
Dim Wid As Long, Hgt As Long
Dim xoff As Long, yoff As Long
獲取窗體背景圖片尺寸
hbm = hForm.Picture
GetObjectAPI hbm, Len(bm), bm
Wid = bm.bmWidth
Hgt = bm.bmHeight
ReDim bmByte(1 To Wid, 1 To Hgt)
GetBitmapBits hbm, Wid * Hgt, bmByte(1, 1) 獲取圖像數組
如果沒有傳入transColor參數，則用第一個像素作為透明色
If transColor = vbNull Then transColor = bmByte(1, 1)
Rgn1 = CreateRectRgn(0, 0, 0, 0)
For Y = 1 To Hgt 逐行掃描
X = 0
Do
X = X + 1
While (bmByte(X, Y) = transColor) And (X < Wid)
X = X + 1 跳過是透明色的點
Wend
SPos = X
While (bmByte(X, Y) <> transColor) And (X < Wid)
X = X + 1 跳過不是透明色的點
Wend
EPos = X - 1
注釋：這一段是合并區域
If SPos <= EPos Then
Rgn2 = CreateRectRgn(SPos - 1, Y - 1, EPos, Y)
CombineRgn Rgn1, Rgn1, Rgn2, RGN_OR
DeleteObject Rgn2
End If
Loop Until X >= Wid
Next Y
SetWindowRgn hForm.hwnd, Rgn1, True 設定窗體形狀區域
DeleteObject Rgn1
End Sub
Form1
Private Sub Form_Load()
Form1.Left = Screen.Width / 2 - Form1.Width / 2
Form1.Top = Screen.Height / 2 - Form1.Height / 2
If Me.Picture <> 0 Then Call SetAutoRgn(Me)
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
移動窗體
If Button = vbLeftButton Then
ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End If
End Sub
延伸閱讀
文章來源于領測軟件測試網 http://www.kjueaiud.com/
