ʰ

VB开发的ERP系统

Dim Sfxshjwg As Boolean                         '是否显示合计网格
Dim Qslz As Long                                '网格隐藏(非操作显示)列数
Dim Sjhgd As Double                             '网格数据行高度
Dim GridBoolean() As Boolean                    '网格列信息(布尔型)
Dim GridStr()  As String                        '网格列信息(字符型)
Dim GridInt() As Integer                        '网格列信息(整型)
Dim Sfblbzkd As Boolean                         '是否保留帮助宽度(字段提供帮助时,是否为按钮保留空间)
Dim Dqlrwgh As Long                             '当前录入数据网格行
Dim Dqlrwgl As Long                             '当前录入数据网格列
Dim Dqlkwgh As Long                             '刚刚离开网格行(不一定为录入行)
Dim Dqtoprow As Long                            '当前录入状态时最上端可视行
Dim Dqleftcol As Long                           '当前录入状态时最左端可视列
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()
    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)
    '设置调整前余额
    Sqlstr = "SELECT * FROM CWZZ_BankBill Where RecType=0 And Ccode='" & Val(YH_FrmXzkm.Combo1.Text) & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If RecTemp.EOF = False Then
        If Val(RecTemp.Fields("Dfje")) = 0 Then
            Label2(0).Caption = "0"
        Else
            Label2(0).Caption = Format(RecTemp.Fields("Dfje"), "#,###.00")
        End If
    Else
        Label2(0).Caption = 0
    End If
    '报表主标题及报表编码
    ReportTitle = "银行对帐单"
    XtReportCode = "Cwzz_yhdzd"
    Load Dyymctbl
    
    '调入网格
    GridCode = "Cwzz_yhdzdcx"          '网格属性编码
    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
    
    '设置网格宽度
    For Jsqte = WglrGrid.FixedRows To WglrGrid.Rows - 1
        WglrGrid.RowHeight(Jsqte) = Sjhgd
    Next Jsqte
    
    '单据变动置为False
    Bln_BillChange = False
    
    '设置会计科目
    Lab_kjbm.Caption = YH_FrmXzkm.Combo1.Text
    Call Sub_ShowBill
    
    '调整标题位置
    SetTitlePos tsLabel(4)

End Sub

Private Sub Form_Resize()
    On Error Resume Next
    With WglrGrid
        .Width = Me.Width - 160
        .Height = Me.Height - .Top - 400
    End With
    With Pic_Title
        .Width = Me.Width - 160
    End With
    
    GsToolbar.Left = Me.Width - GsToolbar.Width - 140
End Sub

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

'显示网格内容
Private Sub Sub_ShowBill()
    Dim rs As New ADODB.Recordset        '定义数据集
    Dim RS1 As New ADODB.Recordset       '定义数据集
    Dim Jsqte  As Long                   '定义计数器
    
    '查询银行对帐单
    Sqlstr = "SELECT * FROM CWZZ_BankBill  Where Ccode='" & Val(Lab_kjbm) & "' And  " _
    & "RecType=2 Order By BillDate"
    
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        WglrGrid.Clear 1
        If .EOF Then
            Exit Sub
        Else
            WglrGrid.Rows = .RecordCount + WglrGrid.FixedRows
        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, 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 RecTemp1 = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If RecTemp1.EOF = False Then
                WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp1.Fields("ssname") & "")    '结算方式
            End If
            WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("BillNo") & "")                '票号
            If Val(Str(.Fields("Jfje"))) <> 0 Then
                WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(Str(.Fields("Jfje")))              '借方金额
            End If
            If Val(Str(.Fields("Dfje"))) 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) = &HE9FC61                       '如果已勾对设置网格颜色
            End If
            WglrGrid.RowHeight(Jsqte) = Sjhgd
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
    '计算合计数据
    Call Sjhj
