来自「VB开发的ERP系统」· 代码 · 共 1,519 行 · 第 1/5 页

                    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")
        Else
            Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(Index).SetFocus
            Exit Function
        End If
    Case 3      '其他类型
        If Index = 0 Then
            Sqlstr = "select * from Cwzz_AccCode where CCode='" & Trim(LrText(Index)) & "'"
            Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Findrec.EOF = True Then
                Tsxx = "该科目不存在！"
                GoTo Error1
            End If
            If Trim(Findrec.Fields("StopUse") & "") = True Then
                Tsxx = "该科目已停用！"
                GoTo Error1
            End If
        End If
        If Index = 1 Then
            Sqlstr = "select * from Cwzz_AccCode where ccode='" & Trim(LrText(Index)) & "'"
            Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Findrec.EOF = True Then
                Tsxx = "该科目不存在！"
                GoTo Error1
            End If
            If Trim(Findrec.Fields("EndFlag") & "") <> True Then
                Tsxx = "应填写末级科目！"
                GoTo Error1
            End If
            If Trim(Findrec.Fields("StopUse") & "") = True Then
                Tsxx = "该科目已停用！"
                GoTo Error1
            End If
        End If
        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 Select
    TextValiJudgeLock(Index) = True
    TextYxxpd = True
    Exit Function
Error1:
    Call Xtxxts(Tsxx, 0, 1)
    LrText(Index).SetFocus
    TextYxxpd = False
    Exit Function
End Function

Private Sub WbklrCl_After(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)
    Select Case Textint(Index, 1)
    Case 8           '金额型
        Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
    Case 9           '数量型
        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)                                                '文本框失去焦点进行有效性判断及相应处理
    If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
        Call TextYxxpd(Index)
    End If
End Sub

Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
    If Not Textboolean(Index, 1) Then
        Exit Sub
    End If
    TextValiJudgeLock(Index) = True
    
    '先进行有效性判断
    If Not TextYxxpd(CurTextIndex) 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
    TextValiJudgeLock(Index) = False
    LrText(Index).SetFocus
End Sub

Public Sub Fill_Relation()
    Dim sqlstr1 As String   '临时字符串
    If LrText(0) = "" Then
        Tsxx = "请输入损益科目！"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(0).SetFocus
        Exit Sub
    End If
    If LrText(1) = "" Then
        Tsxx = "请输入本年利润科目！"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(1).SetFocus
        Exit Sub
    End If
    If LrText(2) = "" Then
        Tsxx = "请输入摘要信息！"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(2).SetFocus
        Exit Sub
    End If
    
    '转帐科目（损益科目）记录集
    Sqlstr = "select * from Cwzz_AccCode where Ccode like '" & Trim(LrText(0).Text) & "%' and EndFlag='1' and StopFlag<>'1'"
    Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Cxnrrec.EOF = True Then
        Tsxx = "重新选择损益类科目编码!"
        Call Xtxxts(Tsxx, 1, 1)
        Exit Sub
    End If
    
    '本年利润科目记录集
    sqlstr1 = "select * from Cwzz_AccCode where Ccode='" & Trim(LrText(1).Text) & "' and EndFlag='1' and StopFlag<>'1'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(sqlstr1)
    If RecTemp.EOF = True Then
        Tsxx = "重新选择利润科目编码!"
        Call Xtxxts(Tsxx, 1, 1)
        Exit Sub
    End If
    With Cxnrrec
        WglrGrid.Clear 1
        If .EOF And .BOF Then
            Exit Sub
        End If
        Jsqte = WglrGrid.FixedRows
        Do While Not .EOF
            If Jsqte >= WglrGrid.Rows Then
                WglrGrid.AddItem ""
            End If
            WglrGrid.TextMatrix(Jsqte, 0) = "*"
            WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = LrText(2)
            
            WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("CCode"))
            WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("CName"))
            If CmbOut_In.Text = "收入" Then
                WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = "借"
            Else
                WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = "贷"
            End If
            
            WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = RecTemp.Fields("Ccode") & ""
            WglrGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = RecTemp.Fields("Cname") & ""
            WglrGrid.RowHeight(Jsqte) = Sjhgd
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
    '修改]
