VB开发的ERP系统

        Sjhzyxxpd = False
        Exit Function
    End With
End Function

Private Sub Yd_Help_content()          '点击辅助核算信息列
    
    '如果单据操作状态为浏览状态则不能显示录入载体
    If Trim(Lab_OperStatus.Caption) = "1" Then Exit Sub
    
    '当科目编码处于录入状态时不能调入辅助核算项目
    If Ydtext.Visible Then Exit Sub
    
    '当焦点处于非录入区域时也不能调入辅助核算项目
    If WglrGrid.Row < WglrGrid.FixedRows Then Exit Sub
    
    If Yd_Help.Visible = False Then Exit Sub
    
    '屏蔽文本框,下拉组合框有效性判断
    Valilock = True
    
    With WglrGrid
        If Trim(.TextMatrix(.Row, Sydz("002", GridStr(), Szzls))) = "" Then
            Tsxx = "请录入转帐科目！"
            Call Xtxxts(Tsxx, 0, 1)
        Else
            Call Sub_Drfzhsx(.Row, Trim(.TextMatrix(.Row, Sydz("002", GridStr(), Szzls))))
        End If
    End With
    Valilock = False
End Sub

Private Sub Sub_Drfzhsx(Dqpdwgh As Long, Str_JudgeText As String)   '判断科目是否有辅助核算,如有则调入辅助核算窗体
    '函数参数：当前判断网格行，判断科目
    
    Dim Coljsq As Long           '临时列计数器
    Dim jsq As Integer          '记录有效辅助信息个数
    '首先进行必要输入项目的判断
    If Len(Str_JudgeText) <> 0 Then
        
        Sqlstr = "Select Cwzz_AccCode.* ,ItemClassName FROM  Cwzz_AccCode " & _
        " LEFT OUTER JOIN Cwzz_ItemClass ON Cwzz_AccCode.ItemClassCode = Cwzz_ItemClass.ItemClassCode " & _
        " Where Ccode='" + Str_JudgeText + "' and EndFlag=1 and StopFlag=0"
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        With RecTemp
            '判断科目进行哪些辅助核算
            '清空辅助核算标识
            For Jsqte = 0 To Int_AssCount - 1
                Bln_AssShow(Jsqte) = False
            Next Jsqte
            If .EOF Then
                WglrGrid.TextMatrix(Dqpdwgh, 1) = ""
                WglrGrid.TextMatrix(Dqpdwgh, 2) = ""
                WglrGrid.TextMatrix(Dqpdwgh, 3) = ""
                WglrGrid.TextMatrix(Dqpdwgh, 4) = ""
                WglrGrid.TextMatrix(Dqpdwgh, 5) = ""
                WglrGrid.TextMatrix(Dqpdwgh, 6) = ""
                WglrGrid.TextMatrix(Dqpdwgh, 7) = ""
                WglrGrid.TextMatrix(Dqpdwgh, 8) = ""
                WglrGrid.TextMatrix(Dqpdwgh, 9) = ""
                WglrGrid.TextMatrix(Dqpdwgh, 10) = ""
                WglrGrid.TextMatrix(Dqpdwgh, 11) = ""
                WglrGrid.TextMatrix(Dqpdwgh, 12) = ""
                Tsxx = "该转帐科目没有辅助核算信息"
                Call Xtxxts(Tsxx, 0, 2)
            Else
                
                '个人核算
                If RecTemp.Fields("PersonFlag") Then
                    Bln_AssShow(0) = True  '个人
                Else
                    WglrGrid.TextMatrix(Dqpdwgh, 1) = ""
                    WglrGrid.TextMatrix(Dqpdwgh, 2) = ""
                End If
                
                '部门核算
                If RecTemp.Fields("DeptFlag") Then
                    Bln_AssShow(1) = True  '部门
                Else
                    WglrGrid.TextMatrix(Dqpdwgh, 3) = ""
                    WglrGrid.TextMatrix(Dqpdwgh, 4) = ""
                End If
                
                '客户核算
                If RecTemp.Fields("CusFlag") Then
                    Bln_AssShow(3) = True                                                     '客户是否需要帮助的标志
                Else
                    WglrGrid.TextMatrix(Dqpdwgh, 5) = ""
                    WglrGrid.TextMatrix(Dqpdwgh, 6) = ""
                End If
                '供应商核算
                If RecTemp.Fields("SupplierFlag") Then
                    Bln_AssShow(4) = True                                                     '供应商是否需要帮助的标志
                Else
                    WglrGrid.TextMatrix(Dqpdwgh, 7) = ""
                    WglrGrid.TextMatrix(Dqpdwgh, 8) = ""
                End If
                '项目核算
                If RecTemp.Fields("ItemFlag") Then
                    If WglrGrid.TextMatrix(Dqpdwgh, 9) <> Trim(.Fields("ItemClassCode")) Then '项目类别编码与数据表中不符
                        WglrGrid.TextMatrix(Dqpdwgh, 9) = ""                                   '项目类别编码、名称、项目编码、名称均为空
                        WglrGrid.TextMatrix(Dqpdwgh, 10) = ""
                        WglrGrid.TextMatrix(Dqpdwgh, 11) = ""
                        WglrGrid.TextMatrix(Dqpdwgh, 12) = ""
                    Else
                        WglrGrid.TextMatrix(Dqpdwgh, 9) = Trim(.Fields("ItemClassCode")) '项目类别编码
                        WglrGrid.TextMatrix(Dqpdwgh, 10) = Trim(.Fields("ItemClassName")) '项目类别名称
                        Bln_AssShow(2) = True                                              '项目是否需要帮助的标志
                    End If
                Else
                    WglrGrid.TextMatrix(Dqpdwgh, 9) = ""
                    WglrGrid.TextMatrix(Dqpdwgh, 10) = ""
                    WglrGrid.TextMatrix(Dqpdwgh, 11) = ""
                    WglrGrid.TextMatrix(Dqpdwgh, 12) = ""
                End If
                '是否存在帮助信息
                jsq = 0
                For Jsqte = 0 To Int_AssCount - 1
                    If Bln_AssShow(Jsqte) = True Then
                        jsq = jsq + 1
                    End If
                Next Jsqte
                If jsq <> 0 Then
                    '调入科目辅助核算项目
                    For Jsqte = 0 To Int_AssCount - 1
                        If Bln_AssShow(Jsqte) Then
                            PZ_FrmAss.lab_GridRow = Dqpdwgh
                            Call Kmfzhsx(Dqpdwgh)
                        End If
                    Next Jsqte
                End If
            End If
            '重新显示辅助核算信息
            Call Sub_ShowMemo(WglrGrid.Row)
            WglrGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Str_Memo
            
        End With
    End If
