ʰ

VB开发的ERP系统

Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
Dim Dqlkwgl As Long                             '刚刚离开网格列
Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
Dim Zdlrqnr As String                           '字段录入修改前内容(用来判断内容是否修改)
Dim Wbkbhlock As Boolean                        '文本框改变值锁
Dim changelock As Boolean                       '网格行列改变控制锁(用来区别用户改变.程序改变)
Dim Gdtlock As Boolean                          '滚动条滚动控制(用来区别用户改变.程序改变)
Dim Yxxpdlock As Boolean                        '字段有效性判断锁(内容不修改不需进行字段有效性判断)
Dim Hyxxpdlock As Boolean                       '行有效性判断锁(字段内容不修改不需进行行有效性判断)
Dim Valilock As Boolean                         '文本框失去焦点是否进行有效性控制(TRUE 为锁定*限用网格录入)
Dim Shsfts As Boolean                           '删除记录行是否提示
Dim Szzls As Integer                            '网格信息数组最大下标值(网格列数-1)
    
Private Sub Form_KeyPress(KeyAscii As Integer)      '控制焦点转移和限制录入字符"'"
    
    Select Case KeyAscii
    Case 39           '屏蔽字符"'"
        KeyAscii = 0
    End Select
    
End Sub

Sub Form_Load()                              '窗体装入
    
    '初始化各种锁值(Fixed)
    changelock = False             '网格行列改变控制锁
    Gdtlock = False                '滚动条滚动控制
    Yxxpdlock = True               '字段有效性判断锁
    Hyxxpdlock = True              '行有效性判断锁
    Wbkbhlock = False              '文本框内容改变锁
    
    '隐藏选择对话框
    YH_FrmXzkm.Hide
    '定义会计区间
    Label1.Caption = Mid(Trim(Str(10000 + Xtyear)), 2, 4) + "." + Mid(Trim(Str(100 + Xtmm)), 2, 2)
    '设置会计科目
    Lab_kjbm.Caption = YH_FrmXzkm.Combo1.Text
    
    '设置调整前余额
    Sqlstr = "SELECT * FROM CWZZ_BankBill Where RecType=0 And Ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "'"
    Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Cxnrrec.EOF = False Then
        If Val(Cxnrrec.Fields("Dfje")) = 0 Then
            Label2(0).Caption = "0"
        Else
            Label2(0).Caption = Format(Cxnrrec.Fields("Dfje"), "#,###.00")
        End If
    Else
        Label2(0).Caption = 0
    End If
    
    '报表主标题及报表编码
    ReportTitle = "银行对帐单"
    XtReportCode = "Cwzz_yhdzd"
    Load Dyymctbl
    
    '调入网格(Fixed)
    GridCode = "Cwzz_yhdzdlr"      '网格属性编码
    Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Pmbcsjhs = GridInf(3)
    Fzxwghs = GridInf(4)
    Sfblbzkd = GridInf(5)
    Shsfts = GridInf(6)
    Sfxshjwg = GridInf(7)
    Szzls = WglrGrid.Cols - 1
    
    '生成查询结果
    Call Sub_Query
    
    '设置状态为修改状态
    Lab_OperStatus = "2"
    
    '调整标题位置
    SetTitlePos tsLabel(4)
    Str_RightEdit = "Cwzz_yhdzd_Edit"
    
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
        Lab_OperStatus = "1"
    End If
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If Fun_Drfrmyxxpd = True Then
        
    Else
        Cancel = 1
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)           '窗体卸载
    
    '卸载打印页面窗体
    Unload Dyymctbl
    
End Sub

Private Sub Sub_Query()                              '生成查询结果
    
    Dim Sqlstr As String                           '临时使用字符串
    Dim RecTemp As New ADODB.Recordset             '临时使用动态集
    Dim Jsqte As Long                              '临时计数器
    
    '禁止网格刷新动作,为加快网格显示速度(Fixed)
    WglrGrid.Redraw = False
    
    '查询银行对帐单
    Sqlstr = "SELECT * FROM CWZZ_BankBill  Where BankBillID in(Select top " + Text_Num + " BankBillID from cwzz_bankbill where Ccode='" & Val(Lab_kjbm) & "' And  " _
    & "RecType=2 Order By BillDate desc) Order By BillDate"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
        WglrGrid.Rows = WglrGrid.FixedRows
        Jsqte = WglrGrid.FixedRows
        
        Do While Not .EOF
            
            WglrGrid.AddItem ""
            WglrGrid.TextMatrix(Jsqte, 0) = "*"
            WglrGrid.TextMatrix(Jsqte, 1) = .Fields("BankBillID")                                                   '对帐单ID
            WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Format(.Fields("billdate"), "yyyy-mm-dd")   '票据日期
            Sqlstr = "Select * From Gy_SetTleMent Where Sscode='" & .Fields!sscode & "'"                           '结算方式
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Cxnrrec.EOF = False Then
                WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(Cxnrrec.Fields("ssname") & "")
            End If
            WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("BillNo") & "")                '票号
            If Val(.Fields("Jfje")) <> 0 Then
                WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(Str(.Fields("Jfje")))              '借方金额
            End If
            If Val(.Fields("dfje")) <> 0 Then
                WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(Str(.Fields("Dfje")))              '贷方金额
            End If
            WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("Digest")) & ""                '摘要
            If .Fields("bcheckflag") = True Then                                                                    '如果已勾对设置网格颜色
                WglrGrid.Cell(flexcpBackColor, Jsqte, 0, Jsqte, WglrGrid.Cols - 1) = Label3(0).BackColor
            End If
            WglrGrid.RowHeight(Jsqte) = Sjhgd
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
    
    '将网格刷新解禁(Fixed)
    WglrGrid.Redraw = True
    
    '调整网格(Fixed)
    Call Sub_AdjustGrid
    '计算合计数据
    Call Sjhj