End Sub

Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
    If Textboolean(Index, 1) Then
        Ydcommand1.Visible = True
        Ydcommand1.Move LrText(Index).Left + LrText(Index).Width, LrText(Index).Top
        Ydcommand1.Tag = Index
    Else
        Ydcommand1.Tag = ""
        Ydcommand1.Visible = False
    End If
End Sub

Private Sub Ydcommand1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call Text_Help(Ydcommand1.Tag)
End Sub

Public Sub Bill_Head_Show()             '填充窗体的网格之上文本框等内容
    Dim rs_temp1 As New ADODB.Recordset      '临时记录集
    Dim rs_temp2 As New ADODB.Recordset      '临时记录集
    
    '取损益科目的数据
    Sqlstr = "SELECT Cwzz_AutoTranItem.TranClass, Cwzz_AutoTranItem.TranCode, " & _
    "Cwzz_AutoTranItem.TranOri,Cwzz_AutoTranItem.Ccode,Cwzz_AutoTranItem.Digest, " & _
    "Cwzz_AutoTranItem.GetCcode,Cwzz_AutoTranItem.FormulaCode " & _
    "FROM Cwzz_AutoTranMain RIGHT OUTER JOIN Cwzz_AutoTranItem ON " & _
    "Cwzz_AutoTranMain.TranCode = Cwzz_AutoTranItem.TranCode AND " & _
    "Cwzz_AutoTranMain.TranClass = Cwzz_AutoTranItem.TranClass " & _
    "where Cwzz_AutoTranItem.TranCode='" & Lbl_AutoAccCode.Caption & "' " & _
    "and Cwzz_AutoTranItem.tranclass='" & TranClassCode & "'" & _
    "and Cwzz_AutoTranItem.FormulaCode<>'05' order by Cwzz_AutoTranItem.Ccode"
    Set Rec_AutoAccItem = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Rec_AutoAccItem.Fields("TranOri") = "借" Then
        CmbOut_In.Text = "收入"
    Else
        CmbOut_In.Text = "支出"
    End If
    LrText(2).Text = Rec_AutoAccItem.Fields("Digest")
    '转帐科目编码
    If Rec_AutoAccItem.Fields("Ccode") & "" <> "" Then
        Sqlstr = "Select * from Cwzz_AccCode where Ccode='" & Trim(Rec_AutoAccItem.Fields("Ccode") & "") & "' order by Ccode"
        Set rs_temp1 = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If rs_temp1.EOF = False Then
            LrText(0).Text = Trim(rs_temp1.Fields("ParentCode") & "")
        Else
            LrText(0).Text = ""
        End If
    End If
    
    '取本年利润的数据
    Sqlstr = "SELECT Cwzz_AutoTranItem.TranClass, Cwzz_AutoTranItem.TranCode, " & _
    "Cwzz_AutoTranItem.TranOri,Cwzz_AutoTranItem.Ccode,Cwzz_AutoTranItem.Digest, " & _
    "Cwzz_AutoTranItem.GetCcode " & _
    "FROM Cwzz_AutoTranMain RIGHT OUTER JOIN Cwzz_AutoTranItem ON " & _
    "Cwzz_AutoTranMain.TranCode = Cwzz_AutoTranItem.TranCode AND " & _
    "Cwzz_AutoTranMain.TranClass = Cwzz_AutoTranItem.TranClass " & _
    "where Cwzz_AutoTranItem.TranCode='" & Lbl_AutoAccCode.Caption & "' " & _
    "and Cwzz_AutoTranItem.tranclass='" & TranClassCode & "'" & _
    "and Cwzz_AutoTranItem.FormulaCode='05'"
    Set Rec_AutoAccItem = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Trim(Rec_AutoAccItem.Fields("Ccode") & "") <> "" Then
        Sqlstr = "select * from Cwzz_AccCode where Ccode='" & Trim(Rec_AutoAccItem.Fields("Ccode") & "") & "' "
        Set rs_temp2 = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If rs_temp2.EOF = False Then
            LrText(1).Text = Trim(rs_temp2.Fields("CCode") & "")
            Lab_GetName.Caption = Trim(rs_temp2.Fields("CName") & "")           '为下一步网格内显示用
        Else
            LrText(1).Text = ""
        End If
    End If
End Sub