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

        KeyAscii = 0
    End Select
    
End Sub

Private Sub Form_Load()
    
    '确定转帐过程编码
    Call SeleTranBm
    
    '窗体的Caption
    Me.Caption = ReportTitle
    Me.Left = (Screen.Width - Me.Width) / 2
    Me.Top = (Screen.Height - Me.Height) / 2
    
    '报表主标题及报表编码
    ReportTitle = "转帐凭证列表"
    XtReportCode = "cwzz_AutoAccList"
    Load Dyymctbl
    
    '以下为文本框处理程序
    TextGroupCode = "cwzz_AutoAccL"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
    Call Wbkcsh
    
    '调 入 网 格
    GridCode = "cwzz_AutoAccList"          '网格属性编码
    Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Szzls = CzxsGrid.Cols - 1
    
    '填 充 网 格
    Call Cxnrtcwg
    
    '初始化toolbar,tab卡状态
    StTab.Tab = 0
    StTab.TabEnabled(1) = False
    Frame1.Enabled = False
    Lrzt = 0            '初始为非编辑状态
    
    '[自定义
    
    Chk_Vouch.Value = vbChecked
    
    '填充凭证类型下拉框
    Call FillImageCombo(ImgCmbClass, "Cwzz_AccVouchClass", 2)
    
    '填充会计期间列表框(年度默认为用户选择年度)
    Call Sub_FillPeriod(Combo_Kjqj, Xtyear, Xtmm)
    
    '自定义]
End Sub

Private Sub Cxnrtcwg()                               '查询内容填充网格
    
    Sqlstr = "SELECT Cwzz_VouchClass.VouchClassName AS VouchClassName, Cwzz_AutoTranMain.TranClass, " & _
    "Cwzz_AutoTranMain.TranCode, Cwzz_AutoTranMain.TranName," & _
    "Cwzz_AutoTranMain.VouchClassCode, Cwzz_AutoTranMain.EndTranDate," & _
    "Cwzz_AutoTranMain.Bill FROM Cwzz_AutoTranMain LEFT OUTER JOIN " & _
    "Cwzz_VouchClass ON " & _
    "Cwzz_AutoTranMain.VouchClassCode = Cwzz_VouchClass.VouchClassCode " & _
    "Where Cwzz_AutoTranMain.TranClass='" & TranClassCode & "' ORDER BY Cwzz_AutoTranMain.TranCode"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        CzxsGrid.Clear 1
        CzxsGrid.Rows = .RecordCount + CzxsGrid.FixedRows
        If .EOF And .BOF Then
            Exit Sub
        End If
        Jsqte = CzxsGrid.FixedRows
        Do While Not .EOF
            If Jsqte >= CzxsGrid.Rows Then
                CzxsGrid.AddItem ""
            End If
            Call Jltcwg(RecTemp, Jsqte)
            CzxsGrid.RowHeight(Jsqte) = Sjhgd
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
    
End Sub

Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)                                     '记录内容填充网格
    
    With Jlbrec
        CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("TranCode"))
        CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("TranName"))
        CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(Trim(.Fields("VouchClassCode")) & " " & Trim(.Fields("VouchClassName")))
        CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Bill") & "")
        CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = IIf(Trim(.Fields("EndTranDate") & "") = "", "", Format(Trim(.Fields("EndTranDate") & ""), "yyyy-mm-dd"))
    End With
    
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   '如果文本框索引值不为0，即不是“编码”文本框
            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   '如果字段录入长度不等于0
                LrText(Jsqte).MaxLength = Textint(Jsqte, 5)  '该文本框的最大录入长度赋值给文本框的MaxLength
            End If
            TextChangeLock = False
        End If
        TextValiJudgeLock(Jsqte) = True
    Next Jsqte
    
End Sub

Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
    
    TranClassCode = ""
    Set Cxnrrec = Nothing
    Unload Dyymctbl
    Set Rec_AutoTranMain = Nothing
    Set Rec_AutoTranItem = Nothing
    Set RecTemp = Nothing
    