End Sub

Private Sub Kmfzhsx(Lng_GridRow As Long)                  '调用科目辅助核算项
    '过程函数;Lng_gridrow当前网格调入辅助核算行
    Dim Kjqstop#, Kjqsleft#, Kjjg#, Ctzxgd#, Kjxsgs%
    Kjqstop = 300          '控件显示起始高度
    Kjqsleft = 300         '控件显示起始左边界
    Kjjg = 450             '控件显示间隔
    Kjxsgs = 0             '控件显示个数
    Ctzxgd = 1500          '窗体显示最小高度
    With AutoTran_AssCus          '辅助核算项目窗体
        For Jsqte = 0 To Int_AssCount - 1
            If Bln_AssShow(Jsqte) Then
                .tsLabel(Jsqte).Visible = True
                .tsLabel(Jsqte).Move Kjqsleft, Kjqstop + Kjxsgs * Kjjg
                .LrText(Jsqte).Visible = True
                .LrText(Jsqte).Move .tsLabel(Jsqte).Left + .tsLabel(Jsqte).Width + 50, .tsLabel(Jsqte).Top - 100
                If Bln_AssHelp(Jsqte) Then
                    .Ydcommand1(Jsqte).Visible = True
                    .Ydcommand1(Jsqte).Move .LrText(Jsqte).Left + .LrText(Jsqte).Width, .LrText(Jsqte).Top, .Ydcommand1(Jsqte).Width, .LrText(Jsqte).Height
                End If
                Kjxsgs = Kjxsgs + 1
                Select Case Jsqte
                Case 0     '个人
                    .LrText(Jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 1))
                    .LrText(Jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 2))
                Case 1     '部门
                    .LrText(Jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 3))
                    .LrText(Jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 4))
                Case 3     '客户
                    .LrText(Jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 5))
                    .LrText(Jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 6))
                Case 4     '供应商
                    .LrText(Jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 7))
                    .LrText(Jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 8))
                Case 2     '项目
                    .Lab_ItemClass.Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 9))
                    .Lab_ItemClass.Caption = "(" + Trim(WglrGrid.TextMatrix(Lng_GridRow, 10)) + ")"
                    .Lab_ItemClass.Move .LrText(Jsqte).Left + .LrText(Jsqte).Width + 400, .LrText(Jsqte).Top + 100
                    .LrText(Jsqte).Tag = Trim(WglrGrid.TextMatrix(Lng_GridRow, 11))
                    .LrText(Jsqte).Text = Trim(WglrGrid.TextMatrix(Lng_GridRow, 12))
                End Select
            Else
                .tsLabel(Jsqte).Visible = False
                .LrText(Jsqte).Visible = False
                If Bln_AssHelp(Jsqte) Then
                    .Ydcommand1(Jsqte).Visible = False
                End If
            End If
        Next Jsqte
        If Kjqstop * 3 + Kjxsgs * Kjjg > Ctzxgd Then
            .Height = Kjqstop * 3 + Kjxsgs * Kjjg
        Else
            .Height = Ctzxgd
        End If
        '加锁
        changelock = True
        .Show 1
        changelock = False
    End With
