📄 frmactivetset.frm
字号:
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX"
Begin VB.Form frmActiveTSet
Caption = "业务配置"
ClientHeight = 4800
ClientLeft = 60
ClientTop = 345
ClientWidth = 4800
LinkTopic = "Form1"
ScaleHeight = 4800
ScaleWidth = 4800
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton Command1
Caption = "自动配置(&A)"
Height = 345
Index = 2
Left = 3420
TabIndex = 6
Top = 1110
Width = 1215
End
Begin VB.Frame Frame2
Caption = "说明"
Height = 1095
Left = 120
TabIndex = 4
Top = 3570
Width = 3105
Begin VB.TextBox Text1
Appearance = 0 'Flat
BackColor = &H8000000F&
BorderStyle = 0 'None
Height = 765
Left = 210
MultiLine = -1 'True
TabIndex = 5
Text = "frmActiveTSet.frx":0000
Top = 240
Width = 2835
End
End
Begin VB.CommandButton Command1
Default = -1 'True
Height = 350
Index = 0
Left = 3420
Picture = "frmActiveTSet.frx":006F
Style = 1 'Graphical
TabIndex = 2
Top = 180
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.CommandButton Command1
Height = 350
Index = 1
Left = 3420
Picture = "frmActiveTSet.frx":0931
Style = 1 'Graphical
TabIndex = 1
Top = 630
UseMaskColor = -1 'True
Width = 1215
End
Begin VB.Frame Frame1
Caption = "选择业务"
Height = 3435
Left = 120
TabIndex = 0
Top = 60
Width = 3105
Begin ComctlLib.TreeView TV1
Height = 3075
Left = 150
TabIndex = 3
Top = 210
Width = 2805
_ExtentX = 4948
_ExtentY = 5424
_Version = 327682
Indentation = 529
LineStyle = 1
Style = 7
ImageList = "ImageList1"
Appearance = 1
End
End
Begin ComctlLib.ImageList ImageList1
Left = 4020
Top = 3540
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 13
ImageHeight = 17
MaskColor = 12632256
UseMaskColor = 0 'False
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 3
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmActiveTSet.frx":11F3
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmActiveTSet.frx":1751
Key = ""
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmActiveTSet.frx":1CAF
Key = ""
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmActiveTSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim intReceiptTypeID As Integer
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0
SaveData
Unload Me
Case 1
Unload Me
Case 2
AutoConfig
End Select
End Sub
Private Sub Form_Load()
' TV1.Nodes.Add , , "R", "系统业务", 1
End Sub
Private Sub TV1_NodeClick(ByVal Node As ComctlLib.Node)
If Node.iMage = 1 Then
If Node.Expanded = True Then
Node.iMage = 3
Else
Node.iMage = 2
End If
Node.Tag = "1"
Else
Node.iMage = 1
Node.Tag = 0
End If
Debug.Print Node.Text; Node.Tag
End Sub
Private Sub ConfigTree(ByVal intReceiptType As Integer)
intReceiptTypeID = intReceiptType
If intReceiptType = 4 Then TV1.Nodes.Add , , "R0", "商品销售", 3
If intReceiptType = 2 Then TV1.Nodes.Add , , "R1", "商品采购", 1
' If intReceipttype = 13 Or intReceipttype = 14 Then TV1.Nodes.Add , , "R2", "应收应付", 1
If intReceiptType = 2 Or intReceiptType = 4 Then TV1.Nodes.Add , , "R3", "库存业务", 1
' TV1.Nodes.Add , , "R4", "现金银行", 1
' TV1.Nodes.Add , , "R5", "工资核算", 1
' TV1.Nodes.Add , , "R6", "固定资产", 1
' TV1.Nodes.Add , , "R7", "总分类帐", 1
' TV1.Nodes.Add , , "R8", "企业资料", 1
' TV1.Nodes.Add , , "R9", "领导查询", 1
' TV1.Nodes.Add , , "RA", "财务分析", 1
If intReceiptType = 4 Then TV1.Nodes.Add "R0", tvwChild, "R00", "商品销售", 1
If intReceiptType = 4 Then TV1.Nodes.Add "R0", tvwChild, "R01", "直运销售", 1
If intReceiptType = 4 Then TV1.Nodes.Add "R0", tvwChild, "R02", "分期收款发出商品", 1
If intReceiptType = 4 Then TV1.Nodes.Add "R0", tvwChild, "R03", "委托代销", 1
' If intReceiptType = 4 Then TV1.Nodes.Add "R0", tvwChild, "R04", "销售凭证", 1
If intReceiptType = 2 Then TV1.Nodes.Add "R1", tvwChild, "R10", "商品采购", 1
If intReceiptType = 2 Then TV1.Nodes.Add "R1", tvwChild, "R11", "直运采购", 1
If intReceiptType = 2 Then TV1.Nodes.Add "R1", tvwChild, "R12", "受托业务", 1
' If intReceipttype = 2 Then TV1.Nodes.Add "R1", tvwChild, "R13", "采购凭证", 1
' TV1.Nodes.Add "R3", tvwChild, "R30", "商品调拨", 1
' TV1.Nodes.Add "R3", tvwChild, "R31", "商品调价", 1
If intReceiptType = 2 Or intReceiptType = 4 Then TV1.Nodes.Add "R3", tvwChild, "R32", "商品盘点", 1
If intReceiptType = 4 Then TV1.Nodes.Add "R3", tvwChild, "R33", "委托加工", 1
If intReceiptType = 2 Then TV1.Nodes.Add "R3", tvwChild, "R34", "自制入库", 1
If intReceiptType = 4 Then TV1.Nodes.Add "R3", tvwChild, "R35", "领用出库", 1
If intReceiptType = 2 Then TV1.Nodes.Add "R3", tvwChild, "R36", "其他入库", 1
If intReceiptType = 4 Then TV1.Nodes.Add "R3", tvwChild, "R37", "其他出库", 1
' TV1.Nodes.Add "R3", tvwChild, "R38", "拆卸组装", 1
If intReceiptType = 4 Then TV1.Nodes.Add "R3", tvwChild, "R39", "成本调整", 1
' TV1.Nodes.Add "R3", tvwChild, "R3A", "成本计算", 1
' TV1.Nodes.Add "R3", tvwChild, "R3B", "库存凭证", 1
' TV1.Nodes.Add "R4", tvwChild, "R40", "收款业务", 1
' TV1.Nodes.Add "R4", tvwChild, "R41", "付款业务", 1
' TV1.Nodes.Add "R4", tvwChild, "R42", "银行对帐", 1
' TV1.Nodes.Add "R4", tvwChild, "R43", "收支凭证", 1
' TV1.Nodes.Add "R2", tvwChild, "R20", "应收业务", 1
' TV1.Nodes.Add "R2", tvwChild, "R21", "应收计息", 1
' TV1.Nodes.Add "R2", tvwChild, "R22", "应付业务", 1
' TV1.Nodes.Add "R2", tvwChild, "R23", "往来凭证", 1
' TV1.Nodes.Add "R7", tvwChild, "R70", "凭证处理", 1
' TV1.Nodes.Add "R7", tvwChild, "R71", "通用转帐", 1
' TV1.Nodes.Add "R7", tvwChild, "R72", "期末调汇", 1
' TV1.Nodes.Add "R7", tvwChild, "R73", "损益结转", 1
' TV1.Nodes.Add "R7", tvwChild, "R74", "期末结帐", 1
' TV1.Nodes.Add "R8", tvwChild, "R80", "帐套修改", 1
' TV1.Nodes.Add "R8", tvwChild, "R81", "数据备份", 1
' TV1.Nodes.Add "R8", tvwChild, "R82", "数据恢复", 1
' TV1.Nodes.Add "R8", tvwChild, "R83", "数据引入", 1
' TV1.Nodes.Add "R8", tvwChild, "R84", "数据引出", 1
' TV1.Nodes.Add "R8", tvwChild, "R85", "帐套结转", 1
' TV1.Nodes.Add "R8", tvwChild, "R86", "财务分工", 1
' TV1.Nodes.Add "R8", tvwChild, "R87", "操作日志", 1
' TV1.Nodes.Add "R8", tvwChild, "R88", "备忘录", 1
' TV1.Nodes.Add "R8", tvwChild, "R89", "报警器", 1
LoadData
End Sub
Private Sub SetANodeImg(ByVal strKey As String, ByVal intReceiptType As Integer)
If IsCanDo(EditNO(intReceiptType, False)) Then
TV1.Nodes(strKey).iMage = 2
Else
TV1.Nodes(strKey).iMage = 1
End If
End Sub
Private Sub AutoConfig()
If intReceiptTypeID = 4 Then
SetANodeImg "R00", 13 '"R00", "商品销售", 1
SetANodeImg "R01", 14 ' "R01", "直运销售", 1
SetANodeImg "R02", 18 ' "R02", "分期收款发出商品", 1
SetANodeImg "R03", 15 ' "R03", "委托代销", 1
End If
If intReceiptTypeID = 2 Then
SetANodeImg "R10", 2 ' "R10", "商品采购", 1
SetANodeImg "R11", 3 ' "R11", "直运采购", 1
SetANodeImg "R12", 4 ' "R12", "受托业务", 1
End If
If intReceiptTypeID = 2 Then
SetANodeImg "R32", 10 ' "R32", "商品盘点", 1
ElseIf intReceiptTypeID = 4 Then
SetANodeImg "R32", 23 ' "R32", "商品盘点", 1
End If
If intReceiptTypeID = 4 Then
SetANodeImg "R33", 17 ' "R33", "委托加工", 1
SetANodeImg "R35", 21 ' "R35", "领用出库", 1
SetANodeImg "R37", 24 ' "R37", "其他出库", 1
SetANodeImg "R39", 22 ' "R39", "成本调整", 1
End If
If intReceiptTypeID = 2 Then
SetANodeImg "R34", 9 ' "R34", "自制入库", 1
SetANodeImg "R36", 11 ' "R36", "其他入库", 1
End If
End Sub
Public Sub ShowConifig(ByVal intReceiptType As Integer)
ConfigTree intReceiptType
Me.Show vbModal
End Sub
Private Sub LoadData()
Dim Strsql As String
Dim recTmp As rdoResultset
Dim strAll As String
Dim intI As Integer
Strsql = "SELECT * FROM setting WhERE trim(strSetting)='" & CStr(gclsBase.OperatorID) & "'"
Set recTmp = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
If recTmp Is Nothing Then Exit Sub
If recTmp.RowCount = 0 Then GoTo EndProc
strAll = ";"
With recTmp
Do While Not .EOF
strAll = strAll & !strKey & ","
.MoveNext
Loop
End With
With TV1
For intI = 1 To TV1.Nodes.Count
If InStr(strAll, .Nodes(intI).Text) > 1 Then
.Nodes(intI).Tag = "1"
.Nodes(intI).iMage = 2
Else
.Nodes(intI).Tag = "0"
.Nodes(intI).iMage = 1
End If
Next intI
End With
EndProc:
If Not recTmp Is Nothing Then
recTmp.Close
Set recTmp = Nothing
End If
End Sub
Private Sub SaveData()
Dim Strsql As String
Dim recTmp As rdoResultset
Dim strAll As String
Dim intI As Integer
Dim strTmp As String
Strsql = "SELECT * FROM setting WhERE trim(strSetting)='" & CStr(gclsBase.OperatorID) & "'"
Set recTmp = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenDynaset)
If recTmp Is Nothing Then Exit Sub
With TV1
For intI = 1 To TV1.Nodes.Count
If Len(.Nodes(intI).Key) > 2 Then
''' recTmp ''' .FindFirst "strSection='" & .Nodes(intI).Parent.Text & "'"
If recTmp.EOF Then
recTmp.AddNew
recTmp!strSection = .Nodes(intI).Parent.Text
recTmp!strSetting = CStr(gclsBase.OperatorID)
Else
recTmp.Edit
End If
If .Nodes(intI).iMage = 1 Then
strTmp = recTmp!strKey
strTmp = FilterString(strTmp, "," & .Nodes(intI).Text)
strTmp = FilterString(strTmp, .Nodes(intI).Text)
If strTmp = "" Then strTmp = ","
recTmp!strKey = strTmp
Else
strTmp = IIf(IsNull(recTmp!strKey), ",", recTmp!strKey)
If IsNull(strTmp) Then
recTmp!strKey = .Nodes(intI).Text
Else
If InStr(strTmp, .Nodes(intI).Text) > 0 Then
Else
recTmp!strKey = recTmp!strKey & "," & .Nodes(intI).Text
End If
End If
End If
recTmp!strTypeName = "String"
recTmp.Update
End If
Next intI
End With
EndProc:
If Not recTmp Is Nothing Then
recTmp.Close
Set recTmp = Nothing
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -