图象处理:如何实现选择其中一部分然后出现一虚线框,并可以拖动,放大等~~

Question

就类似"画图"里的矩形区域选择功能,我用line和shape实现了选择,可是它们不支持click和drag事件,怎么办??

Answer 1

可否这样处理：用一个PictureBox,取名为PicClip,当矩形区域选择好以后，就把PicClip移到这个位置（大小为矩形区域），图像用PaintPicture或BitBlt进行截取。原区域的图像抹掉。这样click和drag事件实际上就是PicClip的事件了。当使用drag事件时，图像放下可采用同样的方法：把原图象的一块用PaintPicture或BitBlt进行取代，然后移走PicClip.

Answer 2

你还可以使用 Windows API的 DrawFocusRect来画虚线框 。

Answer 3

抱歉，DrawFocusRect是用来画聚焦框，你还是用你原来的或者Windows API的Rectangle。

Answer 4

能否给个代码?
[email protected]

Answer 5

用shape。
在picturebox的mousemove事件中动态修改shape的位置和大小。

Answer 6

lsftest() 用shape。
在picturebox的mousemove事件中动态修改shape的位置和大小。
------------------------------------------------------------
可是这样只能进行最初选择,如果想改变方案还要重新来.就是说不能在原有的基础上进行修改.

Answer 7

一切都很简单:
用image控件
然后用个矩形矢量图
使用image控件的drag事件矢量图已发送到你email代码:
Dim bShow As Boolean
Dim bMove As Boolean
Dim oldX As Single, oldY As Single
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Sub Form_Click()
    If bShow Then
        bShow = False
        HideNodes
    End If
End SubPrivate Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
    SetNodes Image1
End SubPrivate Sub Form_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
    SizeObject Source.Index, X, Y
End SubPrivate Sub Form_Load()
    If Node.Count = 1 Then
        For i = 1 To 7
            Load Node(i)
        Next
    End If
   ' Image1.Stretch = True '如果想在拖动时不闪动，可以设置该值为False，但长宽比不能保持相同
    bShow = False
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.MousePointer = vbDefault
End SubPrivate Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bMove = True
    oldX = X: oldY = Y
End SubPrivate Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i As Integer
    If bMove Then
        Image1.Left = X - oldX + Image1.Left
        Image1.Top = Y - oldY + Image1.Top
        For i = 0 To 7
            Node(i).Visible = False
        Next
    End If
End SubPrivate Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim i As Integer
    
    bMove = False
    For i = 0 To 7
        Node(i).Visible = True
    Next
End SubPrivate Sub Node_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    HideNodes
    Node(Index).Drag
End SubPrivate Sub Image1_Click()
    Dim i As Integer
    If Node.Count = 1 Then
        For i = 1 To 7
            Load Node(i)
        Next
    End If
    bShow = True
    SetNodes Image1
End SubPrivate Sub Image1_DragDrop(Source As Control, X As Single, Y As Single)
    SetNodes Image1
End SubPrivate Sub Image1_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
    With Image1
        Select Case Source.Index
            Case 0
                .Top = .Top + Y
                .Left = .Left + X
                .Width = .Width - X
                .Height = .Height - Y
            Case 1
                .Left = .Left + X
                .Width = .Width - X
            Case 2
                .Width = .Width - X
                .Height = Y
                .Left = .Left + X
            Case 3
                .Height = .Height - Y
                .Top = .Top + Y
            Case 4
                .Height = Y
            Case 5
                .Width = X
                .Height = .Height - Y
                .Top = .Top + Y
            Case 6
                .Width = X
            Case 7
                .Width = X
                .Height = Y
        End Select
    End With
End SubPrivate Sub Node_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Select Case Index
        Case 0, 7
            Node(Index).MousePointer = 8
        Case 1, 6
            Node(Index).MousePointer = 9
        Case 2, 5
            Node(Index).MousePointer = 6
        Case 3, 4
            Node(Index).MousePointer = 7
    End Select
