资源名称:ERPSYS.zip [点击查看]
上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:29k
源码类别:
企业管理
开发平台:
Visual Basic
- VERSION 5.00
- Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
- Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
- Begin VB.Form Xt_Control
- Caption = "桌面"
- ClientHeight = 5850
- ClientLeft = 675
- ClientTop = 1665
- ClientWidth = 9240
- Icon = "系统_主操作桌面.frx":0000
- LinkTopic = "Form1"
- MDIChild = -1 'True
- ScaleHeight = 5850
- ScaleWidth = 9240
- WindowState = 2 'Maximized
- Begin VB.PictureBox picSplitter
- BackColor = &H00808080&
- BorderStyle = 0 'None
- FillColor = &H00808080&
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 4800
- Left = 4740
- ScaleHeight = 2090.126
- ScaleMode = 0 'User
- ScaleWidth = 780
- TabIndex = 0
- Top = 780
- Visible = 0 'False
- Width = 72
- End
- Begin MSComctlLib.ImageList ImageList1
- Left = 5220
- Top = 2340
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 16
- ImageHeight = 16
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 6
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":08CA
- Key = "stb"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":191C
- Key = "xttb"
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":296E
- Key = "szk"
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":2D08
- Key = "gnqx1"
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":315A
- Key = "gnqx"
- EndProperty
- BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":34F4
- Key = "kpgl"
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.ListView lvListView
- Height = 3375
- Left = 2160
- TabIndex = 5
- Top = 705
- Width = 2295
- _ExtentX = 4048
- _ExtentY = 5953
- Arrange = 2
- LabelEdit = 1
- LabelWrap = -1 'True
- HideSelection = -1 'True
- OLEDragMode = 1
- OLEDropMode = 1
- PictureAlignment= 1
- _Version = 393217
- Icons = "ImageList2"
- SmallIcons = "ImageList1"
- ColHdrIcons = "ImageList1"
- ForeColor = -2147483640
- BackColor = -2147483643
- BorderStyle = 1
- Appearance = 1
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- OLEDragMode = 1
- OLEDropMode = 1
- NumItems = 0
- End
- Begin VB.PictureBox picTitles
- Align = 1 'Align Top
- Appearance = 0 'Flat
- BorderStyle = 0 'None
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- ForeColor = &H80000008&
- Height = 300
- Left = 0
- ScaleHeight = 300
- ScaleWidth = 9240
- TabIndex = 1
- TabStop = 0 'False
- Top = 420
- Width = 9240
- Begin VB.Label lblTitle
- BorderStyle = 1 'Fixed Single
- Caption = "百利/ERP"
- Height = 270
- Index = 0
- Left = 0
- TabIndex = 3
- Tag = " 树形视图:"
- Top = 12
- Width = 2016
- End
- Begin VB.Label lblTitle
- BorderStyle = 1 'Fixed Single
- Caption = " 列表视图:"
- Height = 270
- Index = 1
- Left = 2078
- TabIndex = 2
- Tag = " 列表视图:"
- Top = 12
- Width = 3216
- End
- End
- Begin MSComDlg.CommonDialog dlgCommonDialog
- Left = 3360
- Top = 2160
- _ExtentX = 847
- _ExtentY = 847
- _Version = 393216
- End
- Begin MSComctlLib.TreeView tvTreeView
- Height = 4800
- Left = 0
- TabIndex = 4
- Top = 705
- Width = 2010
- _ExtentX = 3545
- _ExtentY = 8467
- _Version = 393217
- Indentation = 564
- Style = 7
- ImageList = "ImageList1"
- Appearance = 1
- BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
- Name = "宋体"
- Size = 9
- Charset = 134
- Weight = 400
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- End
- Begin MSComctlLib.Toolbar tbToolBar
- Align = 1 'Align Top
- Height = 420
- Left = 0
- TabIndex = 6
- Top = 0
- Width = 9240
- _ExtentX = 16298
- _ExtentY = 741
- ButtonWidth = 609
- ButtonHeight = 582
- AllowCustomize = 0 'False
- Appearance = 1
- ImageList = "imlToolbarIcons"
- _Version = 393216
- BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
- NumButtons = 10
- BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "返回"
- Object.ToolTipText = "返回"
- ImageKey = "xq"
- EndProperty
- BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "向前"
- Object.ToolTipText = "向前"
- ImageKey = "xh"
- EndProperty
- BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Style = 3
- EndProperty
- BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "大图标"
- Object.ToolTipText = "大图标"
- ImageKey = "dtb"
- Style = 2
- Value = 1
- EndProperty
- BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "小图标"
- Object.ToolTipText = "小图标"
- ImageKey = "xtb"
- Style = 2
- EndProperty
- BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "列表"
- Object.ToolTipText = "列表"
- ImageKey = "lb"
- Style = 2
- EndProperty
- BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}
- Key = "详细资料"
- Object.ToolTipText = "详细资料"
- ImageKey = "xxzl"
- Style = 2
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.ImageList imlToolbarIcons
- Left = 4710
- Top = 840
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 16
- ImageHeight = 16
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 6
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":4546
- Key = "xq"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":48E0
- Key = "xh"
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":4C7A
- Key = "dtb"
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":5014
- Key = "xtb"
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":53AE
- Key = "lb"
- EndProperty
- BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":5748
- Key = "xxzl"
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.ImageList ImageList2
- Left = 6210
- Top = 2370
- _ExtentX = 1005
- _ExtentY = 1005
- BackColor = -2147483643
- ImageWidth = 32
- ImageHeight = 32
- MaskColor = 12632256
- _Version = 393216
- BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
- NumListImages = 4
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":5AE2
- Key = "y1"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":5F36
- Key = ""
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":6256
- Key = "i"
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":72A8
- Key = "y"
- EndProperty
- EndProperty
- End
- Begin VB.Image imgSplitter
- Height = 4785
- Left = 4230
- MousePointer = 9 'Size W E
- Top = 750
- Width = 150
- End
- End
- Attribute VB_Name = "Xt_Control"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '***********************************************
- '* 模 块 名 称 :系统主操作桌面
- '* 功 能 描 述 :
- '* 程序员姓名 :张建忠
- '* 最后修改人 :张建忠
- '* 最后修改时间:2001/06/21
- '* 备 注:封版
- '***********************************************
- Const NAME_COLUMN = 0
- Const TYPE_COLUMN = 1
- Const SIZE_COLUMN = 2
- Const DATE_COLUMN = 3
- Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
- Dim mbMoving As Boolean
- Const sglSplitLimit = 1000
- Dim nodX As Node
- Dim mitem As ListItem
- Dim Ztxxrec As New ADODB.Recordset '帐套信息动态集
- Dim Xtgnbrec As New ADODB.Recordset '系统功能表
- Dim Xtqxxzrec As New ADODB.Recordset '系统权限限制动态集
- Dim Tsxx As String '系统提示信息
- Dim gnsyte As String '系统功能项索引
- Dim Xtrlrec As New ADODB.Recordset '系统日历动态集
- Dim Ctsfscdr As Boolean '窗体是否首次读入
- Dim sjgnbmStr As String '上级编码
- Private Sub lvListView_DblClick() '点击ListView执行相应功能
- If lvListView.ListItems.count > 0 Then
- Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_xtgnb where gnbm='" + Mid(Trim(lvListView.SelectedItem.Key), 2, Len(Trim(lvListView.SelectedItem.Key)) - 1) + "'")
- If Not Xtgnbrec.EOF Then
- If Xtgnbrec.Fields("mjbz") = True Then
- gnsyte = Trim(Xtgnbrec.Fields("gnsy"))
- Call Zxxymk(gnsyte)
- Else
- '---------------
- Dim Ssql As String
- sjgnbmStr = ""
- lvListView.ColumnHeaders.Clear
- lvListView.ListItems.Clear
- Ssql = "SELECT * FROM xt_xtgnb where sjgnbm='" + Xtgnbrec.Fields("gnbm") + "' and MenuList=1 order by gnbm"
- Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute(Ssql)
- lvListView.ColumnHeaders.Add 1, "rcsw", tvTreeView.SelectedItem.Text, 3000, , "stb"
- Do While Not Xtgnbrec.EOF
- Set mitem = lvListView.ListItems.Add()
- mitem.Text = Trim(Xtgnbrec!gnmc)
- If Xtgnbrec.Fields("mjbz") Then
- mitem.SmallIcon = "gnqx"
- mitem.Icon = "y"
- Else
- mitem.Icon = "i"
- mitem.SmallIcon = "stb"
- End If
- mitem.Key = "T" & Trim(Xtgnbrec!gnbm)
- Xtgnbrec.MoveNext
- Loop
- '---------------
- End If
- End If
- End If
- End Sub
- Private Sub lvListView_KeyPress(KeyAscii As Integer)
- If KeyAscii = vbKeyReturn Then
- Call lvListView_DblClick
- End If
- End Sub
- Private Sub tvTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
- Dim Ssql As String
- If Node.Tag <> "" Then
- If Node.Tag = False Then
- Ssql = "SELECT * FROM xt_xtgnb where sjgnbm='" + Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1) + "' and MenuList=1 order by gnbm"
- If sjgnbmStr = Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1) Then
- Exit Sub
- Else
- sjgnbmStr = Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1)
- End If
- Else
- Ssql = "SELECT * FROM xt_xtgnb a," _
- & "(SELECT sjgnbm FROM xt_xtgnb where gnbm='" + Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1) + "')b" & " where a.sjgnbm=b.sjgnbm and MenuList=1 order by gnbm"
- End If
- Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute(Ssql)
- If Node.Tag = True Then
- If sjgnbmStr = Trim(Xtgnbrec!sjgnbm) Then
- Exit Sub
- Else
- sjgnbmStr = Trim(Xtgnbrec!sjgnbm)
- End If
- End If
- lvListView.ColumnHeaders.Clear
- lvListView.ListItems.Clear
- lvListView.ColumnHeaders.Add 1, "rcsw", "明细", 3000, , "stb"
- Do While Not Xtgnbrec.EOF
- Set mitem = lvListView.ListItems.Add()
- mitem.Text = Trim(Xtgnbrec!gnmc)
- If Xtgnbrec.Fields("mjbz") Then
- mitem.SmallIcon = "gnqx"
- mitem.Icon = "y"
- Else
- mitem.Icon = "i"
- mitem.SmallIcon = "stb"
- End If
- mitem.Key = "T" & Trim(Xtgnbrec!gnbm)
- Xtgnbrec.MoveNext
- Loop
- End If
- End Sub
- Public Sub Cshgns() '初始化系统功能树
- Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_xtgnb where gnbm like '23%' and MenuList=1 order by gnbm")
- tvTreeView.Nodes.Add , 4, "T", "百利/ERP5.0", "xttb"
- With Xtgnbrec
- Do While Not .EOF
- If .Fields("mjbz") Then
- Set nodX = tvTreeView.Nodes.Add("T" + Trim(.Fields("sjgnbm")), 4, "T" + Trim(.Fields("gnbm")), Trim(.Fields("gnmc")), "gnqx")
- Else
- If Trim(.Fields("sjgnbm")) = "" Then
- Set nodX = tvTreeView.Nodes.Add("T" + Trim(.Fields("sjgnbm")), 4, "T" + Trim(.Fields("gnbm")), Trim(.Fields("gnmc")), "kpgl")
- Else
- Set nodX = tvTreeView.Nodes.Add("T" + Trim(.Fields("sjgnbm")), 4, "T" + Trim(.Fields("gnbm")), Trim(.Fields("gnmc")), "stb")
- End If
- End If
- nodX.Tag = Xtgnbrec!mjbz
- If Len(Trim(.Fields("sjgnbm"))) <= 2 Then
- nodX.EnsureVisible
- End If
- .MoveNext
- Loop
- End With
- End Sub
- '系统功能树操作
- Private Sub tvTreeView_BeforeLabelEdit(Cancel As Integer) '屏蔽编辑
- Cancel = 1
- End Sub
- Private Sub tvTreeView_Collapse(ByVal Node As MSComctlLib.Node) '功能树收缩
- If Node.Index <> 1 And Node.Key <> "T23" Then
- Node.Image = "stb"
- End If
- End Sub
- Private Sub tvTreeView_Expand(ByVal Node As MSComctlLib.Node) '功能树展开
- If Node.Index <> 1 And Node.Key <> "T23" Then
- Node.Image = "szk"
- End If
- End Sub
- Private Sub tvTreeView_KeyPress(KeyAscii As Integer) '用户按回车键执行相应功能
- If KeyAscii = vbKeyReturn Then
- Call tvTreeView_DblClick
- End If
- End Sub
- Private Sub tvTreeView_DblClick() '选择功能
- If tvTreeView.SelectedItem.Children = 0 Then
- Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_xtgnb where gnbm='" + Mid(Trim(tvTreeView.SelectedItem.Key), 2, Len(Trim(tvTreeView.SelectedItem.Key)) - 1) + "'")
- If Not Xtgnbrec.EOF Then
- gnsyte = Trim(Xtgnbrec.Fields("gnsy"))
- Call Zxxymk(gnsyte)
- End If
- End If
- End Sub
- Public Sub Zxxymk(gnsy As String) '根据用户选择执行相应程序
- Dim RecTemp As New ADODB.Recordset '临时使用动态集
- Dim Sqlstr As String '临时查询字符串
- If Len(Trim(gnsy)) = 0 Then
- Exit Sub
- End If
- ' '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- ' If Not Security_Log(gnsy, Xtczybm, 1, True) Then
- ' Exit Sub
- ' End If
- On Error GoTo Cwcl:
- Select Case gnsy
- '文件
- Case "Khgl_Register" '用户重新注册
- XT_login.HelpContextID = 230001
- XT_login.Show 1
- Case "Khgl_quit"
- Unload XT_Main
- '基础设置
- Case "Khgl_Check" '考核规则
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Khgl_Check_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Khgl_Check.Show 1
- Security_Log "Khgl_Check_edit", Xtczybm, 2, False '用户退出时写上机日志
- Case "Khgl_Point" '分值规则
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Khgl_Point_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Khgl_Point.Show 1
- Security_Log "Khgl_Point_edit", Xtczybm, 2, False '用户退出时写上机日志
- Case "Khgl_GauList" '量化规则明细
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Khgl_GauList_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Khgl_GauList.Show 1
- Security_Log "Khgl_GauList_edit", Xtczybm, 2, False '用户退出时写上机日志
- Case "Khgl_ValList" '测评规则明细
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Khgl_ValList_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Khgl_ValList.Show 1
- Security_Log "Khgl_ValList_edit", Xtczybm, 2, False '用户退出时写上机日志
- Case "Khgl_Factor" '考核要素设置
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Khgl_Factor_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Khgl_Factor.Show 1
- Security_Log "Khgl_Factor_edit", Xtczybm, 2, False '用户退出时写上机日志
- Case "Khgl_Title" '考核类别设置
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Khgl_Title_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Khgl_Title.Show 1
- Security_Log "Khgl_Title_edit", Xtczybm, 2, False '用户退出时写上机日志
- Case "Khgl_Group" '考核组设置
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Khgl_Group_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Khgl_Group.Show 1
- Security_Log "Khgl_Group_edit", Xtczybm, 2, False '用户退出时写上机日志
- Case "Khgl_Result" '结果类型设置
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Khgl_Result_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Khgl_Result.Show 1
- Security_Log "Khgl_Result_edit", Xtczybm, 2, False '用户退出时写上机日志
- '日常管理
- Case "Khgl_CheckQuery" '考核表查询
- Khgl_CheckQuery.Show 1
- Case "Khgl_CheckData" '单人考核数据
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Khgl_CheckData_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Khgl_CheckData.Show 1
- Security_Log "Khgl_CheckData_edit", Xtczybm, 2, False '用户退出时写上机日志
- Case "Khgl_GroupData" '考核组考核数据
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Khgl_Result_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Khgl_GroupData.Show 1
- Security_Log "Khgl_GroupData_edit", Xtczybm, 2, False '用户退出时写上机日志
- Case "Khgl_Compute" '考核数据计算
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Khgl_Compute", Xtczybm, 1) Then
- Exit Sub
- End If
- Khgl_Compute.Show 1
- Security_Log "Khgl_Compute", Xtczybm, 2, False '用户退出时写上机日志
- '统计分析
- Case "Khgl_Analyze" '考核结果分析
- Khgl_Analyze.Show
- Khgl_AnalyzeQuery.Show 1
- Case "Khgl_FactorAnalyze" '他评要素分析
- Khgl_FactorAnalyze.Show
- '工具
- Case "Khgl_gnbmjsq" '计算器
- Shell App.Path & "calc.exe", vbNormalFocus
- '帮助
- Case "Khgl_xtbz" '系统帮助
- Call F1bz
- Case "Khgl_gy" '关于
- XT_frmAbout.Show
- End Select
- '用户退出时写上机日志
- Security_Log gnsy, Xtczybm, 2, False
- Exit Sub
- Cwcl:
- Tsxx = "此项系统功能有待完善!"
- Call Xtxxts(Tsxx, 0, 4)
- Exit Sub
- End Sub
- Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '用户关闭窗体
- If Unload_TF = False Then
- Cancel = 1
- Me.WindowState = 1
- End If
- End Sub
- Private Sub Form_Load()
- '设置窗体图标
- Me.Icon = XT_Main.Icon
- '设置窗体位置大小,并调入系统功能树
- Me.Left = 0
- Me.Top = 0
- Me.Width = XT_Main.Width - 60
- Me.Height = XT_Main.Height - 760 - 690
- Call Cshgns
- '启动调入数据等待提示
- Load Xt_Wait
- End Sub
- Private Sub Form_Unload(Cancel As Integer)
- On Error Resume Next
- Dim i As Integer
- For i = Forms.count - 1 To 1 Step -1
- Unload Forms(i)
- Next
- If Me.WindowState <> vbMinimized Then
- SaveSetting App.Title, "Settings", "MainLeft", Me.Left
- SaveSetting App.Title, "Settings", "MainTop", Me.Top
- SaveSetting App.Title, "Settings", "MainWidth", Me.Width
- SaveSetting App.Title, "Settings", "MainHeight", Me.Height
- End If
- SaveSetting App.Title, "Settings", "ViewMode", lvListView.View
- End Sub
- Private Sub Form_Resize()
- On Error Resume Next
- If Me.Width < 3000 Then Me.Width = 3000
- SizeControls imgSplitter.Left
- End Sub
- Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
- With imgSplitter
- picSplitter.Move .Left, .Top, .Width 2, .Height - 20
- End With
- picSplitter.Visible = True
- mbMoving = True
- End Sub
- Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
- Dim sglPos As Single
- If mbMoving Then
- sglPos = X + imgSplitter.Left
- If sglPos < sglSplitLimit Then
- picSplitter.Left = sglSplitLimit
- ElseIf sglPos > Me.Width - sglSplitLimit Then
- picSplitter.Left = Me.Width - sglSplitLimit
- Else
- picSplitter.Left = sglPos
- End If
- End If
- End Sub
- Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
- SizeControls picSplitter.Left
- picSplitter.Visible = False
- mbMoving = False
- lvListView.Refresh
- End Sub
- Private Sub TreeView1_DragDrop(Source As Control, X As Single, Y As Single)
- If Source = imgSplitter Then
- SizeControls X
- End If
- End Sub
- Sub SizeControls(X As Single)
- On Error Resume Next
- '设置 Width 属性
- If X < 3500 Then X = 3500
- If X > (Me.Width - 1500) Then X = Me.Width - 1500
- tvTreeView.Width = X
- imgSplitter.Left = X
- lvListView.Left = X + 40
- lvListView.Width = Me.Width - (tvTreeView.Width + 140)
- lblTitle(0).Width = tvTreeView.Width
- lblTitle(1).Left = lvListView.Left + 20
- lblTitle(1).Width = lvListView.Width - 40
- '设置 Top 属性
- tvTreeView.Top = tbToolBar.Height + picTitles.Height
- lvListView.Top = tvTreeView.Top
- '设置 height 属性
- tvTreeView.Height = Me.ScaleHeight - (picTitles.Top + picTitles.Height)
- lvListView.Height = tvTreeView.Height
- imgSplitter.Top = tvTreeView.Top
- imgSplitter.Height = tvTreeView.Height
- End Sub
- Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
- On Error Resume Next
- Select Case Button.Key
- Case "返回"
- tvTreeView.SetFocus
- SendKeys "{up}", True
- Case "向前"
- tvTreeView.SetFocus
- SendKeys "{DOWN}", True
- Case "大图标"
- lvListView.View = lvwIcon
- Case "小图标"
- lvListView.View = lvwSmallIcon
- Case "列表"
- lvListView.View = lvwList
- Case "详细资料"
- lvListView.View = lvwReport
- End Select
- End Sub