'改变标题：
DBEngine.SetFormTitle ("标题")
'---------------------------------------------------------------------------------------------------------------------
'全部控件只读：
Call DBEngine.SetAllCtrlPro("EditBox", "ReadOnly", 1)
Call DBEngine.SetAllCtrlPro("DateTimeCtrl", "ReadOnly", 1)
Call DBEngine.SetAllCtrlPro("ComboBox", "ReadOnly", 1)
Call DBEngine.SetAllCtrlPro("OptionGroup", "ReadOnly", "1")
Call DBEngine.SetAllCtrlPro("CheckBox", "ReadOnly", "1")
'---------------------------------------------------------------------------------------------------------------------
'调用窗体并传递参数
'调用窗体的代码：
RowIndex = DBGrid.GetCurRecordIndex
sInitData = "<InitData><KeyValue>" & DBGrid.GetFieldStringValue("订单号",RowIndex)& "</KeyValue><ID>序号</ID><Action>ViewRecord</Action></InitData>"
strRet = DBEngine.OpenForm("IntoSchReq_Info",sInitData,"")
nCloseType = DBEngine.GetElemData(strRet, "CloseType")
If nCloseType = 1 Then
Call RetrvData()
End If
'被调用窗体代码：
gAction = DBEngine.GetElemData(strInitData, "Action")
gKey = DBEngine.GetElemData(strInitData, "KeyValue")
gID = DBEngine.GetElemData(strInitData, "ID")
If strAction = "NewRecord" then '新增记录
DBEngine.NewRecord g_strSourceName
ebCode.Text = gKey
Else
If gID <> "" Then
DBEngine.LocateRecordBySQLWhere (g_strSourceName, "ID = "+gID)
end if
If strAction = "ViewRecord" then '浏览记录
btn_Save.Enabled = False
btn_New.Enabled = False
Call DBEngine.SetAllCtrlPro("EditBox", "ReadOnly", 1)
Call DBEngine.SetAllCtrlPro("DateTimeCtrl", "ReadOnly", 1)
Call DBEngine.SetAllCtrlPro("ComboBox", "ReadOnly", 1)
end if
End if
'---------------------------------------------------------------------------------------------------------------------
'退出窗体时的检查修改动作
Sub DBEngine_EventBeforeCloseWindow(bOK)
If DBEngine.GetElemData(DBEngine.InitType, "Action") = "EditRecord" Then
If DBEngine.IsModified(g_strSourceName) Then
ret = DBEngine.MsgBox1("数据发生改变是否保存?",3)
if ret = 1 then DBEngine.Continue = false '取消
if ret = 6 then
lb_Ret = DBEngine.SaveRecord(g_strSourceName)
If not lb_Ret Then
DBEngine.Continue = false
End If
End If
End If
End If
'新增状态
If DBEngine.IsNewRecord(g_strSourceName) Then
ret = DBEngine.MsgBox1("是否保存新增的数据?",3)
if ret = 1 then DBEngine.Continue = false '取消
if ret = 6 then
lb_Ret = DBEngine.SaveRecord(g_strSourceName)
If not lb_Ret Then
DBEngine.Continue = false
End If
End If
End If
End Sub
'-----------------------------------------------------------------------------------------------------------------
'注释:调用区域式报表，并打印条件查询的结果行
Sub Print_Click()
RowIndex = MainGrid.GetCurRecordIndex
If RowIndex = -1 then
Msgbox "没有数据可打印！"
Exit sub
Else
strsql = "SELECT ReportName AS 报表名称,'区域式报表' AS 报表格式 FROM sysORepTemplate WHERE TableName='" &_
strTableName + "' "
strRet = DBEngine.WebFunction("SqlQuery", strsql , "")
ReportName = DBEngine.GetElemData(strRet, "报表名称")
strType = "<Int><SQLWhere>" + strSqlWhere + "</SQLWhere></Int>" ?传送条件
strInit = "<Int><ReportName>" + ReportName + "</ReportName></Int>"
DBEngine.OpenForm "区域式报表窗体" ,strInit,strType
End If
End Sub
'---------------------------------------------------------------------------------------------------------------------
'切换选项卡页面事件
Sub DBEngine_EventUserEvent(strEventName, strInputXML)
if strEventName = "TabCtrlCanChange" And strInputXML = "基本情况" then
if DBEngine.IsNewRecord = true then
MsgBox("请先保存“基本情况”的数据")
DBEngine.SetUserEventReturnValue("0")
End if
End if
End Sub
'---------------------------------------------------------------------------------------------------------------------
'删除网格数据
Sub btn_StudyExp_Del_Click()
nCurRecord = grd_StudyExp.GetCurRecordIndex()
if nCurRecord = -1 then exit sub
strSqlWhere = "StudyID=" & grd_StudyExp.GetFieldStringValue("StudyID", nCurRecord)
ret = DBEngine.MsgBox1("确定要删除记录?",1)
If ret = 2 then Exit Sub
strInitdata = "DELETE FROM t_b_rs_StudyExp WHERE " + strSqlWhere
strRet = DBEngine.WebFunction("SqlNonQuery", strInitData, "")
strError = DBEngine.GetNodeText(strRet, "Error")
If strError <> "" then '如返回字符串包含了Error节点,则表明出错了
DBEngine.MsgBox(strError)
Exit Sub
End if
grd_StudyExp.UpdateFromDataSourceUrl("") '更新网格数据
call SetParenValue_StudyExp()
End Sub
'---------------------------------------------------------------------------------------------------------------------
'目录树代码：
'检索 First data
Sub RetrieveTreeFirst()
TreeCatalog.InsertItem "全部",-1
dim Arr,Dic
strInitdata = " Select name from sysDepartment where supDepartment = '学校' ORDER BY name ASC"
strRet = DBEngine.WebFunction("SqlQuery", strInitData, "")
GetArrFromXML Dic,Arr,strRet
FOR i=0 TO UBound(Arr,2)
TreeCatalog.InsertItem Arr(0,i),-1
TreeCatalog.SelectItem (0)
NEXT
End Sub
'注释:取得所选节点值
Sub TreeCatalog_EventTreeSelchanged(nItemID, strItemText)
strSch = strItemText
End Sub
'---------------------------------------------------------------------------------------------------------------------
'自定义多层目录树：
Sub InitTree()
strTreeXml = strTreeXml&"<TreeXml>"
strTreeXml = strTreeXml&"<TreeItem Name=""全部""Image=""0"" SelectedImage=""1"">"
strTreeXml = strTreeXml&"<TreeItem Name=""教育组1"" Image=""0"" SelectedImage=""1"">"
strTreeXml = strTreeXml&"<TreeItem Name=""学校1"" Image=""2""></TreeItem>"
strTreeXml = strTreeXml&"<TreeItem Name=""学校2"" Image=""2""></TreeItem>"
strTreeXml = strTreeXml&"<TreeItem Name=""学校3"" Image=""2""></TreeItem>"
strTreeXml = strTreeXml&"</TreeItem>"
strTreeXml = strTreeXml&"<TreeItem Name=""教育组2"" Image=""0"" SelectedImage=""1"">"
strTreeXml = strTreeXml&"<TreeItem Name=""学校4"" Image=""2""></TreeItem>"
strTreeXml = strTreeXml&"<TreeItem Name=""学校5"" Image=""2""></TreeItem>"
strTreeXml = strTreeXml&"<TreeItem Name=""学校6"" Image=""2""></TreeItem>"
strTreeXml = strTreeXml&"<TreeItem Name=""学校7"" Image=""2""></TreeItem>"
strTreeXml = strTreeXml&"<TreeItem Name=""学校8"" Image=""2""></TreeItem>"
strTreeXml = strTreeXml&"<TreeItem Name=""学校9"" Image=""2""></TreeItem>"
strTreeXml = strTreeXml&"</TreeItem>"
strTreeXml = strTreeXml&"</TreeItem>"
strTreeXml = strTreeXml&"</TreeXml>"
'DBEngine.MsgBox(strTreeXml)
Tree.SetTreeXml(strTreeXml)
call Tree.Expand(0, 2)'展开0节点
End Sub
Sub InitField()
dim Arr,Dic
strInitdata = "SELECT DeptCode, DeptName, ParentCode,ID FROM _SysDept WHERE ParentCode='" + strParentCode + "'"
strRet = DBEngine.WebFunction("SqlQuery", strInitData, "")
GetArrFromXML Dic,Arr,strRet
Tree.DeleteAllItems
FOR i=0 TO UBound(Arr,2)
ID = Tree.InsertItem( Arr(0,i) + "-" + Arr(1,i),-1)
Tree.SetItemData ID,Arr(3,i)
RetrieveTreeSecond ID,Arr(0,i)
Tree.Expand 0,2
NEXT
End Sub
'---------------------------------------------------------------------------------------------------------------------
'取字段的扩展属性（字段描述信息）
SELECT *
FROM ::fn_listextendedproperty (NULL, 'user', 'dbo', 'table', 't_intosch_baseinfo', 'column', default) Order by objname
'---------------------------------------------------------------------------------------------------------------------
'取部门用户信息
返回当前用户名称 GetCurUserName
返回当前用户的登陆名称 GetCurLoginName
返回当前用户的UserID GetCurUserID
返回当前用户的departmentID GetCurUserDepartmentID
*传入用户ID和权限ID,判断用户是否有相应权限 JudgeUserPermission 参数:(Input><UserID></UserID><PrivilegeID></PrivilegeID></Input>
*根据名称(SessionName)返回Session值字符串 GetSessionValue 参数:(Input><SessionName></SessionName></Input>
*根据名称设置Session值字符串 SetSessionValue 参数:(Input><SessionName></SessionName><SessionValue></SessionValue></Input>
'取得部门ID
CurDeptID = DBEngine.WebFunction("GetCurUserDepartmentID", "", "")
'取得部门名称
StrInput = "<priMag><methodKey>getOrganName</methodKey><param id=""1"">"&CurDeptID&"</param></priMag>"
strRet = DBEngine.WebFunction("", strInput, "&PFKey=Privilege:1.0")
CurDeptName = DBEngine.GetNodeText(strRet,"organName")
'取得机构ID和名称
StrInput = "<priMag><methodKey>getOrganID</methodKey><param id=""1"">"&CurDeptID&"</param></priMag>"
strRet = DBEngine.WebFunction("", strInput, "&PFKey=Privilege:1.0")
CurOrgID = DBEngine.GetNodeAttribText(strRet,"Organ","ID")
CurOrgName = DBEngine.GetNodeAttribText(strRet,"Organ","Name")
'取得当前学校学段列表，并赋给组合框
strInputXml = "<priMag><methodKey>getSchoolQuality</methodKey><param id=""1"">"&CurSchoolID&"</param></priMag>"
strXmlRet = DBEngine.WebFunction("", strInputXML, "&PFKey=Privilege:1.0")
If Instr(strXmlRet,"<Error>") <> 0 Then
strInputXml = "<priMag><methodKey>getSchoolQuality</methodKey><param id=""1"">root</param></priMag>"
strXmlRet = DBEngine.WebFunction("", strInputXML, "&PFKey=Privilege:1.0")
strWaitSelValue = ConvertToTableDataXml(strXmlRet, "schTypeList", "schType")
call cmbGradePhase.SetTrueDataMapXml(strWaitSelValue, "schquavalue", "schqua")
Else
dim ArrList
strStart = "<schQua>"
strEnd = "<schQua>"
cmbStudyPhase.Clear
GetArrFromXML arrList,strStart,strEnd,strXmlRet
FOR i=0 TO UBound(ArrList)
cmbStudyPhase.AddItem ArrList(i)
NEXT
End If
'---------------------------------------------------------------------------------------------------------------------
'取网格中日期字段值：
strdtcFrom = DBEngine.ToDateString(DBGrid14.GetFieldStringValue("起始时间",nRowIndex))
'-------调用存储过程－－－－－－－－－－
Function RequBillNo()
strInputXML = "<Input><ProcName>RequestBillNo</ProcName><InputList>" &_
"</InputList><OutputList><OutputName>Result</OutputName></OutputList></Input>"
strRetXML = DBEngine.WebFunction("DoProcedure", strInputXML, "")
strError = DBEngine.GetNodeText(strRetXML, "Error")
If strError <> "" Then '如返回字符串包含了Error节点,则表明出错了
DBEngine.MsgBox (strError)
Else
RequBillNo = strRetXML
End If
End Function
'向调用窗体返回值
'==================================================================
'被调用窗体
RowIndex = MainGrid.GetCurRecordIndex
DBEngine.SetReturnValue (MainGrid.GetRowDataXML(RowIndex))
DBEngine.CloseWindow(1)
'调用窗体
strRet = DBEngine.OpenForm("被调用窗体", "", "")
nCloseType = DBEngine.GetElemData(strRet,"CloseType")
If nCloseType Then
ebCode.text = DBEngine.GetElemData(strRet,"ReturnValue")
End If
'取年级列表--将年级列表分组赋值给组合框
cmbGrade.Clear
StrInput = "<Input><TableName>T_ClassInfo</TableName><FieldName>Grade</FieldName>" &_
"<SQLWhere>SchoolID = '"+CurSchoolID+"'</SQLWhere></Input>"
StrRet = DBEngine.WebFunction("GetGroupFieldValue",strInput,"")
arrList = Split(StrRet,"|",-1) '将列表组成数据数组
cmbGrade.AddItem ("全部")
FOR i=0 TO UBound(arrList)
If ArrList(i)<> "" Then
cmbGrade.AddItem ArrList(i)
End If
NEXT
cmbGrade.Text = "全部"
'取TableDataXml节点值<NAME>
ReDim arrList(0)
strStart = "<NAME>"
strEnd = "</NAME>"
cmbStudyType.Clear
StrSql = "Select Name From T_A_STUDYTYPE Where StudyPhase = '"+cmbStudyPhase.Text+"'"
StrRet = DBEngine.WebFunction("SqlQuery",StrSql,"")
GetArrFromXML arrList,strStart,strEnd,StrRet '调用GetArrFromXML函数
FOR i=0 TO UBound(arrList)
cmbStudyType.AddItem ArrList(i)
If UBound(ArrList) = 0 Then
cmbStudyType.SelectString 0,ArrList(0)
cmbStudyType_CloseUp()
End If
NEXT
'函数：将FieldInfo节点值组成数组 ---白肖峰
Function GetArrFromXML(ByRef FieldArr, ByRef Arr1, Xml1)
Dim i, j, lsXml, lsChar, liStar, liEnd, lsStar, lsEnd, liLen,Dic1
lsStar = "<FieldName>"
lsEnd = "</FieldName>"
liLen = Len(lsStar)
i = InStr(1,Xml1, "<FieldInfoArray>",1)
If i <> 0 Then
lsXml = Mid(Xml1, i, Len(Xml1))
Else
Exit Function
End If
liStar = InStr(1, lsXml, lsStar, 1)
liEnd = InStr(1, lsXml, lsEnd, 1)
Do While liEnd > 0
If IsArray(FieldArr) Then
ReDim Preserve FieldArr(UBound(FieldArr) + 1)
Else
ReDim FieldArr(0)
End If
FieldArr(UBound(FieldArr)) = Mid(lsXml, liStar + liLen, liEnd - liStar - liLen)
liStar = InStr(liEnd+1, lsXml, lsStar, 1)
liEnd = InStr(liEnd+1, lsXml, lsEnd, 1)
Loop
Set Dic1 = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(FieldArr, 1)
Dic1.Add FieldArr(i), CStr(i)
Next
'
liStar = InStr(1, lsXml, "<RowNum>", 1)
liEnd = InStr(1, lsXml, "</RowNum>", 1)
i = Int(Mid(lsXml, liStar + Len("<RowNum>"), liEnd - liStar - Len("<RowNum>")))
ReDim Arr1(UBound(FieldArr, 1), i - 1)
tmpStartPos = InStr(1, lsXml, "<Row>", 1)
lsXml = Right(lsXml,Len(lsXml) - tmpStartPos + 1)
For i = 0 To UBound(Arr1,2)
tmpInt = InStr(1, lsXml, "</Row>", 1)
tmpXml = Left(lsXml,tmpInt + Len("</Row>") - 1)
lsXml = Right(lsXml,Len(lsXml) - tmpInt - Len("</Row>") + 1)
For j = 0 To UBound(FieldArr, 1)
lsStar = "<" & FieldArr(j) & ">"
lsEnd = "</" & FieldArr(j) & ">"
liLen = Len(lsStar)
liStar = InStr(1, tmpXml, lsStar, 1)
liEnd = InStr(1, tmpXml, lsEnd, 1)
If liStar = 0 Or liEnd = 0 Then
Arr1(j,i) = ""
Else
Arr1(j, i) = Mid(tmpXml, liStar + liLen, liEnd - liStar - liLen)
End If
Next
Next
'修改结束 bxf
End Function
'函数：将XML节点值组成数组 ---杨庚
Function GetNodeTextFromXml(arrList,strStart,strEnd,strXml)
lenXml = Len(strXml)
lStart = Len(strStart)
lEnd = Len(strEnd)
StartNum = 1
EndNum = 1
i = 0
Do While InStr(StartNum,strXml,strStart) > 0
StartNum = InStr(StartNum,strXml,strStart) + lStart
EndNum = InStr(EndNum,strXml,strEnd) + lEnd
If i > 0 Then
ReDim Preserve arrList(UBound(arrList)+i)
End If
i = i+1
arrlist(UBound(arrList)) = Mid(strXml,StartNum,EndNum-lEnd-StartNum)
Loop
End Function
'函数：将XML整个节点组成数组 ---杨庚
Function GetNodeFromXML(arrList,strStart,strEnd,strXml)
lenXml = Len(strXml)
lStart = Len(strStart)
lEnd = Len(strEnd)
StartNum = 1
EndNum = 1
i = 0
Do While InStr(StartNum,strXml,strStart) > 0
StartNum = InStr(StartNum,strXml,strStart)
EndNum = InStr(EndNum,strXml,strEnd) + lEnd
If i > 0 Then
ReDim Preserve arrList(UBound(arrList)+i)
End If
i = i+1
arrlist(UBound(arrList)) = Mid(strXml,StartNum,EndNum-StartNum)
StartNum = StartNum + lStart
Loop
End Function
