Option ExplicitPublic Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function GetFocus Lib "user32" () As Long
Private Declare Function GetQueueStatus Lib "user32" (ByVal fuFlags As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function GetTickCount Lib "KERNEL32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPrivate Const GWL_STYLE = (-16)
Private Const QS_MOUSEBUTTON = &H4
Private Const QS_MOUSEMOVE = &H2
Private Const SM_CXBORDER = 5
Private Const SM_CXSCREEN = 0
Private Const SM_CYBORDER = 6
Private Const SM_CYSCREEN = 1
Private Const SWP_NOZORDER = &H4
Private Const WS_SYSMENU = &H80000
Private Const LOGPIXELSY = 90
Private Const LOGPIXELSX = 88Private Const DefaultCrementInterval As Single = 0.5Private Type POINTAPI
X As Long
Y As Long
End TypePrivate Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End TypePrivate Type Dimensions
Width As Long
Height As Long
End TypeDim mCallingControl As Control
Dim mCallingForm As Form
Dim mCrementInterval As Double
Dim mCrementIntervalPropertyName As String
Dim mCurrentControl As ControlDim mDtmDate As Date
Dim mMaxBottom As Single
Dim mMinTop As Single
Dim mMoveSpeedControl As Boolean
Dim mPixelsPerTwipHorizontalFactor As Single
Dim mPixelsPerTwipVerticalFactor As Single
Dim mPreviousControl As Control
Dim mPreviousLabel As Control
Dim mUndoDate As Date'===============================================================================
'-函数名称: FormPlacement
'-功能描述: 根据主窗体位置自动停靠子窗体的位置
'-输入参数说明: 参数1:rctr Control 控件
' 参数2:rfrm Form 窗体
' 参数3:rintType Integer 停靠类型
'-返回参数说明: 无
'-使用语法示例: FormPlacement txtCust,me,3
'-参考:
'-使用注意: rctr 应获得焦点
'-兼容性: 97,2000,XP,2003 compatible
'-作者: 王宇虹
'-更新日期： 2003-06-23
'===============================================================================Public Sub FormPlacement(ByRef rctr As Control, rfrm As Form, Optional rintType As Integer = 0)
Dim ctlRect As RECT
Dim frmDimensions As Dimensions
Dim frmRect As RECT
Dim scrDimensions As Dimensions ctlRect = ControlRect(rctr)
