i-

VB开发的ERP系统

         Width           =   810
      End
      Begin VB.Line Line1 
         Index           =   1
         X1              =   2520
         X2              =   2760
         Y1              =   330
         Y2              =   330
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "科目范围:"
         Height          =   180
         Index           =   0
         Left            =   150
         TabIndex        =   19
         Top             =   630
         Width           =   810
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "科目类型:"
         Height          =   180
         Index           =   1
         Left            =   150
         TabIndex        =   18
         Top             =   990
         Width           =   810
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "会计期间:"
         Height          =   180
         Index           =   2
         Left            =   150
         TabIndex        =   17
         Top             =   270
         Width           =   810
      End
   End
End
Attribute VB_Name = "ZB_Frmkmyebtj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************
'*    模 块 名 称 :科目发生额及余额表查询条件
'*    功 能 描 述 :
'*    程序员姓名  : 张建忠
'*    最后修改人  : 奚俊峰
'*    最后修改时间:2001/12/30
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'****************************************************************

Dim Dbl_DefaultWidth As Double           '条件窗体默认宽度

'以下为固定使用变量(网格)
Dim Cxnrrec As New ADODB.Recordset       '显示查询内容动态集
Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
Dim GridCode As String                   '显示网格网格代码
Dim GridInf() As Variant                 '整个网格设置信息
Dim Tsxx As String                       '系统提示信息
Dim Qslz As Long                         '网格隐藏(非操作显示)列数
Dim Sjhgd As Double                      '网格数据行高度
Dim GridBoolean() As Boolean             '网格列信息(布尔型)
Dim GridStr()  As String                 '网格列信息(字符型)
Dim GridInt() As Integer                 '网格列信息(整型)
Dim Szzls As Integer                     '数组总列数(网格列数-1)
Dim Lng_Dqwgh As Long                    '系统当前刚刚离开网格行

'以下为固定使用变量(文本框)
Dim Textvar() As Variant                 '存储变体型文本框信息
Dim Textboolean() As Boolean             '存储布尔型文本框信息
Dim Textint() As Integer                 '存储整型文本框信息
Dim Textstr() As String                  '存储字符型文本框信息
Dim Max_Text_Index As Integer            '最大录入文本框索引值
Dim TextGroupCode As String              '文本框录入分组编码
Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
Dim CurTextIndex As Integer              '当前文本框索引值
Dim TextChangeLock As Boolean            '文本框内容变换控制锁
Dim Bln_Cancel As Boolean                '取消按钮信息传递
Private Sub Cmd_MyReport_Click()         '用户点击我的报表按钮
    If Fra_MyReport.Visible Then
        Fra_MyReport.Visible = False
        Me.Width = Dbl_DefaultWidth
    Else
        Fra_MyReport.Visible = True
        Me.Width = Fra_MyReport.Left + Fra_MyReport.Width + 100
    End If
    
    '条件窗体居于屏幕中心
    Me.Move (Screen.Width - Me.Width) / 2
    
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
    Dim jdzygs As Integer                         '控件焦点转移个数
    jdzygs = 30
    Select Case KeyAscii
    Case vbKeyReturn
        If Kjjdzy(jdzygs) Then
            KeyAscii = 0
        End If
    Case 39           '屏蔽"'"
        KeyAscii = 0
    End Select
End Sub

Private Sub Form_Load()
    
    '填充会计期间列表框(年度默认为用户选择年度)
    Call Sub_FillPeriod(Combo_Kjqj(0), Xtyear, Xtmm)
    Call Sub_FillPeriod(Combo_Kjqj(1), Xtyear, Xtmm)
    
    '科目类型
    Call FillCombo(Combo_Class, "cwzz_kmlx", "", 1)
    
    '以下为文本框处理程序
    
    TextGroupCode = "Cwzz_kmyeb"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
    Call Wbkcsh
    
    '保存条件窗体默认宽度,隐藏我的报表栏
    Dbl_DefaultWidth = Me.Width
    Fra_MyReport.Visible = False
    
    '调 入 网 格
    GridCode = "Cwzz_myreport"
    
    Call BzWgcsh(vsFlx_MyReport, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Szzls = vsFlx_MyReport.Cols - 1
    
    '填 充 网 格
    Call Cxnrtcwg
    
End Sub

Private Sub Cxnrtcwg()                               '查 询 内 容 填 充 网 格
    Dim Sqlstr As String
    Dim Jsqte As Long
    
    vsFlx_MyReport.Redraw = False
    
    '查询连接串
    Sqlstr = "SELECT Distinct QueryName FROM Cwzz_MyReport Where Czybm='" & Xtczybm & "' And QueryCode='" & TextGroupCode & "'"
    Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With Cxnrrec
        vsFlx_MyReport.Clear 1
        vsFlx_MyReport.Rows = .RecordCount + vsFlx_MyReport.FixedRows
        If .EOF And .BOF Then
            vsFlx_MyReport.Redraw = True
            Exit Sub
        End If
        Jsqte = vsFlx_MyReport.FixedRows
        Do While Not .EOF
            If Jsqte >= vsFlx_MyReport.Rows Then
                vsFlx_MyReport.AddItem ""
            End If
            
            vsFlx_MyReport.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("QueryName"))
            
            vsFlx_MyReport.RowHeight(Jsqte) = Sjhgd
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
    
    vsFlx_MyReport.Redraw = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadCheck.Value <> 1 Then
        Cancel = 1
        Me.Hide
    End If
