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

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

<textarea cols="50" rows="15" name="code" class="vb:nogutter:nocontrols">'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' 代码说明：获得或设置输入光标的位置
' 版权声明：本代码由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
' 代码段结束
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
</textarea>