📄
字号:
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************************
'* 模 块 名 称 :系统主操作桌面
'* 功 能 描 述 :
'* 程序员姓名 :张建忠
'* 最后修改人 :
'* 最后修改时间:2001/06/23
'* 备 注:封版
'***********************************************************
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
Dim sjgnbmStr As String '上级编码
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 '窗体是否首次读入
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 TreeInit()
'bsj 10月10日
'在换新的账套时树型目录没有更新
'所以在此窗体内加入这个公共过程
'以在Xt_Main中的Xtcsh模块中调用
'用以刷新树菜单
tvTreeView.Nodes.Clear
Call Cshgns
End Sub
Public Sub Cshgns() '初始化系统功能树
Set Xtgnbrec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM xt_xtgnb where gnbm like '04%' 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 <> "T04" Then
Node.Image = "stb"
End If
End Sub
Private Sub tvTreeView_Expand(ByVal Node As MSComctlLib.Node) '功能树展开
If Node.Index <> 1 And Node.Key <> "T04" Then
Node.Image = "szk"
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
Select Case gnsy
Case "cwfx_BaseProjSet" '基本项目设置
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(gnsy, Xtczybm, 1, True) Then
Exit Sub
End If
JC_FrmBaseProjSet.HelpContextID = "0411001"
JC_FrmBaseProjSet.Show vbModal
Case "cwfx_Balacen" '资产负债表设置
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(gnsy, Xtczybm, 1, True) Then
Exit Sub
End If
JC_FrmBalSetup.HelpContextID = "0411003001"
JC_FrmBalSetup.Show vbModal
Case "cwfx_Income" '损益表设置
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(gnsy, Xtczybm, 1, True) Then
Exit Sub
End If
JC_FrmIncSetup.HelpContextID = "0411003002"
JC_FrmIncSetup.Show vbModal
Case "cwfx_Tag" '指标设置
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(gnsy, Xtczybm, 1, True) Then
Exit Sub
End If
JC_FrmTagSetup.HelpContextID = "0411002001"
JC_FrmTagSetup.Show vbModal
Case "cwfx_Pro" '产品毛利率设置
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(gnsy, Xtczybm, 1, True) Then
Exit Sub
End If
JC_FrmProSetup.HelpContextID = "0411002002"
JC_FrmProSetup.Show vbModal
Case "cwfx_Ite" '项目毛利率设置
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(gnsy, Xtczybm, 1, True) Then
Exit Sub
End If
JC_FrmIteSetup.HelpContextID = "0411002003"
JC_FrmIteSetup.Show vbModal
'*************预算设置表
Case "cwfx_DeptBudget" '部门预算表
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log("cwfx_DeptBudget_Edit", Xtczybm, 1, True) Then
Exit Sub
End If
Unload_TF = True
YS_FrmDeptBudgetC.Show 1
Case "cwfx_ItemBudget" '项目预算表
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log("cwfx_ItemBudget_Edit", Xtczybm, 1, True) Then
Exit Sub
End If
Unload_TF = True
YS_FrmItemBudgetC.Show 1
Case "cwfx_AccntBudget" '科目预算表
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log("cwfx_AccntBudget_Edit", Xtczybm, 1, True) Then
Exit Sub
End If
Unload_TF = True
YS_FrmAccntBudgetC.Show 1
Case "cwfx_ProfitBudget" '利润预算表
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log("cwfx_ProfitBudget_Edit", Xtczybm, 1, True) Then
Exit Sub
End If
Unload_TF = True
YS_FrmProfitBudgetC.Show 1
'*************预算设置表
Case "cwfx_CashIncomeCost" '现金收支设置表
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log("cwfx_CashIncomeCost_Edit", Xtczybm, 1, True) Then
Exit Sub
End If
Unload_TF = True
JC_FrmCashIncomeCostC.HelpContextID = "0411005"
JC_FrmCashIncomeCostC.Show 1
Case "ZBFX_BaseGuideLine" '指标分析
ZBFX_BaseGuideLine.HelpContextID = "0412001"
ZBFX_BaseGuideLine.Show
Zbfx_BaseGuideLineSeach.Show vbModal
Case "cwfx_ProFx" '产品分析
Zbfx_ProFx.HelpContextID = "0412002"
Zbfx_ProFx.Show
Case "cwfx_IteFx" '项目分析
Zbfx_IteFx.HelpContextID = "0412003"
Zbfx_IteFx.Show '
Case "cwfx_BalJds" '资产负债表分析-绝对数分析
Call BalFx(gnsy, "0413001001")
Case "cwfx_BalDj" '资产负债表分析-定基分析
Call BalFx(gnsy, "0413001002")
Case "cwfx_BalHb" '资产负债表分析-环比分析
Call BalFx(gnsy, "0413001003")
Case "cwfx_BalDb" '资产负债表分析-对比分析
Call BalFx2(gnsy, "0413001004")
Case "cwfx_BalJg" '资产负债表分析-结构分析
Call BalFx2(gnsy, "0413001005")
'-----------------------------------------------------
Case "cwfx_IncJds" '损益表分析-绝对数分析
Call IncFx(gnsy, "0413002001")
Case "cwfx_IncDj" '损益表分析-定基分析
Call IncFx(gnsy, "0413002002")
Case "cwfx_IncHb" '损益表分析-环比分析
Call IncFx(gnsy, "0413002003")
Case "cwfx_IncDb" '损益表分析-对比分析
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -