+
资源名称:ERPSYS.zip [点击查看]
上传用户:zhpu1995
上传日期:2013-09-06
资源大小:61151k
文件大小:27k
源码类别:
企业管理
开发平台:
Visual Basic
- VERSION 5.00
- Begin VB.Form JC_FrmBaseAcc
- Appearance = 0 'Flat
- Caption = "基本科目设置"
- ClientHeight = 3780
- ClientLeft = 60
- ClientTop = 345
- ClientWidth = 7425
- HelpContextID = 2001
- Icon = "基础设置_基本科目设置.frx":0000
- KeyPreview = -1 'True
- LinkTopic = "Form2"
- MaxButton = 0 'False
- MinButton = 0 'False
- ScaleHeight = 3780
- ScaleWidth = 7425
- StartUpPosition = 2 'CenterScreen
- Begin VB.CommandButton QxCommand
- Cancel = -1 'True
- Caption = "取消(&C)"
- Height = 300
- Left = 6030
- TabIndex = 14
- Top = 3210
- Width = 1120
- End
- Begin VB.CommandButton BcCommand
- Caption = "保存(&S)"
- Height = 300
- Left = 4830
- TabIndex = 13
- Top = 3210
- Width = 1120
- End
- Begin VB.Frame Frame1
- Height = 3660
- Left = 60
- TabIndex = 15
- Top = 30
- Width = 7305
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 12
- Left = 6810
- Picture = "基础设置_基本科目设置.frx":1042
- Style = 1 'Graphical
- TabIndex = 41
- Top = 2670
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 12
- Left = 5160
- TabIndex = 12
- Text = "12"
- Top = 2670
- Width = 1650
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 11
- Left = 6810
- Picture = "基础设置_基本科目设置.frx":13CC
- Style = 1 'Graphical
- TabIndex = 39
- Top = 2184
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 10
- Left = 6810
- Picture = "基础设置_基本科目设置.frx":1756
- Style = 1 'Graphical
- TabIndex = 38
- Top = 1698
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 9
- Left = 6810
- Picture = "基础设置_基本科目设置.frx":1AE0
- Style = 1 'Graphical
- TabIndex = 37
- Top = 1185
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 8
- Left = 6810
- Picture = "基础设置_基本科目设置.frx":1E6A
- Style = 1 'Graphical
- TabIndex = 36
- Top = 726
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 7
- Left = 6810
- Picture = "基础设置_基本科目设置.frx":21F4
- Style = 1 'Graphical
- TabIndex = 35
- Top = 240
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 6
- Left = 3210
- Picture = "基础设置_基本科目设置.frx":257E
- Style = 1 'Graphical
- TabIndex = 34
- Top = 3180
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 5
- Left = 3210
- Picture = "基础设置_基本科目设置.frx":2908
- Style = 1 'Graphical
- TabIndex = 33
- Top = 2670
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 4
- Left = 3210
- Picture = "基础设置_基本科目设置.frx":2C92
- Style = 1 'Graphical
- TabIndex = 32
- Top = 2184
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 3
- Left = 3210
- Picture = "基础设置_基本科目设置.frx":301C
- Style = 1 'Graphical
- TabIndex = 31
- Top = 1698
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 2
- Left = 3210
- Picture = "基础设置_基本科目设置.frx":33A6
- Style = 1 'Graphical
- TabIndex = 30
- Top = 1185
- Visible = 0 'False
- Width = 300
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 1
- Left = 3210
- Picture = "基础设置_基本科目设置.frx":3730
- Style = 1 'Graphical
- TabIndex = 29
- Top = 726
- Visible = 0 'False
- Width = 300
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 11
- Left = 5160
- TabIndex = 11
- Text = "11"
- Top = 2184
- Width = 1650
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 10
- Left = 5160
- TabIndex = 10
- Text = "10"
- Top = 1698
- Width = 1650
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 9
- Left = 5160
- TabIndex = 9
- Text = "9"
- Top = 1185
- Width = 1650
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 8
- Left = 5160
- TabIndex = 8
- Text = "8"
- Top = 726
- Width = 1650
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 7
- Left = 5160
- TabIndex = 7
- Text = "7"
- Top = 240
- Width = 1650
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 6
- Left = 1560
- TabIndex = 6
- Text = "6"
- Top = 3180
- Width = 1650
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 5
- Left = 1560
- TabIndex = 5
- Text = "5"
- Top = 2670
- Width = 1650
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 4
- Left = 1560
- TabIndex = 4
- Text = "4"
- Top = 2184
- Width = 1650
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 3
- Left = 1560
- TabIndex = 3
- Text = "3"
- Top = 1698
- Width = 1650
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 2
- Left = 1560
- TabIndex = 2
- Text = "2"
- Top = 1185
- Width = 1650
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 0
- Left = 1560
- TabIndex = 0
- Text = "0"
- Top = 240
- Width = 1650
- End
- Begin VB.TextBox LrText
- Height = 300
- Index = 1
- Left = 1560
- TabIndex = 1
- Text = "1"
- Top = 726
- Width = 1650
- End
- Begin VB.CommandButton Ydcommand1
- Height = 300
- Index = 0
- Left = 3210
- Picture = "基础设置_基本科目设置.frx":3ABA
- Style = 1 'Graphical
- TabIndex = 16
- Top = 240
- Visible = 0 'False
- Width = 300
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "坏帐准备科目:"
- Height = 180
- Index = 12
- Left = 3900
- TabIndex = 40
- Tag = "AR_BadDebtPrepAccCode"
- Top = 2730
- Width = 1170
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "坏帐损失科目:"
- Height = 180
- Index = 11
- Left = 3900
- TabIndex = 28
- Tag = "AR_BadDebtAccCode"
- Top = 2244
- Width = 1170
- End
- Begin VB.Label TsLabel
- Caption = "应收票据科目(银行承兑):"
- Height = 405
- Index = 10
- Left = 3900
- TabIndex = 27
- Tag = "AR_BankNoteAccCode"
- Top = 1698
- Width = 1215
- End
- Begin VB.Label TsLabel
- Caption = "应收票据科目(商业承兑):"
- Height = 405
- Index = 9
- Left = 3900
- TabIndex = 26
- Tag = "AR_CommNoteAccCode"
- Top = 1185
- Width = 1215
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "票据费用科目:"
- Height = 180
- Index = 8
- Left = 3900
- TabIndex = 25
- Tag = "AR_NoteFareAccCode"
- Top = 786
- Width = 1170
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "票据利息科目:"
- Height = 180
- Index = 7
- Left = 3900
- TabIndex = 24
- Tag = "AR_NoteIntAccCode"
- Top = 300
- Width = 1170
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "现金折扣科目:"
- Height = 180
- Index = 6
- Left = 180
- TabIndex = 23
- Tag = "AR_CashDisAccCode"
- Top = 3240
- Width = 1170
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "应交增值税科目:"
- Height = 180
- Index = 5
- Left = 180
- TabIndex = 22
- Tag = "AR_SellTaxAccCode"
- Top = 2730
- Width = 1350
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "销售收入科目:"
- Height = 180
- Index = 4
- Left = 180
- TabIndex = 21
- Tag = "AR_SellAccCode"
- Top = 2244
- Width = 1170
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "预收帐款科目:"
- Height = 180
- Index = 3
- Left = 180
- TabIndex = 20
- Tag = "AR_PrAccCode"
- Top = 1758
- Width = 1170
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "代垫费用科目:"
- Height = 180
- Index = 2
- Left = 180
- TabIndex = 19
- Tag = "AR_FareAccCode"
- Top = 1245
- Width = 1170
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "常用收款科目:"
- Height = 180
- Index = 0
- Left = 180
- TabIndex = 18
- Tag = "AR_RrAccCode"
- Top = 300
- Width = 1170
- End
- Begin VB.Label TsLabel
- AutoSize = -1 'True
- Caption = "应收帐款科目:"
- Height = 180
- Index = 1
- Left = 180
- TabIndex = 17
- Tag = "AR_ArAccCode"
- Top = 780
- Width = 1170
- End
- End
- End
- Attribute VB_Name = "JC_FrmBaseAcc"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- '*************************************************************
- '* 模 块 名 称 :基本科目设置
- '* 功 能 描 述 :基本科目是在核算应收款项时经常用到的科目,可以
- '* 在此处设置常用科目。所录入科目必须是最明细科目。
- '* 程序员姓名 :张建忠
- '* 最后修改人 :张建忠
- '* 最后修改时间:2002/01/23
- '* 备 注:
- '*************************************************************
- Dim jdzygs As Integer '控件焦点转移个数
- Dim Tsxx As String '系统提示信息
- '以下为固定使用变量(文本框)
- Dim Textvar() As Variant '存储变体型文本框信息
- Dim Textboolean() As Boolean '存储布尔型文本框信息
- Dim Textint() As Integer '存储整型文本框信息
- Dim Textstr() As String '存储字符型文本框信息
- Dim Max_Text_Index As Integer '最大录入文本框索引值
- Dim TextGroupCode As String '文本框录入分组编码
- Dim TextValiLock As Boolean '文本框失去焦点是否进行有效性控制判断
- Dim TextValiJudgeLock() As Boolean '文本框录入有效性判断控制锁
- Dim CurTextIndex As Integer '当前文本框索引值
- Dim TextChangeLock As Boolean '文本框内容变换控制锁
- Dim Bln_Cancel As Boolean '取消按钮信息传递
- Private Sub Form_KeyPress(KeyAscii As Integer) '控 制 焦 点 转 移
- jdzygs = 14
- Select Case KeyAscii
- Case vbKeyReturn
- If Kjjdzy(jdzygs) Then
- KeyAscii = 0
- End If
- Case 39 '屏蔽"'"
- KeyAscii = 0
- End Select
- End Sub
- Private Sub Form_Load()
- '以下为文本框处理程序
- TextGroupCode = "Ar_BaseAcc"
- Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr()) '读入文本框录入信息
- Call Wbkcsh
- '填充各项内容
- Call Cxnrtcwg
- '判断用户是否有此功能执行权限,如有则写上机日志(进入)
- If Not Security_Log("Ar_BaseAcc_Edit", Xtczybm, 1, True, False) Then
- BcCommand.Enabled = False
- End If
- End Sub
- Private Sub Cxnrtcwg() '填充各项内容
- Dim Sqlstr As String '临时查询字符串
- Dim RecTemp As ADODB.Recordset
- Dim jsqte As Integer
- For jsqte = 0 To Max_Text_Index
- If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
- TextChangeLock = True
- Sqlstr = "Select Ccode From RP_InputCode Where ItemCode='" & TsLabel(jsqte).Tag & "'"
- Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- If Not RecTemp.EOF Then
- LrText(jsqte).Text = Trim(RecTemp.Fields("Ccode") & "")
- End If
- TextChangeLock = False
- End If
- Next jsqte
- End Sub
- Private Function Bclrsj() As Boolean '判断录入数据有效性,并保存数据
- Dim jsqte As Integer
- '对文本框录入内容进行为零和为空判断(固定不变)
- With Rec_CodeSet
- For jsqte = 0 To Max_Text_Index
- If Textint(jsqte, 8) = 1 Then '字段不能为空
- If Len(Trim(LrText(jsqte).Text)) = 0 Then
- Tsxx = Textstr(jsqte, 7) & "不能为空!"
- Call Xtxxts(Tsxx, 0, 1)
- LrText(jsqte).SetFocus
- Bclrsj = False
- Exit Function
- End If
- Else
- If Textint(jsqte, 8) = 2 Then '字段不能为零
- If Val(Trim(LrText(jsqte).Text)) = 0 Then
- Tsxx = Textstr(jsqte, 7) & "不能为零!"
- Call Xtxxts(Tsxx, 0, 1)
- LrText(jsqte).SetFocus
- Bclrsj = False
- Exit Function
- End If
- End If
- End If
- Next jsqte
- '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
- For jsqte = 0 To Max_Text_Index
- If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
- If Not TextYxxpd(jsqte) Then
- Exit Function
- End If
- End If
- Next jsqte
- '判断记录内容无误后,将记录内容写入数据表
- On Error GoTo Swcwcl
- Cw_DataEnvi.DataConnect.BeginTrans
- For jsqte = 0 To Max_Text_Index
- If Trim(LrText(jsqte).Text) <> "" Then
- Sqlstr = "Update RP_InputCode Set Ccode='" & Trim(LrText(jsqte).Text) & "' Where ItemCode='" & TsLabel(jsqte).Tag & "'"
- Cw_DataEnvi.DataConnect.Execute (Sqlstr)
- End If
- Next jsqte
- Cw_DataEnvi.DataConnect.CommitTrans
- '保存记录成功,函数返回真值
- Bclrsj = True
- Exit Function
- End With
- Swcwcl:
- Cw_DataEnvi.DataConnect.RollbackTrans
- Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
- Call Xtxxts(Tsxx, 0, 1)
- Exit Function
- End Function
- Private Sub BcCommand_Click() '确定
- If Bclrsj Then
- Unload Me
- End If
- End Sub
- Private Sub QxCommand_Click() '取消
- Unload Me
- End Sub
- '************以下为文本框录入处理程序(固定不变部分)*************'
- Private Sub Wbklrwbcl(Index As Integer) '文本框录入事后处理程序
- '以下为依据实际情况自定义部分[
- '在此填写文本框录入事后处理程序
- ']以上为依据实际情况自定义部分
- End Sub
- Private Sub LrText_Change(Index As Integer)
- '屏蔽程序改变控制
- If TextChangeLock Then
- Exit Sub
- End If
- TextValiJudgeLock(Index) = False '打开有效性判断锁
- '限制字段录入长度
- TextChangeLock = True '加锁(防止执行Lrtext_Change)
- Call TextChangeLimit(LrText(Index), Textint(Index, 1)) '去掉无效字符
- Select Case Textint(Index, 1)
- Case 8, 11 '金额型
- Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
- Case 9, 12 '数量型
- Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
- Case 10 '单价型
- Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
- Case Else '其他小数类型控制
- If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
- Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
- End If
- End Select
- TextChangeLock = False '解锁
- End Sub
- Private Sub LrText_GotFocus(Index As Integer) '文本框得到焦点,显示相应信息
- Call TextShow(Index)
- CurTextIndex = Index
- LrText(Index).SelStart = Len(LrText(Index))
- End Sub
- Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer) '字段按F2键提供帮助
- Select Case KeyCode
- Case vbKeyF2
- Call Text_Help(Index)
- End Select
- End Sub
- Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer) '文本框录入事中控制
- Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
- End Sub
- Private Sub LrText_LostFocus(Index As Integer) '文本框失去焦点
- '显示相应信息但不能进行有效性判断
- End Sub
- Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) '按钮提供帮助
- Call Text_Help(Index)
- End Sub
- Private Sub Text_Help(Index As Integer) '录入字段帮助
- If Not Textboolean(Index, 1) Then
- Exit Sub
- End If
- '调用帮助
- Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
- '根据设置选择显示编码和名称,并进行存储
- If Len(Xtfhcs) <> 0 Then
- If Textint(Index, 3) = 1 Then
- LrText(Index).Text = Xtfhcsfz
- LrText(Index).Tag = Xtfhcs
- Else
- LrText(Index).Text = Xtfhcs
- LrText(Index).Tag = Xtfhcsfz
- End If
- End If
- LrText(Index).SetFocus
- End Sub
- Private Sub TextShow(Index As Integer) '文本框得到焦点,显示相应信息
- '填写文本框得到焦点,进行相应信息处理程序
- End Sub
- Private Sub Wbkcsh() '录入文本框初始化
- Dim jsqte As Integer
- '最大录入文本框索引值
- Max_Text_Index = Textvar(1)
- ReDim TextValiJudgeLock(Max_Text_Index)
- For jsqte = 0 To Max_Text_Index
- If Len(Trim(Textstr(jsqte, 1))) <> 0 Then
- If Textboolean(jsqte, 1) Then
- If jsqte <> 0 And Not Textboolean(jsqte, 3) Then
- Load Ydcommand1(jsqte)
- End If
- Ydcommand1(jsqte).Visible = True
- Ydcommand1(jsqte).Move LrText(jsqte).Left + LrText(jsqte).Width, LrText(jsqte).Top
- End If
- TextChangeLock = True
- LrText(jsqte).Text = ""
- LrText(jsqte).Tag = ""
- If Textint(jsqte, 5) <> 0 Then
- LrText(jsqte).MaxLength = Textint(jsqte, 5)
- End If
- TextChangeLock = False
- End If
- TextValiJudgeLock(jsqte) = True
- Next jsqte
- End Sub
- Private Function TextYxxpd(Index As Integer) As Boolean '文本框有效性判断
- Dim Sqlstr As String
- Dim Findrec As ADODB.Recordset
- '文本框内容未曾改变不进行有效性判断
- If TextValiJudgeLock(Index) Then
- TextYxxpd = True
- Exit Function
- End If
- '文本框内容为空认为有效,并清空其Tag值
- If Trim(LrText(Index)) = "" Then
- LrText(Index).Tag = ""
- Call Wbklrwbcl(Index)
- TextValiJudgeLock(Index) = True
- TextYxxpd = True
- Exit Function
- End If
- '可在此加入不做有效性判断的理由
- Select Case Textint(Index, 4)
- Case 1 '编码型
- Sqlstr = Trim(Textstr(Index, 5))
- Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
- Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
- If Findrec.EOF Then
- Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
- LrText(Index).SetFocus
- Exit Function
- Else
- Select Case Textint(Index, 3)
- Case 0
- If Len(Trim(Textstr(Index, 2))) <> 0 Then
- LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
- End If
- If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
- LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
- End If
- Case 1
- If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
- LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
- End If
- If Len(Trim(Textstr(Index, 2))) <> 0 Then
- LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
- End If
- End Select
- End If
- Case 2 '日期型
- If IsDate(LrText(Index).Text) Then
- LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
- If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
- LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
- End If
- Else
- Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
- Call Xtxxts(Tsxx, 0, 1)
- LrText(Index).SetFocus
- Exit Function
- End If
- Case 3 '其他类型
- End Select
- '如果有效则加锁,用户不改变内容则不再进行有效性判断
- TextValiJudgeLock(Index) = True
- '调用文本框事后处理程序
- Call Wbklrwbcl(Index)
- '有效性判断通过则返回True
- TextYxxpd = True
- End Function