End Sub

Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
    
    Dim Jsqte As Integer
    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
    
    If ImgCmbClass.Text = "" Then
        Tsxx = tsLabel(2).Caption & "不能为空!"
        Call Xtxxts(Tsxx, 0, 1)
        ImgCmbClass.SetFocus
        Bclrsj = False
        Exit Function
    Else
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select * from Cwzz_VouchClass Where VouchClassCode='" & Trim(GetComboKey(ImgCmbClass, 0)) & "'")
    End If
    
    '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
    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
    If Lrzt = 1 Then  '增 加一个新编码时
        With Rec_AutoTranMain
            If .State = 1 Then .Close
            .Open "SELECT * FROM Cwzz_AutoTranMain WHERE TranCode= '" + Trim(LrText(0).Text) + "' and TranClass='" & TranClassCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not .EOF Then
                Tsxx = "转帐编码重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(0).SetFocus
                Bclrsj = False
                Exit Function
            End If
            If .State = 1 Then .Close
            .Open "SELECT * FROM Cwzz_AutoTranMain WHERE TranName= '" + Trim(LrText(1).Text) + "' and TranClass='" & TranClassCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not .EOF Then
                Tsxx = "转帐名称重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
                Bclrsj = False
                Exit Function
            End If
            .AddNew
            .Fields("TranClass") = TranClassCode
            .Fields("TranCode") = Trim(LrText(0).Text)
            .Fields("TranName") = Trim(LrText(1).Text)
            .Fields("VouchClassCode") = Trim(GetComboKey(ImgCmbClass, 0))
            .Update
        End With
        Sqlstr = "SELECT cwzz_VouchClass.VouchClassCode,cwzz_VouchClass.VouchClassName, Cwzz_AutoTranMain.TranName, " & _
        "Cwzz_AutoTranMain.TranCode, Cwzz_AutoTranMain.VouchClassCode," & _
        "Cwzz_AutoTranMain.EndTranDate , Cwzz_AutoTranMain.Bill FROM Cwzz_AutoTranMain LEFT OUTER JOIN " & _
        "Cwzz_VouchClass ON " & _
        "Cwzz_AutoTranMain.VouchClassCode = Cwzz_VouchClass.VouchClassCode WHERE trancode = '" & Trim(LrText(0)) & "' and TranClass='" & TranClassCode & "'" & _
        "ORDER BY Cwzz_AutoTranMain.TranCode"
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        With CzxsGrid
            .AddItem ""
            .RowHeight(.Rows - 1) = Sjhgd
            .Select .Rows - 1, Qslz
            Call Jltcwg(RecTemp, .Rows - 1)
        End With
        
        Tsxx = "保存成功!"
        Call Xtxxts(Tsxx, 0, 4)
        Call Cshlrxx(1)
        LrText(0).SetFocus
    Else  '修改转帐名称或转帐类型时 修改编辑状态
        With Rec_AutoTranMain
            If .State = 1 Then .Close
            .Open "SELECT * FROM Cwzz_AutoTranMain WHERE TranName= '" + Trim(LrText(1).Text) + "' and TranCode<>'" & Trim(LrText(0).Text) & "' and TranClass='" & TranClassCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not .EOF Then
                Tsxx = "转帐名称重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
                Bclrsj = False
                Exit Function
            End If
            If .State = 1 Then .Close
            .Open "SELECT * FROM Cwzz_AutoTranMain WHERE TranCode= '" + LrText(0).Text + "' and TranClass='" & TranClassCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
            If Not .EOF Then
                .Fields("TranName") = Trim(LrText(1).Text)
                .Fields("VouchClassCode") = Trim(GetComboKey(ImgCmbClass, 0))
            End If
            .Update
            .Close
        End With
        Sqlstr = "SELECT Cwzz_VouchClass.VouchClassName, Cwzz_AutoTranMain.TranName," & _
        "Cwzz_AutoTranMain.TranCode,Cwzz_AutoTranMain.VouchClassCode, Cwzz_AutoTranMain.EndTranDate," & _
        "Cwzz_AutoTranMain.Bill    FROM Cwzz_AutoTranMain LEFT OUTER JOIN " & _
        "Cwzz_VouchClass ON  Cwzz_AutoTranMain.VouchClassCode = Cwzz_VouchClass.VouchClassCode  WHERE trancode = '" & Trim(LrText(0)) & "' and TranClass='" & TranClassCode & "'"
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If Not RecTemp.EOF Then
            Call Jltcwg(RecTemp, CzxsGrid.Row)
        End If
    End If
    Bclrsj = True
    Exit Function
    
Swcwcl:
    Tsxx = "存盘过程中出现错误,请退出后重新进入!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function
    
End Function

Private Sub Cshlrxx(lrztxx As Integer)              '初始化录入字段信息
    
    TextChangeLock = True       '关闭Chang事件
    If lrztxx = 1 Then              '新增状态
        For Jsqte = 0 To Max_Text_Index
            If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then  '文本框索引值
                TextChangeLock = True
                LrText(Jsqte).Text = ""
                LrText(Jsqte).Tag = ""
                TextChangeLock = False
            End If
            TextValiJudgeLock(Jsqte) = True
        Next Jsqte
        ImgCmbClass.Text = ""
    Else                            '其他状态，修改、非编辑
        With CzxsGrid
            LrText(0).Text = Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls)))
            LrText(1).Text = Trim(.TextMatrix(.Row, Sydz("002", GridStr(), Szzls)))
            ImgCmbClass.Text = Trim(.TextMatrix(.Row, Sydz("003", GridStr(), Szzls)))
        End With
    End If
    TextChangeLock = False
    
End Sub

Private Sub Scdqjl()                 '删 除 当 前 记 录
    
    Dim Yhanswer As Integer
    If CzxsGrid.Row < CzxsGrid.FixedRows Then
        Exit Sub
    End If
    Tsxx = "请确认是否删除当前记录?"