[attach]40469[/attach]作者: todaynew 时间: 2009-11-21 11:50
Public Sub 挂饵(钓钩 As Control, ctl As Control)
钓钩.Visible = True
钓钩.Move ctl.Left + 200, ctl.Top, ctl.Width, IIf(ctl.Height > 300, 300, ctl.Height)
钓钩.BorderStyle = 0
钓钩.BackStyle = 1
钓钩.BackColor = RGB(150, 200, 200)
钓钩.Value = ctl.Value
钓钩.SetFocus
End Sub
Public Function 寻鱼(frm As Form, x As Single, y As Single) As Control
Dim ctl As Control
On Error GoTo 寻鱼_Err
For Each ctl In frm.Controls
If ctl.Name <> "钓钩" Then
If ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Then
If x >= ctl.Left And x <= ctl.Left + ctl.Width And y >= ctl.Top And y <= ctl.Top + ctl.Height Then
ctl.BackColor = RGB(0, 0, 0)
Set 寻鱼 = ctl
Else
ctl.BackColor = RGB(255, 255, 255)
End If
End If
End If
Next ctl
寻鱼_Exit:
Exit Function
寻鱼_Err:
Resume 寻鱼_Exit
End Function
Public Sub 起钩(frm As Form, 钓钩 As Control, x As Single, y As Single)
Dim ctl As Control
On Error GoTo 钓钩_Err
Set ctl = 寻鱼(frm, x, y)
ctl.Value = Nz(钓钩.Value)
ctl.SetFocus
ctl.BackColor = RGB(255, 255, 255)
钓钩.Move 0, 0
钓钩.Value = Null
钓钩.Visible = False
钓钩_Exit:
Exit Sub
钓钩_Err:
Resume 钓钩_Exit
End Sub作者: wanshan 时间: 2009-11-21 12:23
非常感谢分享，学习！
既不需要回复才能看到，也不加密！谢谢！
再赞文采……作者: zxklzxm1983 时间: 2009-11-21 15:02 又是板凳
又是板凳