End Sub

Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
    
    '屏蔽文本框,下拉组合框有效性判断
    
    Valilock = True
    
    '屏蔽网格失去焦点产生的有效性判断
    
    changelock = True
    
    Select Case Button.Key
    Case "ymsz"                                          '页面设置
        Dyymctbl.Show 1
    Case "yl"                                            '预 览
        If Fun_Drfrmyxxpd Then
            Call bbyl(True)
        End If
    Case "dy"                                            '打 印
        If Fun_Drfrmyxxpd Then
            Call bbyl(False)
        End If
    Case "zh"                                            '增 行
        Call zjlrfl
    Case "sh"                                            '删 行
        Call Scdqfl
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
    End Select
    
    '解 锁
    Valilock = False
    changelock = False
    
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)        '支持热键操作
    
    If Shift = 2 Then
        Select Case UCase(Chr(KeyCode))
        Case "P"                   'Ctrl+P 打印
            If Tlb_Action.Buttons("dy").Enabled Then
                Call bbyl(False)
            End If
        End Select
    End If
    
End Sub

Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
    
    Dim xswbrr As String
    
    With WglrGrid
        Zdlrqnr = Trim(.Text)
        xswbrr = Trim(.Text)
        
        If GridBoolean(.Col, 3) Then   '列表框录入
            
            '填充列表框程序
            Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
        Else
            Wbkbhlock = True
            
            '====以下为用户自定义
            Ydtext.Text = xswbrr
            '====以上为用户自定义
            
            Wbkbhlock = False
            Ydtext.SelStart = Len(Ydtext.Text)
        End If
    End With
    
End Sub

Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
    '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值
    
    Dim Str_JudgeText As String                 '临时有效性判断字段内容(Fixed)
    Dim Coljsq As Long                          '临时列计数器(Fixed)
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集(Fixed)
    Dim Sqlstr As String                        '临时使用查询字符串(Fixed)
    
    With WglrGrid
        
        '非录入状态或非数据行则其有效性为合法(Fixed)
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
        
        '取得当前要判断字段内容(Fixed)
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
        
        '根据不同字段进行相应的处理(依据其逻辑编号)
        Select Case GridStr(Dqpdwgl, 1)
            '[>>以下为自定义部分
            
        Case "001"          '日期格式(如用户录入日期格式正确)
            If Trim(Str_JudgeText) <> "" Then
                If Not IsDate(Str_JudgeText) = True Then
                    Tsxx = "此日期格式不正确!"
                    GoTo Lrcwcl
                Else
                    Sqlstr = "select * from cwzz_bankbill where rectype=0 and ccode='" & Val(Lab_kjbm.Caption) & "'"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    If RecTemp.EOF = False Then
                        If Str_JudgeText < Format(RecTemp.Fields("billdate"), "yyyy-mm-dd") Then
                            Tsxx = "日期不能小于启用日期!"
                            GoTo Lrcwcl
                        End If
                    End If
                End If
            End If
        Case "002"
            If Trim(Str_JudgeText) <> "" Then
                If Val(Str_JudgeText) <> 0 Then
                    Sqlstr = "Select * from Gy_settlement where sscode='" & Str_JudgeText & "'"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    With RecTemp
                        If .EOF Then
                            Tsxx = "此编码不存在!"
                            GoTo Lrcwcl
                        End If
                        WglrGrid.TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = RecTemp.Fields("ssname")
                    End With
                End If
                If Val(Str_JudgeText) = 0 Then
                    Sqlstr = "Select * from Gy_settlement where ssname='" & Str_JudgeText & "'"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    With RecTemp
                        If .EOF Then
                            Tsxx = "此编码不存在!"
                            GoTo Lrcwcl
                        End If
                    End With
                End If
            End If
        Case "004"     '借方金额
            '用户如录入借方金额,系统则自动清除贷方金额
            If Val(WglrGrid.TextMatrix(Dqpdwgh, Dqpdwgl)) <> 0 Then
                WglrGrid.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = ""
            End If
        Case "005"     '贷方金额
            '用户如录入贷方金额,系统则自动清除借方金额
            If Val(WglrGrid.TextMatrix(Dqpdwgh, Dqpdwgl)) <> 0 Then
                WglrGrid.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = ""
            End If
            '<<以上为自定义部分]
        End Select
        
        '字段录入正确后为零字段清空(Fixed)
        Call Qkwlzd(Dqpdwgh, Dqpdwgl)
        
        '字段录入正确后进行数据合计
        Call Sjhj
        
        '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
        sjzdyxxpd = True
        Yxxpdlock = True
        Exit Function
    End With
    
Lrcwcl:    '录入错误处理(Fixed)
    
    With WglrGrid
        '给出错误提示信息
        Call Xtxxts(Tsxx, 0, 1)
        
        '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
        changelock = True
        .Select Dqpdwgh, Dqpdwgl
        changelock = False
        Call xswbk
        
        '函数返回False
        sjzdyxxpd = False
        Exit Function
    End With
    
End Function

Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
    
    Dim Lrywlz As Long                     '录入错误列值(Fixed)
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '临时查询字符串