资源名称:ERPSYS.zip [点击查看]
上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:43k
源码类别:
企业管理
开发平台:
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 = 8880
- Icon = "系统_主操作桌面.frx":0000
- LinkTopic = "Form1"
- MDIChild = -1 'True
- ScaleHeight = 5850
- ScaleWidth = 8880
- 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 = 7
- BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":1042
- Key = "stb"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":2094
- Key = "xttb"
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":30E6
- Key = "szk"
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":3480
- Key = "gnqx1"
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":38D2
- Key = "kpgl"
- EndProperty
- BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":41AC
- Key = "kftb"
- EndProperty
- BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":51FE
- Key = "gnqx"
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.ListView lvListView
- Height = 3375
- Left = 2130
- TabIndex = 5
- Top = 840
- Width = 2295
- _ExtentX = 4048
- _ExtentY = 5953
- Arrange = 2
- LabelEdit = 1
- LabelWrap = -1 'True
- HideSelection = -1 'True
- OLEDragMode = 1
- OLEDropMode = 1
- HoverSelection = -1 'True
- 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 = 8880
- TabIndex = 1
- TabStop = 0 'False
- Top = 420
- Width = 8880
- Begin VB.Label lblTitle
- BorderStyle = 1 'Fixed Single
- Caption = "百利/ERP5.0"
- 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 = 8880
- _ExtentX = 15663
- _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 = 5220
- Top = 930
- _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":5598
- Key = "xq"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":5932
- Key = "xh"
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":5CCC
- Key = "dtb"
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":6066
- Key = "xtb"
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":6400
- Key = "lb"
- EndProperty
- BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":679A
- Key = "xxzl"
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.ImageList ImageList2
- Left = 6720
- Top = 2940
- _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":6B34
- Key = "y1"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":6F88
- Key = ""
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":72A8
- Key = "i"
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":82FA
- 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/11/19
- '* 备 注:
- '***********************************************
- 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 '12%' 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")), "kftb")
- 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 <> "T12" Then
- Node.Image = "stb"
- End If
- End Sub
- Private Sub tvTreeView_Expand(ByVal Node As MSComctlLib.Node) '功能树展开
- If Node.Index <> 1 And Node.Key <> "T12" 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
- On Error GoTo Cwcl:
- Select Case gnsy
- '文件
- Case "Kf_Register" '用户重新注册
- XT_login.Show 1
- Case "Kf_SysDefine" '帐套参数设置
- If Not Security_Log("Kf_SysDefine", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmAccInfo.Show 1
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- '期初设置
- Case "Kf_StartInput" '期初数据录入
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_StartInput_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- '判断是否已经完成初始化
- If CheckStartFinish = True Then
- Tsxx = "系统已经完成初始化操作,不允许进行期初数据录入操作!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- Else
- Xtcdcs = "1"
- KF_StartInput.Show 1
- End If
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_StartInputList" '期初数据列表
- If Not Security_Log("Kf_StartInputList", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmStartcxjg.Show
- KF_FrmStartCxtj.Show 1
- Case "Kf_StartStockIn" '期初采购入库单
- If Not Security_Log("Kf_StartStockIn_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Xtcdcs = "1"
- KF_FrmStartStockIn.Show 1
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_StartStockInList" '期初采购入库单列表
- If Not Security_Log("Kf_StartStockInList", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmStartStockInList.Show
- KF_FrmStartStockInQuery.Show 1
- Case "Kf_StartChalk" '期初记帐
- If Not Security_Log("Kf_StartChalk", Xtczybm, 1) Then
- Exit Sub
- End If
- '判断是否已经完成初始化
- If CheckStartFinish = True Then
- Tsxx = "系统已经完成初始化操作,不允许进行期初结帐操作!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- Else
- KF_FrmStartEnd.Show 1
- End If
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_StartFinish" '初始化完成
- If Not Security_Log("Kf_StartFinish", Xtczybm, 1) Then
- Exit Sub
- End If
- '判断是否已经完成初始化
- If CheckStartFinish = True Then
- Tsxx = "系统已经完成初始化操作!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- Else '初始化过程
- KF_FrmStartFinish.Show 1
- End If
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- '基础设置
- Case "KF_Material" '物料档案
- If Not Security_Log("KF_Material", Xtczybm, 1) Then
- Exit Sub
- End If
- Gy_Material.Show 1
- Case "KF_Warehouse" '仓库档案
- If Not Security_Log("KF_Warehouse", Xtczybm, 1) Then
- Exit Sub
- End If
- Gy_Warehouse.Show 1
- Case "Kf_Cost" '成本对象
- If Not Security_Log("Kf_Cost", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmCostObject.Show 1
- Case "Kf_Area" '货区设置
- If Not Security_Log("Kf_Area", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmArea.Show 1
- Case "Kf_GetMaterial" '领料用途
- If Not Security_Log("Kf_GetMaterial", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmIssueUse.Show 1
- Case "Kf_ProjectType" '工程类型
- If Not Security_Log("Kf_ProjectType", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmProjectType.Show 1
- Case "Kf_Project" '工程类型
- If Not Security_Log("Kf_Project", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmProject.Show 1
- Case "Kf_NowQuan" '现存量
- If Not Security_Log("Kf_NowQuan", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmNowQuan.Show
- KF_FrmNowQuanCxtj.Show 1
- Case "Kf_MateSort" '物料分类
- If Not Security_Log("Kf_MateSort", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmwlflSet.Show 1
- '业务处理
- Case "Kf_StockIn" '采购入库单
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_StockIn_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Xtcdcs = "1"
- KF_FrmStockIn.Show 1
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_StockInList" '采购入库单列表
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_StockInList", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmStockInList.Show
- KF_FrmStockInQuery.Show 1
- Case "Kf_ProductIn" '产成品入库单
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_ProductIn_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Xtcdcs = "1"
- KF_FrmProductIn.Show 1
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_ProductInList" '产成品入库单列表
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_ProductInList", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmProductInList.Show
- KF_FrmProductInQuery.Show 1
- Case "Kf_OtherIn" '其它入库单
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_OtherIn_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Xtcdcs = "1"
- KF_FrmOtherIn.Show 1
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_OtherInList" '其它入库单列表
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_OtherInList", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmOtherInList.Show
- KF_FrmOtherInQuery.Show 1
- Case "Kf_MaterialOut" '材料出库单
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_MaterialOut_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Xtcdcs = "1"
- KF_FrmMateOut.Show 1
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_MaterialOutList" '材料出库单列表
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_MaterialOutList", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmMateOutList.Show
- KF_FrmMateOutQuery.Show 1
- Case "Kf_SellOut" '销售出库单
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_SellOut_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Xtcdcs = "1"
- KF_FrmSellOut.Show 1
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_SellOutList" '销售出库单列表
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_SellOutList", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmSellOutList.Show
- KF_FrmSellOutQuery.Show 1
- Case "Kf_OtherOut" '其它出库单
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_OtherOut_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Xtcdcs = "1"
- KF_FrmOtherOut.Show 1
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_OtherOutList" '其它出库单列表
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_OtherOutList", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmOtherOutList.Show
- KF_FrmOtherOutQuery.Show 1
- '储备分析
- Case "Kf_SafeAlart" '安全库存预警
- If Not Security_Log("Kf_SafeAlart", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_AlertSafe.Show
- KF_AlertSafeQuery.Show 1
- Case "Kf_LowerAlart" '低储预警
- If Not Security_Log("Kf_LowerAlart", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_AlertMin.Show
- KF_AlertMinQuery.Show 1
- Case "Kf_OverAlart" '高储预警
- If Not Security_Log("Kf_OverAlart", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_AlertExceed.Show
- KF_AlertExceedQuery.Show 1
- Case "Kf_DzjyAssay" '呆滞积压分析
- If Not Security_Log("Kf_DzjyAssay", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_AlertDzjy.Show
- KF_AlertDzjyQuery.Show 1
- Case "Kf_QualityAlart" '保质期预警
- If Not Security_Log("Kf_QualityAlart", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_AlertTime.Show
- KF_AlertTimeQuery.Show 1
- Case "Kf_AgeAssay" '库龄分析
- If Not Security_Log("Kf_AgeAssay", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_AlertWareage.Show
- KF_AlertWareageQuery.Show 1
- '统计分析
- Case "Kf_InOutSum" '收发存汇总
- If Not Security_Log("Kf_InOutSum", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_SumInout.Show
- KF_SumInoutQuery.Show 1
- Case "Kf_TransactSum" '业务类型汇总
- If Not Security_Log("Kf_TransactSum", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmOptypeSum.Show
- KF_FrmOptypeSumQuery.Show 1
- Case "Kf_InOutTypeSum" '收发类别汇总
- If Not Security_Log("Kf_InOutTypeSum", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmInoutSum.Show
- KF_FrmInoutSumQuery.Show 1
- Case "Kf_MaterialSum" '物料批次汇总表
- If Not Security_Log("Kf_MaterialSum", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmMateBatch.Show
- KF_FrmMateBatchQuery.Show 1
- Case "Kf_BatchSum" '批次物料汇总表
- If Not Security_Log("Kf_BatchSum", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmBatchMate.Show
- KF_FrmBatchMateQuery.Show 1
- Case "Kf_InSum" '入库汇总表
- If Not Security_Log("Kf_InSum", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmInList.Show
- KF_FrmInListQuery.Show 1
- Case "Kf_OutSum" '出库汇总表
- If Not Security_Log("Kf_OutSum", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmOutList.Show
- KF_FrmOutListQuery.Show 1
- '其他业务
- Case "KF_IssueApply" '领料申请单
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("KF_IssueApply_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Xtcdcs = "1"
- KF_FrmIssueApply.Show 1
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_MRList" '领料申请单列表
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_MRList", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmIssueApplyCxjg.Show
- KF_FrmIssueApplyCxtj.Show 1
- Case "Kf_DBD" '调拨单
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_DBD_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Xtcdcs = "1"
- KF_FrmDBD.Show 1
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_DbbList" '调拨单列表
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_DbbList", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmDBDcxjg.Show
- KF_FrmDBDCxtj.Show 1
- Case "Kf_PDD" '盘点单
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_PDD_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- Xtcdcs = "1"
- KF_FrmPDD.Show 1
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_PddList" '盘点单列表
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Kf_PddList", Xtczybm, 1) Then
- Exit Sub
- End If
- Xtcdcs = "2"
- KF_FrmPDDcxjg.Show
- KF_FrmPDDCxtj.Show 1
- Case "Kf_AutoBanlance" '自动结算
- If Not Security_Log("Kf_AutoBanlance", Xtczybm, 1) Then
- Exit Sub
- End If
- If Judge_NowDate = False Then Exit Sub
- Balance_KF_Autobalance.Show 1
- Case "Kf_HandBalance" '手工结算
- If Not Security_Log("Kf_HandBalance", Xtczybm, 1) Then
- Exit Sub
- End If
- If Judge_NowDate = False Then Exit Sub
- Balance_KF_HandBalance.Show 1
- Case "Kf_BanlanceList"
- If Not Security_Log("Kf_BanlanceList", Xtczybm, 1) Then
- Exit Sub
- End If
- Balance_KF_BillList.Show
- Balance_KF_BillQuery.Show 1
- Case "Kf_MaterialIn" '材料入库单
- If Not Security_Log("Kf_MaterialIn_edit", Xtczybm, 1) Then
- Exit Sub
- End If
- If Judge_NowDate = False Then Exit Sub
- Xtcdcs = "1"
- KF_FrmMateIn.Show 1
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_MaterialInList" '材料入库单列表
- If Not Security_Log("Kf_MaterialInList", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmMateInCxjg.Show
- KF_FrmMateInCxtj.Show 1
- Case "Kf_BalanceMateIn" '材料入库单列表
- If Not Security_Log("Kf_BalanceMateIn", Xtczybm, 1) Then
- Exit Sub
- End If
- If Clrkdkfsc = True Then
- Balance_KF_MateInList.Show
- Balance_KF_MateInQuery.Show 1
- Else
- Tsxx = "材料入库单不由库存管理系统生成,不允许查看!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- End If
- '月末处理
- Case "Kf_MonthCheck" '月末结帐
- If Not Security_Log("Kf_MonthCheck", Xtczybm, 1) Then
- Exit Sub
- End If
- '判断是否已经完成初始化
- If CheckStartFinish = False Then
- Tsxx = "系统未完成初始化操作,不允许进行月末结帐操作!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- Else
- KF_FrmCheck.Show 1
- End If
- Security_Log gnsy, Xtczybm, 2, False '用户退出时写上机日志
- Case "Kf_RepariNowQuan" '整理现存量
- If Not Security_Log("Kf_RepariNowQuan", Xtczybm, 1) Then
- Exit Sub
- End If
- If CheckStartFinish = False Then
- Tsxx = "系统未完成初始化操作,不允许进行整理现存量!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Sub
- Else
- Call NowQuanManage
- End If
- Case "Kf_Kjrlb" '会计日历表
- KF_FrmKjrlb.Show 1
- '工具
- Case "Kf_Counter" '计算器
- Shell App.Path & "calc.exe", vbNormalFocus
- '帐簿分析
- Case "Kf_WaterLedger" '库存流水帐
- If Not Security_Log("Kf_WaterLedger", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmGliad.Show
- KF_FrmGliadCxtj.Show 1
- Case "Kf_DeskLedger" '库存台帐
- If Not Security_Log("Kf_DeskLedger", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmStockAcc.Show
- KF_FrmStockAccCxtj.Show 1
- Case "Kf_BatchLedger" '批次台帐
- If Not Security_Log("Kf_BatchLedger", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmBatchAcc.Show
- KF_FrmBatchAccCxtj.Show 1
- Case "Kf_MaterialLedger" '材料台帐
- If Not Security_Log("Kf_MaterialLedger", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmMateAcc.Show
- KF_FrmMateAccCxtj.Show 1
- Case "Kf_Collate" '库存对帐表
- If Not Security_Log("Kf_Collate", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmCollate.Show
- KF_FrmCollateCxtj.Show 1
- Case "KF_DayReport" '库存日报表
- If Not Security_Log("KF_DayReport", Xtczybm, 1) Then
- Exit Sub
- End If
- KF_FrmDayReport.Show
- KF_FrmDayReportCxtj.Show 1
- '帮助
- Case "Kf_SysHelp" '系统帮助
- Call F1bz
- Case "Kf_About" '关于
- XT_frmAbout.Show
- End Select
- 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