'*************************************************
'<函数名>
' gfIs_ArrayTest(obj)
'<功效>
' 判别选定的CheckBox的是一个仍是一个以上
'<参数>
' CheckBox对象名
'<前往值>
' true
' false
'<备注>
' Created on Mar.15th.2004 by AITD
'*************************************************
function gfIs_ArrayTest(obj)
on error resume next
if obj.type = "flag" then
gfIs_ArrayTest = True
else
gfIs_ArrayTest = False
end if
end function
'******************************************************
'<函数名>
' gfChkCheckbox()
'<功效>
' 反省画面CheckBox的选择是不是合适请求
'<参数>
' obj: 对应的checkbox控件
' flag: 反省划定规矩：0 可有多个被选中
' 1 只能有一个被选中
' name: 提醒用户谁人控件报错的信息
'<前往值>
' true
' false
'<备注>
' Created on Mar.15th.2004 by AITD
'******************************************************
function gfChkCheckbox(obj,flag,name)
Dim i
Dim j
gfChkCheckbox = false
i = 0
j = 0
'若对象不存在
if isnull(obj) then
msgbox "请选择一个 " + name + "。" '请选择一个对象
gfChkCheckbox = false
exit function
end if
'对象只要一个
if not gfIs_ArrayTest(obj) then
if obj.checked = false then
msgbox "请选择一个 " + name + "。" '请选择一个对象
gfChkCheckbox = false
exit function
else
gfChkCheckbox = true
exit function
end if
end if
'如有多个对象存在
for i = 0 to (obj.length - 1)
if obj(i).type = "checkbox" then
if obj(i).checked = true then
j = j + 1
end if
end if
next
if j = 0 then
msgbox "请选择 " + name + "。" '请选择一个对象
gfChkCheckbox = false
exit function
end if
if j = 1 then
gfChkCheckbox = true
exit function
end if
if j > 1 then
if flag = 1 then
msgbox "只能选择一个 " + name + "。" '只能选择一个对象
gfChkCheckbox = false
exit function
else
gfChkCheckbox = true
exit function
end if
end if
'*************************************************
'<函数名>
' gfGetCheckBoxValue(obj)
'<功效>
' 获得选定的CheckBox的值
'<参数>
' CheckBox对象名
'<前往值>
' 选定的CheckBox的值
'<备注>
' Created on Mar.15th.2004 by AITD
'*************************************************
function gfGetCheckBoxValue(obj)
dim strValue
dim intCounter
dim i
strValue = ""
intCounter = 0
'假如对象不存在
if isnull(obj) then
gfGetCheckBoxValue = strValue
exit function
end if
'假如对象为一个
if not gfIs_ArrayTest(obj) then
if obj.checked = false then
gfGetCheckBoxValue = strValue
exit function
else
gfGetCheckBoxValue = obj.value
exit function
end if
end if