📄 frmvouchertypelistcard.frm
字号:
Height = 225
Index = 13
Left = 3240
TabIndex = 22
Top = 3000
Width = 795
End
Begin VB.Label lblTitle
Caption = "科目编号"
Height = 225
Index = 8
Left = 360
TabIndex = 21
Top = 2580
Width = 795
End
Begin VB.Label lblTitle
Caption = "科目编号"
Height = 225
Index = 9
Left = 360
TabIndex = 20
Top = 3000
Width = 795
End
Begin VB.Label lblTitle
Caption = "科目编号"
Height = 225
Index = 10
Left = 3240
TabIndex = 19
Top = 1260
Width = 795
End
Begin VB.Label lblTitle
Caption = "科目编号"
Height = 225
Index = 11
Left = 3240
TabIndex = 18
Top = 1680
Width = 795
End
Begin VB.Label lblTitle
Caption = "科目编号"
Height = 225
Index = 6
Left = 360
TabIndex = 17
Top = 1260
Width = 795
End
Begin VB.Label lblTitle
Caption = "科目编号"
Height = 225
Index = 7
Left = 360
TabIndex = 16
Top = 1680
Width = 795
End
Begin VB.Label lblTitle
Caption = "凭证类型名称(&N)"
Height = 225
Index = 4
Left = 3000
TabIndex = 2
Top = 390
Width = 1455
End
Begin VB.Label lblTitle
Caption = "凭证类型编码(&C)"
Height = 225
Index = 0
Left = 240
TabIndex = 0
Top = 390
Width = 1365
End
End
Attribute VB_Name = "frmVoucherTypeListCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 凭证类型卡片
' 作者：郑权
' 日期：1998.07.21
'
' 功能：完成凭证类型表的增、删、改操作
'
' 接口： AddCard 增加凭证类型记录。
' 参数：intModal 显示模式，strName 用户输入值
' EditCard 修改凭证类型记录。
' 参数： lngID 被修改的记录的ID，intModal 显示模式
' DelCard 删除凭证类型记录。
' 参数： lngID 被删除的记录的ID
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private Type VoucherTypeRecord '处理凭证类型表的记录
lngVoucherTypeID As Long '凭证类型ID
strVoucherTypeCode As String '凭证类型编码
strVoucherTypeName As String '凭证类型名称
blnIsInActive As Boolean '封存标志
lngDebitAccountID1 As Long '借方必有科目ID1
lngDebitAccountID2 As Long '借方必有科目ID2
lngCreditAccountID1 As Long '贷方必有科目ID1
lngCreditAccountID2 As Long '贷方必有科目ID2
lngVoucherAccountID1 As Long '凭证必有科目ID1
lngVoucherAccountID2 As Long '凭证必有科目ID2
lngVoucherNOAccountID1 As Long '凭证必无科目ID1
lngVoucherNOAccountID2 As Long '凭证必无科目ID2
End Type
Private WithEvents mclsMainControl As MainControl '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private mblnAddRecord As Boolean '是增加记录还是修改记录
Private mstrListTextBuffer(7) As String '暂存列表框输入值，以备新增
Private mlngListIDBuffer(7) As Long '暂存列表框选择的ID，以备修改或删除
Private mstrSQLBuffer() As String '暂时存储对数据库的增删改操作
Private mintSQLIndex As Integer 'strSQLBuffer的索引
Private mvcrVoucherType As VoucherTypeRecord '暂存读写记录的数据
Private mstrInitCode As String '暂存编码的初始值，以备判断是否修改
Private mblnIsChanged As Boolean
Private ID As Long
'进入新增凭证类型
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0) As Long
mblnAddRecord = True
frmVoucherTypeListCard.Caption = "新增凭证类型"
cmdOKCancel(2).Visible = True
mblnIsChanged = False
InitAddCard strName
cmdOKCancel(0).Default = False
cmdOKCancel(2).Default = True
If Me.WindowState = 1 Then Me.WindowState = 0
Show intModal
AddCard = ID
If intModal <> vbModal Then
Refresh
ZOrder 0
End If
End Function
'初始化暂存读写记录的数据的自定义类型变量和卡片
Private Sub InitAddCard(Optional strName As String = "")
Dim intCounter As Integer
With mvcrVoucherType
.strVoucherTypeCode = 0
.strVoucherTypeName = ""
.blnIsInActive = False
.lngDebitAccountID1 = 0
.lngDebitAccountID2 = 0
.lngCreditAccountID1 = 0
.lngCreditAccountID2 = 0
.lngVoucherAccountID1 = 0
.lngVoucherAccountID2 = 0
.lngVoucherNOAccountID1 = 0
.lngVoucherNOAccountID2 = 0
End With
mblnIsChanged = False
If txtInput(0).Text = "Text1" Or txtInput(0).Text = "" Then
txtInput(0).Text = ""
Else
txtInput(0).Text = GetNextCode(txtInput(0).Text)
mstrInitCode = txtInput(0).Text
End If
txtInput(1).Text = strName
For intCounter = 0 To 7
lstAccount(intCounter).Text = ""
mstrListTextBuffer(intCounter) = ""
mlngListIDBuffer(intCounter) = 0
Next intCounter
chkPause.Value = Unchecked
InitBuffer '清空暂时存储数据库操作的数组
End Sub
'进入修改凭证类型
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0)
mblnAddRecord = False
frmVoucherTypeListCard.Caption = "修改凭证类型"
cmdOKCancel(2).Visible = False
cmdOKCancel(2).Default = False
cmdOKCancel(0).Default = True
mblnIsChanged = False
If Not SelectRecord(lngID) Then Exit Sub '查找记录
txtInput(0).SetFocus
If Me.WindowState = 1 Then Me.WindowState = 0
Show intModal
If intModal <> vbModal Then
Refresh
ZOrder 0
End If
End Sub
'查找出想修改的凭证类型表编码记录，存放在自定义类型变量中
Private Function SelectRecord(ByVal lngRecordID As Long) As Boolean
Dim strSql As String
Dim recSelect As rdoResultset
SelectRecord = False
With mvcrVoucherType
.lngVoucherTypeID = lngRecordID
strSql = "SELECT * FROM VoucherType WHERE lngVoucherTypeID=" & .lngVoucherTypeID
Set recSelect = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
If recSelect.EOF Then
ShowMsg 0, "当前修改的凭证类型不存在，不能修改！", _
vbExclamation + MB_TASKMODAL, Me.Caption
Unload Me
Exit Function
End If
.strVoucherTypeName = recSelect!strVoucherTypeName
.strVoucherTypeCode = recSelect!strVoucherTypeCode
.blnIsInActive = recSelect!blnIsInActive
.lngDebitAccountID1 = recSelect!lngDebitAccountID1
.lngDebitAccountID2 = recSelect!lngDebitAccountID2
.lngCreditAccountID1 = recSelect!lngCreditAccountID1
.lngCreditAccountID2 = recSelect!lngCreditAccountID2
.lngVoucherAccountID1 = recSelect!lngVoucherAccountID1
.lngVoucherAccountID2 = recSelect!lngVoucherAccountID2
.lngVoucherNOAccountID1 = recSelect!lngVoucherNOAccountID1
.lngVoucherNOAccountID2 = recSelect!lngVoucherNOAccountID2
txtInput(0).Text = .strVoucherTypeCode
txtInput(1).Text = .strVoucherTypeName
selectListName 0, recSelect!lngDebitAccountID1
selectListName 1, recSelect!lngDebitAccountID2
selectListName 2, recSelect!lngCreditAccountID1
selectListName 3, recSelect!lngCreditAccountID2
selectListName 4, recSelect!lngVoucherAccountID1
selectListName 5, recSelect!lngVoucherAccountID2
selectListName 6, recSelect!lngVoucherNOAccountID1
selectListName 7, recSelect!lngVoucherNOAccountID2
If recSelect!blnIsInActive = 1 Then
chkPause.Value = Checked
Else
chkPause.Value = Unchecked
End If
InitBuffer '清空暂时存储数据库操作的数组
recSelect.Close
End With
SelectRecord = True
End Function
Private Sub selectListName(Index As Integer, lngID As Long)
Dim strSql As String
Dim recSetting As rdoResultset
strSql = "SELECT straccountcode,strAccountName FROM Account WHERE lngAccountID=" & lngID
Set recSetting = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
If Not recSetting.EOF Then
setlistbox lstAccount(Index), Index
End If
recSetting.Close
End Sub
'进入删除凭证类型表，判断记录是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngID As Long) As Boolean
Dim strSql As String
Dim recSelect As rdoResultset
Dim intMsgReturn As Integer
Dim blnSQLExec As Boolean
DelCard = False
strSql = "SELECT * FROM VoucherType WHERE lngVoucherTypeID=" & lngID
Set recSelect = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
If recSelect.EOF Then
recSelect.Close
Exit Function
End If
If frmVoucherTypeList.IsShowCard = True Then
If lngID = frmVoucherTypeListCard.VoucherTypeID Then
ShowMsg 0, "不能删除当前正在修改的凭证类型！", _
vbExclamation + MB_TASKMODAL, "删除凭证类型"
frmVoucherTypeListCard.Show
Exit Function
End If
End If
If CodeUsed(lngID) Then
intMsgReturn = ShowMsg(0, "其它地方正在使用此凭证类型，不能删除！", _
vbExclamation + MB_TASKMODAL, "删除凭证类型")
Else
intMsgReturn = ShowMsg(0, "你确实要删除“" & recSelect!strVoucherTypeName & "”凭证类型吗？", _
vbQuestion + vbOKCancel + MB_SYSTEMMODAL, "删除凭证类型")
If intMsgReturn = vbOK Then
strSql = "DELETE FROM VoucherType WHERE lngVoucherTypeID = " & lngID
blnSQLExec = gclsBase.ExecSQL(strSql)
If blnSQLExec Then
gclsSys.SendMessage CStr(Me.hwnd), Message.msgVoucherType
End If
End If
End If
DelCard = blnSQLExec
recSelect.Close
End Function
'判断记录是否被使用（可能有多张表会使用此编码）
Private Function CodeUsed(lngID As Long) As Boolean
CodeUsed = True
If CheckIDUsed("Voucher", "lngVoucherTypeID", lngID) Then Exit Function
If CheckIDUsed("TransVoucher", "lngvouchertypeid", lngID) Then Exit Function
CodeUsed = False
End Function
Private Sub chkPause_Click()
mblnIsChanged = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -