如何实现在图片上面创建不同的点击按钮？

[lken]

一幅流程图片，想在不同的位置用鼠标拉一个矩形区域，然后把这个区域当作一个按钮，点击的时候可以执行相关的程序，我该如何做？

[anteye]

up

[online]

VB中不规则图形热点的实现

所谓图形热点就是指定图形或图像上的某部分区域，当鼠标在这部分区域上单击或双击时，就像命令按钮一样会引发相应事件。笔者在VB 5中用Windows提供的三个API函数轻松实现了任何形状的图形热点，在此具体介绍这一技术的实现步骤。
　　首先在VB5中新建一"标准EXE工程"，设置窗体Form1的ScaleMode属性为3。在窗体代码的声明部分定义如下三个API函数：
　　Private Type POINTAPI
　　　　x As Long
　　　　y As Long
　　End Type
　　Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
　　Private Declare Function DeleteObject Lib "gdi32"(ByVal hObject As Long) As Long
　　Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long,ByVal x As Long, ByVal y As Long) As Long
　　函数说明：CreatePolygonRgn( )函数是用来创建一个图形热点对象，lpPoint参数为形成图形热点区的第一个边界点坐标，nCount参数指出了边界点的个数（如nCount<3时，将无法形成一个封闭区域），nPolyFillMode参数指定填充模式，该函数返回图形热点对象（Long型）；DeleteObject( )函数用来删除一个由hObject参数指定的对象；PtInRegion( )函数用来判断某坐标（由参数x、y指出）是否在hRgn图形热 点对象指出的热点区内，若是返回1，否则返回0。
　　其次在申明部分再添入下列自定义变量：
　　Const MAXCOUNT = 30 '热点区边界点的最多个数
　　Dim RgnPt(MAXCOUNT) As POINTAPI '热点数组
　　Dim RgnObject, RgnCount, flag As Long
　　然后在Form1窗体的上方创建一个PictureBox控件，设置名称为P1 ，ScaleMode属性为3，Picture属性指定一幅BMP图像。在P1的MouseMove事件和MouseDown事件中添入下列代码：
　　Private Sub P1_MouseDown(button As Integer, shift As Integer, x As Single, y As Single)
　　　If button = 1 Then '必须按下鼠标左键才有效
　　　　RgnPt(RgnCount).x = x
　　　　RgnPt(RgnCount).y = y
　　　　RgnCount = RgnCount + 1
　　　End If
　　End Sub
　　Private Sub P1_MouseMove(button As Integer, shift As Integer, x As Single, y As Single)
　　　If PtInRegion(RgnObject, x, y) = 1 Then
　　　　Label1.ForeColor = QBColor(12)
　　　　Label1.Caption = " 进入图形热点区！鼠标形状变为沙漏状！"
　　　　P1.MousePointer = 11 '设置鼠标形状为沙漏状
　　　ElseIf flag = 1 Then
　　　　Label1.ForeColor = 0
　　　　Label1.Caption = " 没有进入图形热点区！"
　　　　P1.MousePointer = 0
　　　End If
　　End Sub
　　接着在P1的下方并排创建两个CommandButton控件，Caption属性分别设为"创建热点"和"使用热点"， 名称分别设为CrtRgn（对应"创建热点"）和DspRgn。在这两个命令按钮的下方创建一个Label控件作为操作 提示区，取默认名Label1，Caption属性设为空，BackColor设为白色， BorderStyle属性设为1，字体为黑体加粗小四号。双击CrtRgn和DspRgn，在它们的Click事件中分别添入以下代码：
　　Private Sub CrtRgn_Click()
　　　Dim tmp As Long
　　　RgnCount = 0
　　　tmp = DeleteObject(RgnObject)
　　　Label1.Caption = " 在图像上单击鼠标左键来创建图形热点的范围！"+ _
　　　　"至少应在不同位置单击三次以上，否则形不成封闭区域！"
　　　flag = 0
　　End Sub
　　Private Sub DspRgn_Click()
　　　RgnObject = CreatePolygonRgn(RgnPt(0), RgnCount, 1)
　　　flag = 1
　　End Sub
　　最后在窗体代码的任意位置添入Form_Load（）事件：
　　Private Sub Form_Load()
　　　ScaleMode = 3
　　　P1.ScaleMode = 3
　　End Sub
　　按F5运行后，首先单击"创建热点"按钮，在图像区域内的不同位置 单击鼠标左键，最好单击三次以上，否则形不成热点区。然后单击"使用热点"按钮，在图像框内移动鼠标，你会发现当鼠标进入热点区后， 形状变为沙漏状。本文中的程序仅为演示程序，在实际应用中，可以事先创建好热点区数组，然后在热点区的MouseDown( )事件中添入相应的代码，即可使用图形热点代替命令按钮。
　　本程序在VB5/Win 95、Win 98下通过。

[jam021]

学习!帮你顶!

[lfshf]

用透明的label也可以吧，简单一点。

[ryuginka]

学习

[windlin1314]

学习

[lken]

谢谢 online(龙卷风V3.0--笑傲江湖) ，testing~~~

[laozhaoskinny]

收藏

[BlueBeer]

晕，矩形区域啊，放个image嘛

[江语]

是啊，放image多简单~

[zxhawk]

就是，放个透明的image就行了。

[lken]

透明不能放在图像上面吧，况且我还想拉一个范围的时候能够最后显示那个范围

[行云边]

我搞了一个你看行不行
先新建一个工程 上面放一个Timer1 和 Picture1 ,Picture1放上你的图片

Option Explicit

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private m_MyRect As RECT
Private m_bBegin As Boolean
Private m_X As Single, m_Y As Single

Private Sub Form_Load()
Timer1.Interval = 500 '鼠标按住0.5秒不动 说明开始画方形
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
m_X = X
m_Y = Y
Timer1.Enabled = True
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If m_bBegin Then
If X > m_MyRect.Left Then
m_MyRect.Right = X
Else
m_MyRect.Right = m_MyRect.Left
m_MyRect.Left = X
End If
If Y > m_MyRect.Top Then
m_MyRect.Bottom = Y
Else
m_MyRect.Bottom = m_MyRect.Top
m_MyRect.Top = Y
End If
Picture1.Cls
Picture1.Line (m_MyRect.Left, m_MyRect.Top)-(m_MyRect.Right, m_MyRect.Top)
Picture1.Line (m_MyRect.Left, m_MyRect.Bottom)-(m_MyRect.Right, m_MyRect.Bottom)
Picture1.Line (m_MyRect.Left, m_MyRect.Top)-(m_MyRect.Left, m_MyRect.Bottom)
Picture1.Line (m_MyRect.Right, m_MyRect.Top)-(m_MyRect.Right, m_MyRect.Bottom)
m_bBegin = False
Else
If X > m_MyRect.Left And X < m_MyRect.Right _
And Y > m_MyRect.Top And Y < m_MyRect.Bottom Then
Call PicClick
End If
Timer1.Enabled = False
End If
End Sub

Private Function PicClick()
MsgBox "点击到了"
End Function

Private Sub Timer1_Timer()
m_MyRect.Left = m_X
m_MyRect.Top = m_Y
m_bBegin = True
Timer1.Enabled = False
End Sub

[行云边]

对了 在Form_Load事件里加上 Timer1.Enabled = False

Private Sub Form_Load()
Timer1.Interval = 500 '鼠标按住0.5秒不动 说明开始画方形
Timer1.Enabled = False
End Sub

[lken]

baoaya(点头) 的想法很好，谢谢！