VBSCRIPT实现HTML页面控件的键盘光标位置获取和设置功能

        在编写B/S程序时，有时往往需要获取或设置控件中光标的位置，以便于对控件进行进一步的子类化，可是HTML中的标准控件没有HWND，也无明显相关的属性，实现起来有点复杂，俺曾经为这个问题苦恼了好长时间，在网上搜索也得不到答案，后来经过几天的实验，才发现其实只需要基于DOM就可以实现，为了让朋友们少走弯路，故把代码贴出来，并附上一个基于此代码对INPUT 控件进行子类化的实例（实现HTML文本的货币输入和显示）。

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ' 代码说明：获得或设置输入光标的位置 ' 版权声明：本代码由lyserver编制 ' 引用时请注明来处 '---------------------------------------------------- Const CARET_LIB = 1 '* ************************************************* * '* 辅助函数，获得光标位置 * '* ************************************************* * Function GetCaretPos(obj) Dim nPos Dim activeObj, docRange nPos = 0 Set activeObj = Document.activeElement If obj.sourceIndex <> activeObj.sourceIndex Then obj.Focus End If Set docRange = Document.selection.createRange() docRange.moveEnd "character", Len(obj.Value) nPos = Len(obj.Value) - Len(docRange.Text) If obj.sourceIndex <> activeObj.sourceIndex Then activeObj.Focus End If GetCaretPos = nPos End Function '* ************************************************* * '* 辅助函数，设置光标位置 * '* ************************************************* * Sub SetCaretPos(obj, nPos) Dim objRange 'On Error Resume Next If obj.sourceIndex <> Document.activeElement.sourceIndex Then obj.Focus End If Set objRange = obj.createTextRange() objRange.moveStart "character", nPos objRange.Collapse objRange.Select End Sub ' 代码段结束 '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> '基于上述两个函数的子类化实现代码: '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ' 代码说明：用VbScript子类化HTML文本框， ' 使其只能输入数字或小数点，并以货币形式显示 ' 调用说明：设置需要子类化的文本框的Name为cyBox即可 ' 版权声明：本代码由lyserver编制 ' 引用时请注明来处 '* ************************************************* * '* 模块公共变量 * '* ************************************************* * Dim m_cyBox Const CYBOX_LIB = 1 '* ************************************************* * '* 子类化初始函数 * '* ************************************************* * Call m_cyBox_Init Sub m_cyBox_Init() Dim i, c, cyBox_Array On Error Resume Next Set cyBox_Array = Document.getElementsByName("cyBox") c = cyBox_Array.Length - 1 For i = 0 To c Set m_cyBox = cyBox_Array(i) m_cyBox.Value = "￥0.00" Set m_cyBox.OnFocus = GetRef("m_cyBox_OnFocus") Set m_cyBox.OnBlur = GetRef("m_cyBox_OnBlur") Set m_cyBox.OnKeyPress = GetRef("m_cyBox_OnKeyPress") Next '动态加载光标辅助函数库 If IsEmpty(CARET_LIB) Then Document.write "<Script Language=VBScript Src="vbs/Caret.vbs" mce_Src="vbs/Caret.vbs"></" & "Script>" End If End Sub '* ************************************************* * '* 焦点获得事件 * '* ************************************************* * Sub m_cyBox_OnFocus() Dim nValue On Error Resume Next Set m_cyBox = Document.activeElement nValue = CCur(m_cyBox.Value) If Not IsNumeric(nValue) Then m_cyBox.Value = 0 ElseIf Left(nValue, 1) = "." Then m_cyBox.Value = "0" & nValue Else m_cyBox.Value = nValue End If If Err.Number > 0 Then m_cyBox.Value = 0 End If m_cyBox.Select() End Sub '* ************************************************* * '* 焦点失去事件 * '* ************************************************* * Sub m_cyBox_OnBlur() Dim strValue On Error Resume Next strValue = m_cyBox.Value If strValue = "-0" Or (Not IsNumeric(strValue)) Then strValue = "0" End If m_cyBox.Value = FormatCurrency(strValue, 2, True) End Sub '* ************************************************* * '* 按键事件处理 * '* ************************************************* * Sub m_cyBox_OnKeyPress() Dim kCode, nDotPos, nSelPos, strValue On Error Resume Next kCode = window.event.keyCode strValue = m_cyBox.Value If kCode = 45 Then '处理负号 nSelPos = GetCaretPos(m_cyBox) If nSelPos <> 0 Then window.event.keyCode = 0 End If ElseIf kCode = 46 Then '处理小数点 nDotPos = InStr(1, strValue, ".") nSelPos = GetCaretPos(m_cyBox) If nSelPos = 0 Then '如果小数点处于最前，则补上0 m_cyBox.Value = "0." window.event.keyCode = 0 SetCaretPos m_cyBox, 2 ElseIf nSelPos = 1 And Left(strValue, 1) = "-" Then m_cyBox.Value = "-0." window.event.keyCode = 0 SetCaretPos m_cyBox, 3 ElseIf nDotPos Then '如果已有小数点，则截取多余数字 m_cyBox.Value = Left(strValue, nDotPos - 1) End If ElseIf kCode = 48 And (strValue = "0" Or strValue = "-0") Then '过滤最前面多余的0 window.event.keyCode = 0 ElseIf kCode < 48 Or kCode > 57 Then '过滤掉数字和小数点之外的按键 window.event.keyCode = 0 End If End Sub ' 代码段结束 '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>