我现在能用在运行时用鼠标划出无数个区域,并且每划一个区域时能分别在text1,text2,text3,text4中显示X坐标,Y坐标、高和宽,还能在组合框的下拉列表中自动增加这个区域并显示其为这是第几个区域,但是我在这里遇到了一个问题,希望各位大虾能帮我忙,其中我能实现的代码如下:
'在窗体上放置 Shape 控件,一切属性取初始值
Option Explicit
Dim a As Boolean '判断鼠标是否按下状态
Dim x1 As Integer '矩形区域左上角 x 值
Dim y1 As Integer '矩形区域左上角 y 值
Dim x2 As Integer '矩形区域右下角 x 值
Dim y2 As Integer '矩形区域右下角 y 值
Private Sub Combo1_Change()
If Combo1.Text = Command1.Count Then
Load Command1(Command1.Count)
Command1(Command1.Count - 1).Left = x1
Command1(Command1.Count - 1).Top = y1
Command1(Command1.Count - 1).Height = y2
Command1(Command1.Count - 1).Width = x2
End If
End Sub
Private Sub FORM_Load()
Shape1.Height = 0
Shape1.Width = 0
Shape1.Left = 0
Shape1.Top = 0
Shape1.BorderColor = vbYellow '矩形边框颜色
End Sub
Private Sub FORM_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
a = True
x1 = X '保存矩形左上角坐标
y1 = Y
Shape1.Left = X '设置矩形位置
Shape1.Top = Y
Text1.Text = x1
Text2.Text = x2
Text3.Text = Shape1.Height
Text4.Text = Shape1.Width
Combo1.AddItem Command1.Count
End Sub
Private Sub FORM_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo e
If a Then
Shape1.Height = Y - Shape1.Top '画出矩形
Shape1.Width = X - Shape1.Left
End If
e:
End Sub
Private Sub FORM_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
a = False
x2 = X - x1 '保存矩形右下角位置
y2 = Y - y1
'在此加入设置播放器的大小与位置的代码,这里用commandbutton控件作演示
'command1的visible=false,index=0
'程序修改如下
If y2 < 0 Then y2 = 0
If x2 < 0 Then x2 = 0
Load Command1(Command1.Count)
Command1(Command1.Count - 1).Left = x1
Command1(Command1.Count - 1).Top = y1
Command1(Command1.Count - 1).Height = y2
Command1(Command1.Count - 1).Width = x2
Command1(Command1.Count - 1).Visible = True
End Sub
'在窗体上放置 Shape 控件,一切属性取初始值
Option Explicit
Dim a As Boolean '判断鼠标是否按下状态
Dim x1 As Integer '矩形区域左上角 x 值
Dim y1 As Integer '矩形区域左上角 y 值
Dim x2 As Integer '矩形区域右下角 x 值
Dim y2 As Integer '矩形区域右下角 y 值
Private Sub Combo1_Change()
If Combo1.Text = Command1.Count Then
Load Command1(Command1.Count)
Command1(Command1.Count - 1).Left = x1
Command1(Command1.Count - 1).Top = y1
Command1(Command1.Count - 1).Height = y2
Command1(Command1.Count - 1).Width = x2
End If
End Sub
Private Sub FORM_Load()
Shape1.Height = 0
Shape1.Width = 0
Shape1.Left = 0
Shape1.Top = 0
Shape1.BorderColor = vbYellow '矩形边框颜色
End Sub
Private Sub FORM_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
a = True
x1 = X '保存矩形左上角坐标
y1 = Y
Shape1.Left = X '设置矩形位置
Shape1.Top = Y
Text1.Text = x1
Text2.Text = x2
Text3.Text = Shape1.Height
Text4.Text = Shape1.Width
Combo1.AddItem Command1.Count
End Sub
Private Sub FORM_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo e
If a Then
Shape1.Height = Y - Shape1.Top '画出矩形
Shape1.Width = X - Shape1.Left
End If
e:
End Sub
Private Sub FORM_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
a = False
x2 = X - x1 '保存矩形右下角位置
y2 = Y - y1
'在此加入设置播放器的大小与位置的代码,这里用commandbutton控件作演示
'command1的visible=false,index=0
'程序修改如下
If y2 < 0 Then y2 = 0
If x2 < 0 Then x2 = 0
Load Command1(Command1.Count)
Command1(Command1.Count - 1).Left = x1
Command1(Command1.Count - 1).Top = y1
Command1(Command1.Count - 1).Height = y2
Command1(Command1.Count - 1).Width = x2
Command1(Command1.Count - 1).Visible = True
End Sub
文章標籤
全站熱搜
