在应用程序中给自己开发的控件添加选中句柄,我们已实现了,就是用鼠标点击时, 所点的的控件成为活动控件的响应速度慢,点击后,几秒后才成为活动控件(ACTIVECONTROL) ,我在调试时, 用鼠标点 A 控件时,用断点或是日志文件记录,发现活动控件是B,(记录活动的控件的名称), 不是我所点的A控件, 请问高手,有没有什么办法能使我用鼠标点的控件,立即成为活动控件,成为我程序里的活动控件后,(程序中有取当前的活动控件),然后执行后面的程序代码,好似VB的编辑界面时,窗体中的控件效果,有8句柄能移动,这要在我程序运行时实现,我的程序是,8个句柄(8个小LABEL做的)是共用的,所有的控件都共享这8个,就是在用鼠标选中的控件,我们程序处理是把这8个LABEL放在当前的活动的控件周围,我们遇到的是,我们用鼠标点的,不是当前的活动的控件,所以用鼠标点控件时,我程序是,判断鼠标的位置是否在当前活动控件的矩形内,若是则,8个LABEL到所点的控件周围,8个LABEL到所点的控件周围时间有好几秒,现在是要,用鼠标一点控件,马上8个LABEL就过去,我移动控件程序是用Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Source.left = X - diffx
Source.top = Y - diffy
EightPoints Me  是把8个LABEL放在活动控件的周围
End Sub  我程序是,判断鼠标的位置是否在当前活动控件的矩形内,程序在 
Private Sub Form_MouseDown 里,若是则selectcontrol.Drag 1,开始拖动,谢谢高手!!

