如何画一个方框并取得方框内所有的控件？

[fishmans]

就像浏览器中拖动选取多个文件夹一样的效果！

[maxiuhui]

判断方框四角和控件坐标

[fishmans]

难道要遍历所有的在这个范围的控件？？会不会太慢了点？还有就是我问的重点是如何实现画框的效果！！！

[junwhj]

Option Explicit

Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long

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

Private Type POINTAPI
X As Long
Y As Long
End Type

Private pt As POINTAPI
Private rc As RECT
Private blnMouseDown As Boolean

Private Sub Form_Load()
Me.ScaleMode = 3
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
pt.X = X
pt.Y = Y
blnMouseDown = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If blnMouseDown Then
DrawFocusRect Me.hdc, rc
rc.Left = IIf(pt.X < X, pt.X, X)
rc.Top = IIf(pt.Y < Y, pt.Y, Y)
rc.Right = IIf(pt.X > X, pt.X, X)
rc.Bottom = IIf(pt.Y > Y, pt.Y, Y)
DrawFocusRect Me.hdc, rc
Me.Refresh
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
blnMouseDown = False
End Sub

[junwhj]

Option Explicit

Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long

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

Private Type POINTAPI
X As Long
Y As Long
End Type

Private pt As POINTAPI
Private rc As RECT
Private blnMouseDown As Boolean

Private Sub Form_Load()
Me.ScaleMode = 3
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
pt.X = X
pt.Y = Y
blnMouseDown = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If blnMouseDown Then
DrawFocusRect Me.hdc, rc
rc.Left = IIf(pt.X < X, pt.X, X)
rc.Top = IIf(pt.Y < Y, pt.Y, Y)
rc.Right = IIf(pt.X > X, pt.X, X)
rc.Bottom = IIf(pt.Y > Y, pt.Y, Y)
DrawFocusRect Me.hdc, rc
Me.Refresh
End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ctrl As Control

On Error Resume Next '有些控件不支持Left,Top属性（如Line）

For Each ctrl In Me.Controls
If ctrl.Left + ctrl.Width < rc.Left Or _
ctrl.Left > rc.Right Or _
ctrl.Top + ctrl.Height < rc.Top Or _
ctrl.Top > rc.Bottom Then
Else
Debug.Print ctrl.Name
End If
Next

blnMouseDown = False
End Sub

[fishmans]

谢谢，这个问题我已经解决了~~~

[fishmans]

为什么不能给分啊？？