End Sub

Private Sub Sub_ShowMemo(Lng_GridRow)                                    '显示网格备注项
    '函数参数:网格行
    
    Str_Memo = ""
    With WglrGrid
        If Len(Trim(.TextMatrix(Lng_GridRow, 1))) <> 0 Then
            Str_Memo = Str_Memo + Trim(.TextMatrix(Lng_GridRow, 2)) + Space(2)
        End If
        If Len(Trim(.TextMatrix(Lng_GridRow, 3))) <> 0 Then
            Str_Memo = Str_Memo + Trim(.TextMatrix(Lng_GridRow, 4)) + Space(2)
        End If
        If Len(Trim(.TextMatrix(Lng_GridRow, 5))) <> 0 Then
            Str_Memo = Str_Memo + Trim(.TextMatrix(Lng_GridRow, 6)) + Space(2)
        End If
        If Val(.TextMatrix(Lng_GridRow, 7)) <> 0 Then
            Str_Memo = Str_Memo + Trim(.TextMatrix(Lng_GridRow, 8)) + Space(2)
        End If
        
        If Len(Trim(.TextMatrix(Lng_GridRow, 11))) <> 0 Then
            Str_Memo = Str_Memo + Trim(.TextMatrix(Lng_GridRow, 12)) + Space(2)
        End If
        
        
    End With
    
End Sub

Private Sub Sub_EditBill()                                                '修改一张单据
    '判断当前凭证是否允许修改
    If Not Fun_AllowEdit Then
        Exit Sub
    End If
    
    '设置操作状态为修改
    Lab_OperStatus.Caption = "3"
    '设置工具条状态
    Call Sub_OperStatus("30")
End Sub

Private Sub Sub_AbandonBill()                                              '放弃对当前单据的操作
    
    '先关闭录入载体
    changelock = True
    Valilock = True
    Call Ycwbk
    changelock = False
    Valilock = False
    Yd_Help.Visible = False
    Select Case Trim(Lab_OperStatus.Caption)
    Case "3"         '修改状态
        '重新显示当前单据
        Call Sub_ShowBill
        '设置操作状态为浏览
        Lab_OperStatus = "1"
        Call Sub_OperStatus("11")
    End Select
End Sub

Private Function Fun_AllowEdit() As Boolean                      '判断当前定义是否允许编辑或删除
    Fun_AllowEdit = True
End Function

'===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改======================='
Private Sub Sub_AdjustGrid()
    '调 整 网 格
    With WglrGrid
        '加 1 保持一行录入行
        If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
            .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
            For Jsqte = .FixedRows To .Rows - 1
                .RowHeight(Jsqte) = Sjhgd
            Next Jsqte
        Else
            '判断是否有辅助行和录入行,如没有则加行
            Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
                .AddItem ""
                .RowHeight(.Rows - 1) = Sjhgd
            Loop
        End If
    End With
End Sub

Private Sub Lrzdbz()                                                      '录入字段帮助
    If Not Ydcommand.Visible Then
        Exit Sub
    End If
    Valilock = True         '为防止按ydText中帮助按纽时，引起ydText的LostFocus事件。
    With WglrGrid
        '[>>会计科目编码帮助单独处理
        Select Case .Col
        Case Sydz("002", GridStr(), Szzls)
            Xtcdcs = Trim(Ydtext.Text)
            PZ_FrmKjkmcz.Show 1
            If Len(Xtfhcs) <> 0 Then
                Ydtext.Text = Xtfhcs
            End If
        Case Sydz("005", GridStr(), Szzls)
            AutoTran_AssCus.Show 1
        Case Else
            '处理通用部分
            changelock = True        '调入另外窗体必须加锁，为不必执行网格的离开焦点造成的RowColChange事件
            '?没有必要，因为，文本框和命令按纽之间转换焦点，不会执行RowColChange
            Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
            changelock = False
            If Len(Xtfhcs) <> 0 Then
                If GridInt(.Col, 7) = 0 Then
                    Ydtext.Text = Xtfhcs