Private Declare Function GetRegionData Lib "gdi32" (ByVal hRgn As Long, ByVal dwCount As Long, lpRgnData As Byte) 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 SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function ExtCreateRegion Lib "gdi32" (lpXform As Long, ByVal nCount As Long, lpRgnData As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Sub Command1_Click()
Dim x, y As Integer '当前象素坐标
Dim Red, Green, Blue As Integer '当前象素红,绿,篮组分
Dim Pixel As Long '当前象素点
Dim StarPos, EndPos As Integer '合并区域起点,终点坐标
Dim FirstPoint, AlSet As Integer
Dim FRgn As Integer '起始区域标记
Dim Rgn1, Rgn2, value As Long '显示区域缓冲区
Dim a As Integer
Dim CRed, CGreen, CBlue As Integer '不显示区域颜色标记
'获取不显示颜色
Pixel = Form1.Picture1.Point(1, 1)
CRed = Pixel Mod 256
CGreen = ((Pixel And &HFF00) / 256&) Mod 256&
CBlue = (Pixel And &HFF0000) / 65536
For y = 0 To Picture1.Height
For x = 0 To Picture1.Width
Pixel = Form1.Picture1.Point(x, y)
Red = Pixel Mod 256
Green = ((Pixel And &HFF00) / 256&) Mod 256&
Blue = (Pixel And &HFF0000) / 65536
If Not (Red = CRed And Green = CGreen And Blue = CBlue) Then '判断当前点是否为显示点
If FirstPoint = 0 Then '判断该点是否为显示区域起点,0为是起点
StarPos = x '区域起点为当前点
EndPos = x '设置结束点坐标
FirstPoint = 1 '
AlSet = 0
Else '不为起点
EndPos = x '设置终点坐标
AlSet = 1 '设置区域选定标志
End If
Else '该点为不显示点
If AlSet = 1 Then '已经标记区域
If FRgn = 0 Then '判断是否为起始区域,0为是
FRgn = 1 '设定已有区域标志
Rgn1 = CreateRectRgn(StarPos + 1, y, EndPos, y + 1) '建立显示区域
Else '已经存在显示区域
Rgn2 = CreateRectRgn(StarPos + 1, y, EndPos, y + 1) '建立要与Rgn1合并的区域
If Rgn2 <> 0 Then '建立区域2成功
value = CombineRgn(Rgn1, Rgn1, Rgn2, 2) '合并区域1和区域2
Form1.Picture1.Line (StarPos + 1, y)-(EndPos, y), RGB(2 * y, y * 3, y / 1.5) '显示已合并区域(可不要)
End If
DeleteObject (Rgn2) '删除区域2
End If
End If
FirstPoint = 0 '初始化新区域起点
End If
Next x
Next y
If Rgn1 <> 0 Then
Picture1.Visible = False
SetWindowRgn hwnd, Rgn1, True '显示上面建立的区域
Dim ReginData As Byte
Dim RgnSize As Long
Me.AutoRedraw = True
hBitmap = CreateCompatibleBitmap(Me.hdc, 0, 0)
SelectObject Me.hdc, hBitmap
Me.Refresh
而透明的图形呢,那需要那一种背景透通性的.GIF档,在Form上放一个Image Control,将
图放到Image Control,那就OK了注释:需一个Image Control , 一个Command1
Option Explicit
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private hBitmap As Long
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
注释:事先请设form的BorderStyle = 0 没有框线
Me.AutoRedraw = True
Set Image1.Picture = LoadPicture("e:\bubbles.gif") 注释:请自行找一个背景透明的图
hBitmap = CreateCompatibleBitmap(Me.hdc, 0, 0)
SelectObject Me.hdc, hBitmap
Me.Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteObject hBitmap
End Sub