解决方案 »

  1.   

    程序代码
    Public Sub EightPoints(fP As Form)
    Dim i, j As Integer 'iPicNum  , iPicNum
    Dim selecontrol As Control
    'Dim fp As Form    For i = 1 To iPicsCount
            If frmPic(i) Is fP Then iPicNum = i
        Next
           Set selecontrol = frmPic(iPicNum).ActiveControl
            fP.lblHeadLeft.left = selecontrol.left - 80
            fP.lblHeadLeft.top = selecontrol.top - 80
            fP.lblHeadMiddle.left = selecontrol.left + selecontrol.Width / 2 - 40
            fP.lblHeadMiddle.top = selecontrol.top - 80
            fP.lblHeadRight.left = selecontrol.left + selecontrol.Width
            fP.lblHeadRight.top = fP.lblHeadMiddle.top
            fP.lblMiddleLeft.left = fP.lblHeadLeft.left
            fP.lblMiddleLeft.top = selecontrol.top + selecontrol.Height / 2 - 40
            fP.lblMiddleRight.left = fP.lblHeadRight.left
            fP.lblMiddleRight.top = fP.lblMiddleLeft.top
            fP.lblTailLeft.left = fP.lblHeadLeft.left
            fP.lblTailLeft.top = selecontrol.top + selecontrol.Height
            fP.lblTailMiddle.left = fP.lblHeadMiddle.left
            fP.lblTailMiddle.top = fP.lblTailLeft.top
            fP.lblTailRight.left = fP.lblHeadRight.left
            fP.lblTailRight.top = fP.lblTailLeft.top
            
            fP.lblHeadLeft.Visible = True
            fP.lblHeadMiddle.Visible = True
            fP.lblHeadRight.Visible = True
            fP.lblMiddleLeft.Visible = True
            fP.lblMiddleRight.Visible = True
            fP.lblTailLeft.Visible = True
            fP.lblTailMiddle.Visible = True
            fP.lblTailRight.Visible = True
            
    End Sub
    Public Sub GetEightPs(fP As Form)
    'On Error Resume Next
    Dim i, j As Integer 'iPicNum  , iPicNum
    Dim gselcontrol, Control As Control
    Dim lpRect As RECT
    Dim ret As Long
    'Dim fp As Form    For i = 1 To iPicsCount
            If frmPic(i) Is fP Then iPicNum = i
        Next
    ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::taowencai add
        j = 0
        ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::NOTE
         For Each Control In frmPic(iPicNum).Controls 'frmPics.lblLineHead
         On Error GoTo JJ
           If Control.Visible = True And (Control.Name = "Lines" Or Control.Name = "lblLineHead" Or Control.Name = "lblLineTail") Then GoTo JJ
            If Control.Visible = True Then Exit For  'Control.Visible = True
    JJ:         j = j + 1
    'NN:
            'Exit Sub
         Next
         If j = frmPic(iPicNum).Count Then Exit Sub
         
          ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::NOTE
    ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::taowencai add
         
           Set gselcontrol = frmPic(iPicNum).ActiveControl  '  以前是 i-1
    '       If gselcontrol = Nothing Then Exit Sub
           GetWindowRect gselcontrol.hwnd, lpRect
           GetCursorPos controlbottom
           ScreenToClient frmPic(iPicNum).hwnd, controlbottom       ret = PtInRect(lpRect, controlbottom.X, controlbottom.Y)
           frmPic(iPicNum).Label1 = lpRect.left
           frmPic(iPicNum).Label2 = lpRect.top
           frmPic(iPicNum).Label3 = controlbottom.X
           frmPic(iPicNum).Label4 = controlbottom.Y
           
        If ret Then
           EightPoints fP
           End If
    End Sub
      

  2.   

    Private Sub Form_Click()
    'Dim selcontrol As Form
    ''Dim fp As Form
    '
    ''    For i = 1 To iPicsCount
    ''        If frmPic(i) Is fp Then iPicNum = i
    ''    Next
    '       Set selcontrol = Me 'frmPic(i - 1).ActiveControl
    '        lblHeadLeft.left = selcontrol.left - 80
    '        lblHeadLeft.top = selcontrol.top - 80
    '        lblHeadMiddle.left = selcontrol.left + selcontrol.Width / 2 - 40
    '        lblHeadMiddle.top = selcontrol.top - 80
    '        lblHeadRight.left = selcontrol.left + selcontrol.Width
    '        lblHeadRight.top = lblHeadMiddle.top
    '        lblMiddleLeft.left = lblHeadLeft.left
    '        lblMiddleLeft.top = selcontrol.top + selcontrol.Height / 2 - 40
    '        lblMiddleRight.left = lblHeadRight.left
    '        lblMiddleRight.top = lblMiddleLeft.top
    '
    '
    '        lblTailLeft.left = lblHeadLeft.left
    '        lblTailLeft.top = selcontrol.top + selcontrol.Height
    '        lblTailMiddle.left = lblHeadMiddle.left
    '        lblTailMiddle.top = lblTailLeft.top
    '        lblTailRight.left = lblHeadRight.left
    '        lblTailRight.top = lblTailLeft.top
            
            lblHeadLeft.Visible = False
            lblHeadMiddle.Visible = False
            lblHeadRight.Visible = False
            lblMiddleLeft.Visible = False
            lblMiddleRight.Visible = False
            lblTailLeft.Visible = False
            lblTailMiddle.Visible = False
            lblTailRight.Visible = False
            
            Call GetEightPs(Me)
    End Sub
    Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        'set the FormProperty when  mousedown event of frmpics engaged
        Dim frmbottom As PointBottom, controlbottom As PointBottom
        Me.SetFocus
        
    '    FormProperty = True
        If Button = 2 And WorkMode = "Configration" Then frmPopmnuSet    ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::region
        If Button = 1 Then
        boolregion = True
        GetCursorPos frmbottom
        GetCursorPos controlbottom
        x1region = frmbottom.X * Screen.TwipsPerPixelX
        y1region = frmbottom.Y * Screen.TwipsPerPixelY
        x1mousedown = X
        y1mousedown = Y
        End If
        ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::region
        ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::move
        x1move = X
        y1move = Y
    '    boolcontrolmove = True
        ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::move   ' EightPoints Me
       ';;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;controlmove
       ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::taowencai note 5 24
       Dim MyControl As Control
       Set MyControl = Me.ActiveControl
    '   If MyControl = Nothing Then Exit Sub
    '   If TypeOf MyControl Is Form Then
    '
    '   Else
    '
    '    boolcontrolmove = True
    '    End If   ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::taowencai note 5 24
         x1mousedown = frmbottom.X * Screen.TwipsPerPixelX
         y1mousedown = frmbottom.Y * Screen.TwipsPerPixelY
         ';;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;      Dim i, j As Integer 'iPicNum  , iPicNum       ' Dim selcontrol As Control
            Dim lpRect As RECT
            Dim ret, ret1 As Long
            Dim ppt1 As PointBottom
    '        GetCursorPos pt1
    '        ret1 = ChildWindowFromPoint(Me, pt1)        'Dim fp As Form'        For i = 1 To iPicsCount
    '            If frmPic(i) Is fp Then iPicNum = i
    '        Next
            On Error GoTo LL
            Set selectcontrol = Me.ActiveControl        GetWindowRect selectcontrol.hwnd, lpRectLL:        GetCursorPos ppt1  'ControlBottom
            ret = PtInRect(lpRect, ppt1.X, ppt1.Y)
            If ret Then     selectcontrol.Drag 1
         selectcontrolleft = selectcontrol.left
         selectcontroltop = selectcontrol.top
         controlx = controlbottom.X * Screen.TwipsPerPixelX
         controly = controlbottom.Y * Screen.TwipsPerPixelY
             GetCursorPos txtFeederBottomP   '得到鼠标
            ScreenToClient frmPics.hwnd, txtFeederBottomP
    '        diffx = txtFeederBottomP.X * Screen.TwipsPerPixelX - selectcontrol.left
    '        diffy = txtFeederBottomP.Y * Screen.TwipsPerPixelY - selectcontrol.top
            diffx = X - selectcontrol.left
            diffy = Y - selectcontrol.top
         End If   ';;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;controlmove
       Set SelectedObject = Me.ActiveControl
    'Label1 = selectcontrol.left
    'Label2 = selectcontrol.top
    'Label3 = txtFeederBottomP.X * Screen.TwipsPerPixelX
    'Label4 = txtFeederBottomP.Y * Screen.TwipsPerPixelY
    'Label5 = X
    'Label6 = Y
    End Sub
    Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
    'Dim controlp As PointBottom
    'Dim x1, y1 As Single
    'GetCursorPos controlp
    'ScreenToClient Me.hwnd, controlp
    'x1 = controlp.X * Screen.TwipsPerPixelX - controlx
    'y1 = controlp.Y * Screen.TwipsPerPixelY - controly
    '
    'Source.left = selectcontrolleft + x1 '  - Source.Width / 2
    'Source.top = selectcontroltop + y1 ' Y - Source.Height / 2Source.left = X - diffx
    Source.top = Y - diffy
    EightPoints Me
    End Sub