English
资源名称：ERPSYS.zip [点击查看]
上传用户：zhpu1995
上传日期：2013-09-06
资源大小：61151k
文件大小：27k
源码类别：
企业管理
开发平台：
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 MSComctlLib.ImageList ImageList1
- Left = 4920
- Top = 3030
- _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":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 = "gnqx"
- EndProperty
- BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":3C6C
- Key = "kpgl"
- EndProperty
- EndProperty
- End
- 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.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 = 8880
- TabIndex = 1
- TabStop = 0 'False
- Top = 420
- Width = 8880
- 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 = 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 = 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":4CBE
- Key = "xq"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":5058
- Key = "xh"
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":53F2
- Key = "dtb"
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":578C
- Key = "xtb"
- EndProperty
- BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":5B26
- Key = "lb"
- EndProperty
- BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":5EC0
- Key = "xxzl"
- EndProperty
- EndProperty
- End
- Begin MSComctlLib.ImageList ImageList2
- Left = 5850
- Top = 3030
- _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":625A
- Key = "y1"
- EndProperty
- BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":66AE
- Key = ""
- EndProperty
- BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":69CE
- Key = "i"
- EndProperty
- BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
- Picture = "系统_主操作桌面.frx":7A20
- 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)
- Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
- 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 '07%' 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 <> "T07" Then
- Node.Image = "stb"
- End If
- End Sub
- Private Sub tvTreeView_Expand(ByVal Node As MSComctlLib.Node) '功能树展开
- If Node.Index <> 1 And Node.Key <> "T07" 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 "Cb_register" '用户重新注册
- XT_login.Show 1
- Case "Cb_quit"
- Unload XT_Main
- '1.基础设置
- Case "Cb_CostCenter" '成本中心
- JC_FrmCostCenter.HelpContextID = 702001
- JC_FrmCostCenter.Show 1
- Case "Cb_CostItem" '成本项目
- JC_FrmCostItem.HelpContextID = 702002
- JC_FrmCostItem.Show 1
- Case "Cb_CostObject" '成本对象
- JC_FrmCostObject.HelpContextID = 702003
- JC_FrmCostObject.Show 1
- Case "Cb_CostStru" '成本结构
- JC_FrmCostStructure.HelpContextID = 702004
- JC_FrmCostStructure.Show 1
- Case "Cb_GatherSet" '归集关系
- JC_FrmGatherSet.HelpContextID = 702005
- JC_FrmGatherSet.Show 1
- Case "Cb_ScatterSet" '分配关系
- JC_FrmScatterSet.HelpContextID = 702006
- JC_FrmScatterSet.Show 1
- '2.成本计算
- Case "CB_Inventory" '月末盘存
- JS_FrmInventory.HelpContextID = 703001
- JS_FrmInventory.Show
- Case "CB_ObjectComplete" '对象完工
- JS_FrmObjectComplete.HelpContextID = 703002
- JS_FrmObjectComplete.Show
- Case "Cb_CostGather" '成本归集
- JS_FrmCostGather.HelpContextID = 703003
- JS_FrmCostGather.Show
- Case "CB_CostScatter" '成本分配
- JS_FrmCostScatter.HelpContextID = 703004
- JS_FrmCostScatter.Show
- '3.成本分析
- Case "CB_CostReport" '成本明细
- FX_FrmCostReport.HelpContextID = 704001
- FX_FrmCostReport.Show
- Case "CB_CostCollect" '成本汇总
- FX_FrmCostCollect.HelpContextID = 704002
- FX_FrmCostCollect.Show
- '4.结转凭证
- Case "CB_CostCarryForward" '结转成本
- JZ_FrmTranList.HelpContextID = 705001
- JZ_FrmTranList.TranClassCode = "01"
- JZ_FrmTranList.Caption = "结转生产成本"
- JZ_FrmTranList.Show 1
- Case "CB_CostManuFactured" '结转成品
- JZ_FrmTranList.HelpContextID = 705002
- JZ_FrmTranList.TranClassCode = "02"
- JZ_FrmTranList.TsLabel(6).Caption = "结转产成品"
- JZ_FrmTranList.Caption = "结转产成品"
- JZ_FrmTranList.Show 1
- '工具
- Case "Cb_gnbmkmrl" '会计日历
- XT_kjrlFrm.HelpContextID = 706001
- XT_kjrlFrm.Show 1
- Case "Cb_gnbmjsq" '计算器
- Shell "calc.exe", vbNormalFocus
- '帮助
- Case "Cb_wshxxd" '网上华夏新达
- ShellExecute 0, "open", "www.hxxd.com", "", "", 0
- Case "Cb_xtbz" '系统帮助
- Call F1bz
- Case "Cb_gy" '关于
- 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
