📄 项目向导.frm
字号:
End
Begin VB.ListBox lstXdkm
Height = 1140
Left = 990
Sorted = -1 'True
TabIndex = 35
Top = 2130
Width = 2805
End
Begin VB.ListBox lstDxkm
Height = 960
Left = 990
Sorted = -1 'True
TabIndex = 34
Top = 690
Width = 2805
End
Begin VB.ComboBox cobXmmc
Height = 300
Left = 990
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 33
Top = 270
Width = 2505
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "选定科目"
Height = 180
Left = 180
TabIndex = 42
Top = 2190
Width = 720
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "待选科目"
Height = 180
Left = 180
TabIndex = 41
Top = 720
Width = 720
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "项目名称"
Height = 180
Left = 180
TabIndex = 40
Top = 330
Width = 720
End
End
Begin VB.Frame bk
Height = 3500
Index = 1
Left = 2600
TabIndex = 28
Top = 240
Width = 4200
Begin EDITLib.Edit edtXmmc
Height = 270
Left = 1140
TabIndex = 1
Top = 690
Width = 1905
_Version = 65536
_ExtentX = 3360
_ExtentY = 476
_StockProps = 253
ForeColor = 0
BackColor = 16777215
Appearance = 1
MaxLength = 20
BadStr = "|'"""
End
Begin VB.Frame Frame2
Height = 30
Left = 150
TabIndex = 51
Top = 1530
Width = 3945
End
Begin VB.ComboBox cobSrc
Enabled = 0 'False
Height = 300
Left = 1140
TabIndex = 2
Text = "cobSrc"
Top = 1080
Width = 1335
End
Begin VB.ListBox lstXmml
Height = 960
Left = 330
Sorted = -1 'True
TabIndex = 6
Top = 1920
Width = 2715
End
Begin VB.CommandButton cmdOk
Caption = "确定"
Enabled = 0 'False
Height = 315
Left = 3270
TabIndex = 3
Top = 1080
Width = 615
End
Begin VB.CommandButton cmdAdd
Caption = "增加"
Height = 315
Left = 3270
TabIndex = 4
Top = 1980
Width = 615
End
Begin VB.CommandButton cmdDel
Caption = "删除"
Height = 315
Left = 3270
TabIndex = 5
Top = 2370
Width = 615
End
Begin VB.TextBox txtXmbm
Enabled = 0 'False
Height = 270
Left = 1140
TabIndex = 0
Top = 300
Width = 1335
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "数据来源"
Height = 180
Left = 300
TabIndex = 50
Top = 1110
Width = 720
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "项目名称"
Height = 180
Left = 300
TabIndex = 31
Top = 735
Width = 720
End
Begin VB.Label Label11
AutoSize = -1 'True
Caption = "项目目录"
Height = 180
Left = 330
TabIndex = 30
Top = 1650
Width = 720
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "项目编码"
Height = 180
Left = 300
TabIndex = 29
Top = 360
Width = 720
End
End
End
Attribute VB_Name = "frmItmWzd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'软件著作权: 北京用友软件集团有限公司
'系统名称: 资金管理8.0
'功能说明: 项目定义向导
'作者: 赵春立
Option Explicit
Private mStep As Long
Private cGrade As String
Private bReXmLst As Boolean
Public blnRuned As Boolean
Private blnFillcob As Boolean
Private blnChangeKm As Boolean
Private blnChangeDl As Boolean
Private blnClick As Boolean
Private blnRefresh As Boolean
Private lngCobXmmc() As Long
Private lngGrade(1 To 4) As Long
Private strGrade(1 To 4) As String
Private iGrade As Long
Private blnAddOrEdit As Boolean
'**********************************************************************
'*函数说明: 验证项目编码的正确性 *
'*参 数: *
'* *
'*返回值 : True - 正确 *
'***********************************************************************
Private Function VerifyGrade() As Boolean
Dim i As Long, tmpGrade As Long
Dim id As Integer
VerifyGrade = False
For i = 1 To 4
tmpGrade = tmpGrade + lngGrade(i)
strGrade(i) = mID(txtXmbm, 1 + tmpGrade - lngGrade(i), lngGrade(i))
Next i
For i = 1 To 4
If strGrade(i) <> "" And lngGrade(i) <> Len(strGrade(i)) Then
MsgBox "项目编码不符合级次定义！", vbInformation, zjGl_Name
SetTxtFocus txtXmbm
Exit Function
End If
Next i
For i = 1 To 4
If strGrade(i) = "" Then
Exit For
End If
Next i
iGrade = i - 1
VerifyGrade = True
End Function
'**********************************************************************
'*函数说明: 填充ListBox *
'*参 数: mIndex - 项目大类 *
'* *
'*返回值 : *
'***********************************************************************
Private Sub FillLst(mIndex As Integer)
Dim rsl As New UfRecordset, sqlL As String
On Error Resume Next
lResume:
sqlL = "SELECT * FROM FD_Items WHERE [iitems_id]=" & (cobDl.ListIndex + 1)
Set rsl = dbsZJ.OpenRecordset(sqlL, dbOpenSnapshot)
lstXmml.Clear
While Not rsl.EOF
lstXmml.AddItem "[" & rsl![cItem_id] & "] " & rsl![cItem_Name]
rsl.MoveNext
If Err <> 0 Then GoTo lResume
Wend
On Error GoTo 0
On Error GoTo Errsol
If lstXmml.ListCount <> 0 Then lstXmml.Selected(mIndex) = True
Exit Sub
Errsol:
mIndex = mIndex - 1
Resume
End Sub
'**********************************************************************
'*函数说明: 填充Combo *
'*参 数: *
'* *
'*返回值 : *
'***********************************************************************
Private Sub FillCob()
Dim rsC As New UfRecordset
Dim sqlC As String
Dim i As Long
Dim j As Long
sqlC = "SELECT * FROM FD_Items WHERE [bend] = 1 AND [iitems_id]=" & _
(cobDl.ListIndex + 1) & " ORDER BY [citem_id]"
Set rsC = dbsZJ.OpenRecordset(sqlC, dbOpenSnapshot)
cobXmmc.Clear
i = 0: j = 0
ReDim lngCobXmmc(2, 10)
While Not rsC.EOF
cobXmmc.AddItem "[" & rsC![cItem_id] & "]" & rsC![cItem_Name]
'1-科目；2-账户；0-非末级
lngCobXmmc(0, j) = IIf(rsC![bSource], 1, 2)
lngCobXmmc(1, j) = rsC![iItem_id]
j = j + 1
If j >= i + 10 Then
ReDim Preserve lngCobXmmc(2, j + 10)
i = i + 10
End If
rsC.MoveNext
Wend
If cobXmmc.ListCount <> 0 Then cobXmmc.Text = cobXmmc.List(0)
End Sub
Private Sub cmdStep_Click(Index As Integer)
Dim i As Long
Select Case Index
Case 0
If blnChangeKm Then
If Not SavKm(cobXmmc.ListIndex) Then
MsgBox "网络互斥，请过一会儿再试！", vbInformation, zjGl_Name
End If
blnChangeKm = False
bReXmLst = True
End If
mStep = mStep - 1
cmdStep(1).Enabled = True
If mStep = 0 Then
cmdStep(0).Enabled = False
cmdStep(2).Caption = "放弃"
If lstXmml.ListCount = 0 Then
For i = 1 To 3
txtgrade(i).Locked = False
Next i
Else
For i = 1 To 3
txtgrade(i).Locked = True
Next i
End If
End If
Case 1
If mStep = 0 Then
If Not VerifyDl Then Exit Sub
ElseIf mStep = 1 Then
If bReXmLst Then
bReXmLst = False
blnFillcob = False
FillCob
End If
End If
mStep = mStep + 1
cmdStep(0).Enabled = True
cmdStep(2).Caption = "完成"
If mStep = 2 Then
cmdStep(1).Enabled = False
End If
Case 2
If blnChangeKm Then
If Not SavKm(cobXmmc.ListIndex) Then
MsgBox "网络互斥，请过一会儿再试！", vbInformation, zjGl_Name
End If
blnChangeKm = False
End If
If cmdStep(2).Caption = "完成" Then
If blnChangeDl Then
blnChangeDl = False
SavDl cobDl.ListIndex + 1
End If
End If
frmItem.blnRefresh = blnRefresh
blnRefresh = False
Unload Me
End Select
If Index <> 2 Then
ShowSign mStep
For i = 0 To 2
If i = mStep Then
bk(i).Visible = True
Else
bk(i).Visible = False
End If
Next i
If bk(1).Visible Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -