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

Question

Option ExplicitPrivate Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As LongPrivate Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End TypePrivate Type POINTAPI
        X As Long
        Y As Long
End TypePrivate pt As POINTAPI
Private rc As RECT
Private blnMouseDown As BooleanPrivate Sub Form_Load()
    Me.ScaleMode = 3
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    pt.X = X
    pt.Y = Y
    blnMouseDown = True
End SubPrivate 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 SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    blnMouseDown = False
End Sub

Answer 1

Option ExplicitPrivate Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As LongPrivate Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End TypePrivate Type POINTAPI
        X As Long
        Y As Long
End TypePrivate pt As POINTAPI
Private rc As RECT
Private blnMouseDown As BooleanPrivate Sub Form_Load()
   Me.ScaleMode = 3
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    pt.X = X
    pt.Y = Y
    blnMouseDown = True
End SubPrivate 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 SubPrivate 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