End Sub

Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
    Case "bcgs"                              '保存表格格式
        Call Bcwggs(WglrGrid, GridCode, GridStr())
    Case "hfmrgs"                            '恢复默认格式
        Call Hfmrgs(WglrGrid, GridCode, GridStr())
    Case "szxsxm"                            '设置显示项目
        Call Szxsxm(WglrGrid, GridCode)
    End Select
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"                                            '预 览
        Call bbyl(True)
    Case "dy"                                            '打 印
        Call bbyl(False)
    Case "cx"                                            '查 询
        YH_FrmGltj.Tag = "Y"
        YH_FrmGltj.HelpContextID = "0115003"
        YH_FrmGltj.Show 1
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Glo_Variable.Unload_TF = True
        Unload YH_FrmXzkm
        Unload Me
    Case "Sel"                                           '选择
        Glo_Variable.Unload_TF = False
        YH_FrmXzkm.HelpContextID = "0115003"
        YH_FrmXzkm.Show 1
    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 WglrGrid_EnterCell()
    With WglrGrid
        If .Row >= .FixedRows Then
            Lab_Row = Trim(Str(.Row - .FixedRows + 1))
        End If
    End With
End Sub

'网格得到焦点
Private Sub WglrGrid_GotFocus()
    '则调整当前焦点至有效数据行
    With WglrGrid
        If .Row < .FixedRows And .Rows > .FixedRows Then
            changelock = True
            .Select .FixedRows, .Col
            changelock = False
        End If
        If .Col < Qslz Then
            changelock = True
            .Select .Row, Qslz
            changelock = False
        End If
    End With
End Sub

'限制用户在录入过程中滚动鼠标
Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)
    If Gdtlock Then
        Exit Sub
    End If
End Sub

'网格列数据合计
Private Sub Sjhj()
    Dim Hjjg As Double
    Dim Rjsq As Integer
    With WglrGrid
        For Rjsq = 1 To .Rows - 1
            Hjjg = 0
            If Rjsq = 1 Then
                Hjjg = Hjjg + Val(Format(.TextMatrix(Rjsq, Sydz("005", GridStr(), Szzls)), "0.00")) - Val(Format(.TextMatrix(Rjsq, Sydz("004", GridStr(), Szzls)), "0.00")) + Val(Format(Label2(0).Caption, "0.00"))
            Else
                Hjjg = Hjjg + Val(Format(.TextMatrix(Rjsq, Sydz("005", GridStr(), Szzls)), "0.00")) - Val(Format(.TextMatrix(Rjsq, Sydz("004", GridStr(), Szzls)), "0.00")) + Val(Format(.TextMatrix(Rjsq - 1, Sydz("006", GridStr(), Szzls)), "0.00"))
            End If
            If Hjjg <> 0 Then
                .TextMatrix(Rjsq, Sydz("006", GridStr(), Szzls)) = Format(Hjjg, "#,###.00")
            Else
                .TextMatrix(Rjsq, Sydz("006", GridStr(), Szzls)) = ""
            End If
            If Val(.TextMatrix(Rjsq, Sydz("004", GridStr(), Szzls))) <> 0 Then
                .TextMatrix(Rjsq, Sydz("004", GridStr(), Szzls)) = Format(.TextMatrix(Rjsq, Sydz("004", GridStr(), Szzls)), "#,###.00")
            End If
            If Val(.TextMatrix(Rjsq, Sydz("005", GridStr(), Szzls))) <> 0 Then
                .TextMatrix(Rjsq, Sydz("005", GridStr(), Szzls)) = Format(.TextMatrix(Rjsq, Sydz("005", GridStr(), Szzls)), "#,###.00")
            End If
        Next Rjsq
    End With
End Sub

'打印预览(通用)
Private Sub bbyl(bbylte As Boolean)
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    '报表小标题行数
    Bbxbtgs = 1
    '报表表尾行数
    Bbbwhgs = 1
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    '报表总标题
    Bbzbt = ReportTitle
    '报表行组织形式(0-居左 1-居中 2-居右)
    Bbxbt(1) = Space(0) + Fun_FormatOutPut("会计期间:" + Trim(Label1.Caption), 30)
    Bbxbt(1) = Bbxbt(1) + Fun_FormatOutPut("科目编码:" + Trim(Lab_kjbm), 26)
    '报表小标题组织形式
    '报表行组织形式(0-居左 1-居中 2-居右)
    bbxbtzzxs(1) = 0
    Bbbwhzzxs(1) = 1
    '生成报表数据
    Call Scyxsjb(WglrGrid)
    '生成报表
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    '卸载预览窗体
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If
End Sub