End Sub

Private Sub QdCommand_Click()                                   '确 定
    '录入条件有效性判断
    If Not Lrtjyxxpd Then
        Exit Sub
    End If
    Me.Hide
    
    '激活查询过程
    ZB_FrmKmyebjg.Timer1.Enabled = True
    
End Sub

Private Sub QxCommand_Click()                                    '取消
    Me.Hide
End Sub

Private Function Lrtjyxxpd() As Boolean                          '用户录入条件有效性判断
    Dim Jsqte As Integer
    Lrtjyxxpd = False
    
    '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
    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
    
    '[>>以下为依据实际情况自定义部分
    
    '查询会计期间范围应由小到大
    If Trim(Combo_Kjqj(0).Text) > Trim(Combo_Kjqj(1).Text) Then
        Tsxx = "查询会计期间范围应由小到大!"
        Call Xtxxts(Tsxx, 0, 4)
        Combo_Kjqj(0).SetFocus
        Exit Function
    End If
    
    
    '查询科目号范围应由小到大
    If Trim(LrText(0).Text) > Trim(LrText(1).Text) And Trim(LrText(1).Text) <> "" Then
        Tsxx = "查询科目范围应由小到大!"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(0).SetFocus
        Exit Function
    End If
    
    '查询科目级次应为1-6,且级次范围应由小到大
    If Not (Val(LrText(2).Text) >= 1 And Val(LrText(2).Text) <= 6) Then
        Tsxx = "查询科目级次应在1-6之间!"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(2).SetFocus
        Exit Function
    End If
    
    If Not (Val(LrText(3).Text) >= 1 And Val(LrText(3).Text) <= 6) Then
        Tsxx = "查询科目级次应在1-6之间!"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(3).SetFocus
        Exit Function
    End If
    
    If Val(LrText(2).Text) > Val(LrText(3).Text) Then
        Tsxx = "查询科目级次范围应由小到大!"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(2).SetFocus
        Exit Function
    End If
    
    '<<]以上为依据实际情况自定义部分
    
    Lrtjyxxpd = True
End Function

Private Sub vsFlx_MyReport_Click()                                          '显示用户点击查询报表
    Dim Sqlstr As String
    Dim Rec_MyReport As New ADODB.Recordset     '我的报表动态集
    Dim Jsqte As Integer                        '临时动态计数器
    
    If vsFlx_MyReport.Row < vsFlx_MyReport.FixedRows Then
        Exit Sub
    End If
    
    '查询连接串
    Sqlstr = "SELECT Value FROM Cwzz_MyReport Where Czybm='" & Xtczybm & "' And QueryCode='" & TextGroupCode & "' And QueryName='" & Trim(vsFlx_MyReport.TextMatrix(vsFlx_MyReport.Row, Sydz("001", GridStr(), Szzls))) & "' Order By I_ID"
    Set Rec_MyReport = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    Jsqte = 1
    
    On Error Resume Next
    
    With Rec_MyReport
        Do While Not .EOF
            Select Case Jsqte
            Case 1           '起始科目编码
                LrText(0).Text = Trim(.Fields("Value"))
            Case 2           '终止科目编码
                LrText(1).Text = Trim(.Fields("Value"))
            Case 3           '科目类型
                Combo_Class.Text = Trim(.Fields("Value"))
            Case 4           '起始科目级次
                LrText(2).Text = Trim(.Fields("Value"))
            Case 5           '终止科目级次
                LrText(3).Text = Trim(.Fields("Value"))
            Case 6           '是否包含未记帐凭证
                Chk_NotBook.Value = Int(.Fields("Value"))
            Case 7           '是否输出按科目类别合计
                Chk_ClassSum.Value = Int(.Fields("Value"))
            Case 8           '科目各列数据均为零则不显示
                Chk_NotOuputZero.Value = Int(.Fields("Value"))
            End Select
            Jsqte = Jsqte + 1
            .MoveNext
        Loop
    End With
End Sub

Private Sub Cmd_Delete_Click()                                              '删除当前报表查询条件
    Dim Yhanswer As Integer