End SubPrivate Sub SetNodes(SelectedControl As Control)
    Dim i As Integer
    With SelectedControl
        For i = 0 To 7
            Select Case i
                'Left Top
                Case 0
                    Node(i).Left = .Left - Node(i).Width
                    Node(i).Top = .Top - Node(i).Height
                'Left center
                Case 1
                    Node(i).Left = .Left - Node(i).Width
                    Node(i).Top = .Top + ((.Height - Node(i).Height) / 2)
                'Left bottom
                Case 2
                    Node(i).Left = .Left - Node(i).Width
                    Node(i).Top = .Top + .Height
                'Center Top
                Case 3
                    Node(i).Left = .Left + ((.Width + Node(i).Width) / 2)
                    Node(i).Top = .Top - Node(i).Height
                'Center Bottom
                Case 4
                    Node(i).Left = .Left + ((.Width + Node(i).Width) / 2)
                    Node(i).Top = .Top + .Height
                 'Right Top
                Case 5
                    Node(i).Left = .Left + .Width
                    Node(i).Top = .Top - Node(i).Height
                'Right Center
                Case 6
                    Node(i).Left = .Left + .Width
                    Node(i).Top = .Top + ((.Height - Node(i).Height) / 2)
                'Right Bottom
                Case 7
                    Node(i).Left = .Left + .Width
                    Node(i).Top = .Top + .Height
            End Select
            Node(i).Visible = True
        Next
    End With
End SubPrivate Sub SizeObject(NodeIndex As Integer, X As Single, Y As Single)
    On Error Resume Next    With Image1
        Select Case NodeIndex
            Case 0
                .Width = .Width + (.Left - X)
                .Height = .Height + (.Top - Y)
                .Left = X
                .Top = Y
            Case 1
                .Width = .Width + (.Left - X)
                .Left = X
            Case 2
                .Width = (.Left - X) + .Width
                .Height = Y - .Top
                .Left = X
            Case 3
                .Height = .Height + .Top - Y
                .Top = Y
            Case 4
                .Height = Y - .Top
            Case 5
                .Width = X - .Left
                .Height = .Height + .Top - Y
                .Top = Y
            Case 6
                .Width = X - .Left
            Case 7
                .Width = X - .Left
                .Height = Y - .Top
        End Select
    End With
    KeyEdit = "Move"
End SubPrivate Sub HideNodes()
    For i = 0 To 7
        Node(i).Visible = False
    Next
