Option Explicit '函数声明
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, _
ByVal Y As Long) As Long
Private 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Const RGN_OR = 2
Dim I As Integer, j, myint, linex As Integer
Dim Fullr, myColor, crn As Long
Dim Region, PicWidth, PicHeight As Long
Dim mystart, mybool As Boolean
Private Sub Form_Load()
Dim hDC As Long
Me.Width = Picture1.Width '设置窗体宽度等于图形宽度
Me.Height = Picture1.Height '设置窗体宽度等于图形宽度
Picture1.ScaleMode = vbPixels '设置Picture1度量单位为像素
Picture1.AutoRedraw = True '设置Picture1自动重绘有效
Picture1.AutoSize = True '设置Picture1自动调整大小
Picture1.BorderStyle = vbBSNone '设置Picture1的边框样式
Me.BorderStyle = vbBSNone '设置窗体的边框样式
hDC = Picture1.hDC
mystart = True
mybool = False
I = 0
j = 0
PicWidth = Picture1.ScaleWidth
PicHeight = Picture1.ScaleHeight
linex = 0
myColor = GetPixel(hDC, 0, 0) '获取picture1指定像素的rgb值
For j = 0 To PicHeight - 1
For I = 0 To PicWidth - 1
If GetPixel(hDC, I, j) = myColor Or I = PicWidth Then '透明像素
If mybool Then
mybool = False
crn = CreateRectRgn(linex, j, I, j - 1) '创建矩形区域
If mystart Then
Fullr = crn
mystart = False
Else
CombineRgn Fullr, Fullr, crn, RGN_OR '合并区域
DeleteObject CreateRectRgn(linex, j, I, j - 1) '删除透明区域
End If
End If
Else '非透明像素
If Not mybool Then
mybool = True
linex = I
End If
End If
Next
Next
Region = Fullr
SetWindowRgn Me.hWnd, Region, True '设置窗体区域
myint = 0
End Sub
Private Sub Timer1_Timer() '形成动画
Dim hDC As Long
myint = myint + 1
If myint = 1 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz3.bmp")
If myint = 2 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz4.bmp")
If myint = 3 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz5.bmp")
If myint = 4 Then Set Picture1.Picture = LoadPicture(App.Path & "\sz6.bmp")
If myint = 5 Then myint = 0
hDC = Picture1.hDC
mystart = True
mybool = False
I = 0
j = 0
Me.Width = Picture1.Width
Me.Height = Picture1.Height
PicWidth = Picture1.ScaleWidth
PicHeight = Picture1.ScaleHeight
linex = 0
myColor = GetPixel(hDC, 0, 0) '获取picture1指定像素的rgb值
For j = 0 To PicHeight - 1
For I = 0 To PicWidth - 1
If GetPixel(hDC, I, j) = myColor Or I = PicWidth Then '透明像素
If mybool Then
mybool = False
crn = CreateRectRgn(linex, j, I, j - 1) '创建矩形区域
If mystart Then
Fullr = crn
mystart = False
Else
CombineRgn Fullr, Fullr, crn, RGN_OR '合并区域
DeleteObject CreateRectRgn(linex, j, I, j - 1) '删除透明区域
End If
End If
Else '非透明像素
If Not mybool Then
mybool = True
linex = I
End If
End If
Next
Next
Region = Fullr
SetWindowRgn Me.hWnd, Region, True '设置窗体区域
End Sub
Private Sub Picture1_Click()
End
End Sub