End Sub
'''''''''''''''''''''
searched by baidu.com

Answer 8

lsftest() 用shape。
在picturebox的mousemove事件中动态修改shape的位置和大小。
------------------------------------------------------------
可是这样只能进行最初选择,如果想改变方案还要重新来.就是说不能在原有的基础上进行修改.=================================================================
"在原有的基础上进行修改"是什么意思？？？？？？
一个很简单的例子：
Dim x1 As Long
Dim y1 As Long
Dim DOING As Boolean
Private Sub Form_Load()
Shape1.Visible = False
Shape1.Shape = 0
Shape1.BorderStyle = 3
End SubPrivate Sub Picture1_DblClick()
Shape1.Visible = False
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
x1 = X
y1 = Y
DOING = True
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If DOING = True Then
Shape1.Visible = True
Shape1.Top = y1
Shape1.Left = x1
Shape1.Height = Abs(Y - y1)
Shape1.Width = Abs(X - x1)
End If
End SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
DOING = False
End Sub
运行，在picture1中按下鼠标，shape1出现，按住鼠标拖动，shape的大小随着改变，松开鼠标，shape定格。如果想重来，只需要重复上面的阿操作步骤，双击picture1，shape消失
上面只是一个示例代码，没有考虑鼠标从右向左、从下到上拖动的时候shape的拉伸方向也应该相应改变，不过要实现也不会难，简单的坐标判断。
如果要求shape的大小固定但能拖到任意地方，原理也差不多，参考上面mousemove事件里如何改变shape。

Answer 9

"在原有的基础上进行修改"
意思是:如果按照您的办法选定了一个区域,然后发现不合适的话,只能重新选择一次,而不能对画好的shape进行放大或缩小,因为shape没有drag和鼠标的其他属性,但我听说可以用api实现shape的拖动,不知道是怎么实现的...

Answer 10

MrKnowNothing:Node是自定对象吗？矩形矢量图能发一分给我吗？谢谢先！
[email protected]

Answer 11

"在原有的基础上进行修改"
意思是:如果按照您的办法选定了一个区域,然后发现不合适的话,只能重新选择一次,而不能对画好的shape进行放大或缩小,因为shape没有drag和鼠标的其他属性,但我听说可以用api实现shape的拖动,不知道是怎么实现的...
===========================
哦，原来你要的是这个，简单：Dim x1 As Long
Dim y1 As Long
Dim x2 As Long
Dim y2 As Long
Dim w As Long
Dim h As Long
Dim DOING As Boolean
Private Sub Form_Load()
Shape1.Visible = False
Shape1.Shape = 0
Shape1.BorderStyle = 3
End SubPrivate Sub Picture1_DblClick()
Shape1.Visible = False
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
x1 = X
y1 = Y
DOING = True
ElseIf Button = 2 Then
x2 = X
y2 = Y
w = Shape1.Width
h = Shape1.Height
End If
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If DOING = True Then
Shape1.Visible = True
Shape1.Top = y1
Shape1.Left = x1
Shape1.Height = Abs(Y - y1)
Shape1.Width = Abs(X - x1)
End If
ElseIf Button = 2 Then
Shape1.Width = w + X - x2
Shape1.Height = h + Y - y2
End IfEnd SubPrivate Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
DOING = False
End Sub
操作同上面我的回复，增加的功能：当shape确定下来后，在picture里按下右键，拖动鼠标，可以改变shape的大小。
要改变shape的位置原理也差不多。

Answer 12

谢谢lsftest() 不厌其烦的给我解答
改变大小的问题解决了，可是平移这个虚线框的还是没办法啊？还是只有重新画吧？

Answer 13

谢谢lsftest() 不厌其烦的给我解答
改变大小的问题解决了，可是平移这个虚线框的还是没办法啊？还是只有重新画吧？
==============================
那还不更简单。
不过我的鼠标只有两键，如果你的鼠标是三键鼠标，就可以用按下中间键、拖动鼠标的方式来动态改变shape的top、left
如果没有三键鼠标，用两键齐按（button＝3）来触发改变shape位置的代码也行，或者在旁边加一个按钮来进入平易状态，，，方法很多。。总之，你找到合适的触发事件就可以了，能清楚地分清操作状态就行了。
上面的代码只是示例代码，要实际应用还要进行一些修改完善的

Answer 14

添加用两键齐按实现平移的功能，并且完善了其他两种功能：
Dim x1 As Long
Dim y1 As Long
Dim x2 As Long
Dim y2 As Long
Dim x3 As Long
Dim y3 As Long
Dim w As Long
Dim h As Long
Dim t As Long
Dim l As Long
Dim DOING As Boolean
Dim going As Boolean
Private Sub Form_Load()
Shape1.Visible = False
Shape1.Shape = 0
Shape1.BorderStyle = 3
End Sub
Private Sub Picture1_DblClick()
Shape1.Visible = False
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
x1 = X
y1 = Y
DOING = True
ElseIf Button = 2 Then
x2 = X
y2 = Y
w = Shape1.Width
h = Shape1.Height
ElseIf Button = 3 Then
x3 = X
y3 = Y
t = Shape1.Top
l = Shape1.Left
going = True
End If
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If DOING = True Then
If X >= x1 And Y >= y1 Then
Shape1.Visible = True
Shape1.Top = y1
Shape1.Left = x1
ElseIf X > x1 And Y < y1 Then
Shape1.Top = Y
ElseIf X < x1 And Y < y1 Then
Shape1.Top = Y
Shape1.Left = X
ElseIf X < x1 And Y > y1 Then
Shape1.Left = X
End If
Shape1.Height = Abs(Y - y1)
Shape1.Width = Abs(X - x1)
End If
ElseIf Button = 2 Then
Shape1.Width = IIf(w + X - x2 >= 0, w + X - x2, 0)
Shape1.Height = IIf(h + Y - y2 >= 0, h + Y - y2, 0)
ElseIf Button = 3 Then
If going = False Then Call Picture1_MouseDown(3, 0, X, Y)
Shape1.Top = t + Y - y3
Shape1.Left = l + X - x3
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
DOING = False
going = False
End Sub

Answer 15

用lsftest代码试了一下，我的屏幕上怎么画虚框的起始点离鼠标有好远啦，
这是怎么回事呀？lsftest解释一下或者怎么做？

Answer 16

用lsftest代码试了一下，我的屏幕上怎么画虚框的起始点离鼠标有好远啦，
这是怎么回事呀？lsftest解释一下或者怎么做？
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
在我这里没有你说的问题，我是新建一个工程，添加picture框，在picture框里添加一个shape，然后把上面的代码直接复制过去就可以用了
估计你的问题是由于坐标不同造成的检查一下你的picture的scalmode是否为twip？？？

Answer 17

谢谢sftest大哥，改为twip可以了。

Answer 18

精彩！
可是如何实现象mrknowthing那样在区域周围出现8个小黑点呢？

Answer 19

可是如何实现象mrknowthing那样在区域周围出现8个小黑点呢？
==============================
这个稍微复杂一点，不过也只是烦而并不难。
在picture1中再加一个shape2，把它的index属性设为0。然后：
Dim x1 As Long
Dim y1 As Long
Dim x2 As Long
Dim y2 As Long
Dim x3 As Long
Dim y3 As Long
Dim w As Long
Dim h As Long
Dim t As Long
Dim l As Long
Dim DOING As Boolean
Dim going As Boolean
Private Sub Form_Load()With Shape2(0)
.FillStyle = 0
.Shape = 0
.Height = 80
.Width = 80
.Visible = False
End With
For i = 1 To 7
Load Shape2(i)
NextWith Shape1
.Visible = False
.Shape = 0
.BorderStyle = 3
End WithEnd Sub
Private Sub Picture1_DblClick()
Shape1.Visible = False
For i = 0 To 7
            Shape2(i).Visible = False
Next
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
x1 = X
y1 = Y
DOING = True
ElseIf Button = 2 Then
x2 = X
y2 = Y
w = Shape1.Width
h = Shape1.Height
ElseIf Button = 3 Then
x3 = X
y3 = Y
t = Shape1.Top
l = Shape1.Left
going = True
End If
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If DOING = True Then
If X >= x1 And Y >= y1 Then
Shape1.Visible = True
Shape1.Top = y1
Shape1.Left = x1
ElseIf X > x1 And Y < y1 Then
Shape1.Top = Y
ElseIf X < x1 And Y < y1 Then
Shape1.Top = Y
Shape1.Left = X
ElseIf X < x1 And Y > y1 Then
Shape1.Left = X
End If
Shape1.Height = Abs(Y - y1)
Shape1.Width = Abs(X - x1)
End If
ElseIf Button = 2 Then
Shape1.Width = IIf(w + X - x2 >= 0, w + X - x2, 0)
Shape1.Height = IIf(h + Y - y2 >= 0, h + Y - y2, 0)
ElseIf Button = 3 Then
If going = False Then Call Picture1_MouseDown(3, 0, X, Y)
Shape1.Top = t + Y - y3
Shape1.Left = l + X - x3
End If
If Button <> 0 Then
    showpoint
    If Shape2(0).Visible = False Then
        For i = 0 To 7
            Shape2(i).Visible = True
        Next
    End If
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
DOING = False
going = False
End SubPrivate Sub showpoint()
Shape2(0).Top = IIf(Shape1.Top - Shape2(0).Height / 2 >= 0, Shape1.Top - Shape2(0).Height / 2, 0)
Shape2(0).Left = IIf(Shape1.Left - Shape2(0).Width / 2 >= 0, Shape1.Left - Shape2(0).Width / 2, 0)Shape2(1).Top = IIf(Shape1.Top - Shape2(1).Height / 2 >= 0, Shape1.Top - Shape2(1).Height / 2, 0)
Shape2(1).Left = IIf(Shape1.Left + Shape1.Width / 2 - Shape2(1).Width / 2 >= 0, Shape1.Left + Shape1.Width / 2 - Shape2(1).Width / 2, 0)Shape2(2).Top = IIf(Shape1.Top - Shape2(2).Height / 2 >= 0, Shape1.Top - Shape2(2).Height / 2, 0)
Shape2(2).Left = IIf(Shape1.Left + Shape1.Width - Shape2(2).Width / 2 >= 0, Shape1.Left + Shape1.Width - Shape2(2).Width / 2, 0)Shape2(3).Top = IIf(Shape1.Top + Shape1.Height / 2 - Shape2(3).Height / 2 >= 0, Shape1.Top + Shape1.Height / 2 - Shape2(3).Height / 2, 0)
Shape2(3).Left = IIf(Shape1.Left - Shape2(3).Width / 2 >= 0, Shape1.Left - Shape2(3).Width / 2, 0)Shape2(4).Top = IIf(Shape1.Top + Shape1.Height / 2 - Shape2(4).Height / 2 >= 0, Shape1.Top + Shape1.Height / 2 - Shape2(4).Height / 2, 0)
Shape2(4).Left = IIf(Shape1.Left + Shape1.Width - Shape2(4).Width / 2 >= 0, Shape1.Left + Shape1.Width - Shape2(4).Width / 2, 0)Shape2(5).Top = IIf(Shape1.Top + Shape1.Height - Shape2(5).Height / 2 >= 0, Shape1.Top + Shape1.Height - Shape2(5).Height / 2, 0)
Shape2(5).Left = IIf(Shape1.Left - Shape2(5).Width / 2 >= 0, Shape1.Left - Shape2(5).Width / 2, 0)Shape2(6).Top = IIf(Shape1.Top + Shape1.Height - Shape2(6).Height / 2 >= 0, Shape1.Top + Shape1.Height - Shape2(6).Height / 2, 0)
Shape2(6).Left = IIf(Shape1.Left + Shape1.Width / 2 - Shape2(6).Width / 2 >= 0, Shape1.Left + Shape1.Width / 2 - Shape2(6).Width / 2, 0)
Shape2(7).Top = IIf(Shape1.Top + Shape1.Height - Shape2(7).Height / 2 >= 0, Shape1.Top + Shape1.Height - Shape2(7).Height / 2, 0)
Shape2(7).Left = IIf(Shape1.Left + Shape1.Width - Shape2(7).Width / 2 >= 0, Shape1.Left + Shape1.Width - Shape2(7).Width / 2, 0)End Sub

Answer 20

'完善、简化代码：
Dim x1 As Long
Dim y1 As Long
Dim x2 As Long
Dim y2 As Long
Dim x3 As Long
Dim y3 As Long
Dim w As Long
Dim h As Long
Dim t As Long
Dim l As Long
Dim DOING As Boolean
Dim going As Boolean
Private Sub Form_Load()With Shape2(0)
.FillStyle = 0
.Shape = 0
.Height = 80
.Width = 80
.Visible = False
End With
For i = 1 To 8
If i <> 4 Then
Load Shape2(i)
End If
NextWith Shape1
.Visible = False
.Shape = 0
.BorderStyle = 3
End WithEnd Sub
Private Sub Picture1_DblClick()
Shape1.Visible = False
For i = 0 To 8
If i <> 4 Then
            Shape2(i).Visible = False
End If
Next
End SubPrivate Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
x1 = X
y1 = Y
DOING = True
ElseIf Button = 2 Then
x2 = X
y2 = Y
w = Shape1.Width
h = Shape1.Height
ElseIf Button = 3 Then
x3 = X
y3 = Y
t = Shape1.Top
l = Shape1.Left
going = True
End If
End SubPrivate Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
If DOING = True Then
If X >= x1 And Y >= y1 Then
Shape1.Visible = True
Shape1.Top = y1
Shape1.Left = x1
ElseIf X > x1 And Y < y1 Then
Shape1.Top = Y
ElseIf X < x1 And Y < y1 Then
Shape1.Top = Y
Shape1.Left = X
ElseIf X < x1 And Y > y1 Then
Shape1.Left = X
End If
Shape1.Height = Abs(Y - y1)
Shape1.Width = Abs(X - x1)
End If
ElseIf Button = 2 Then
Shape1.Width = IIf(w + X - x2 >= 0, w + X - x2, 0)
Shape1.Height = IIf(h + Y - y2 >= 0, h + Y - y2, 0)
ElseIf Button = 3 Then
If going = False Then Call Picture1_MouseDown(3, 0, X, Y)
Shape1.Top = t + Y - y3
Shape1.Left = l + X - x3
End If
If Button <> 0 Then
    showpoint
    If Shape2(0).Visible = False Then
        For i = 0 To 8
            If i <> 4 Then
            Shape2(i).Visible = True
            End If
        Next
    End If
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
DOING = False
going = False
End SubPrivate Sub showpoint()
For i = 0 To 8
    If i <> 4 Then
        If i \ 3 = 0 Then Shape2(i).Top = Shape1.Top - Shape2(i).Height / 2
        If i \ 3 = 1 Then Shape2(i).Top = Shape1.Top + Shape1.Height / 2 - Shape2(i).Height / 2
        If i \ 3 = 2 Then Shape2(i).Top = Shape1.Top + Shape1.Height - Shape2(i).Height / 2
        If i Mod 3 = 0 Then Shape2(i).Left = Shape1.Left - Shape2(i).Height / 2
        If i Mod 3 = 1 Then Shape2(i).Left = Shape1.Left + Shape1.Width / 2 - Shape2(i).Height / 2
        If i Mod 3 = 2 Then Shape2(i).Left = Shape1.Left + Shape1.Width - Shape2(i).Height / 2
     End If
Next
End Sub

Answer 21

最后采用lsftest() 大哥和mrknowthing大哥综合的办法解决问题
结帐