VB开发的ERP系统

        '(如果字段录入内容发生变化,则打开有效性判断锁)
        If Zdlrqnr <> Trim(.Text) Then
            Yxxpdlock = False
            Hyxxpdlock = False
        End If
   
        '如果字段录入内容不为空则写数据行有效性标志
   
        If Len(Trim(.Text)) <> 0 Then
            Call Xyxhbz(.Row)
        End If
   
        '隐藏文本框,帮助按钮,列表组合框
        Call Ycwbk
   
    End With
    
End Sub

Private Sub WglrGrid_KeyPress(KeyAscii As Integer)                     '网格接受键盘录入
  
    Dim Str_ChangeTe As String    '临时交换内容
    Dim Coljsq As Long            '临时列计数器
    Dim Int_SaveKey As Integer    '保存KeyAscii值
  
    '如果单据操作状态为浏览状态则不能显示录入载体
    If Trim(Lab_OperStatus.Caption) = "1" Then
        Exit Sub
    End If
  
    Int_SaveKey = KeyAscii
  
    With WglrGrid
    
        '屏 蔽 回 车 键
        If KeyAscii = vbKeyReturn Then
            KeyAscii = 0
            Rowjsq = .Row
            Coljsq = .Col + 1
            If Coljsq > .Cols - 1 Then
                If Rowjsq < .Rows - 1 Then
                    Rowjsq = Rowjsq + 1
                End If
                Coljsq = Qslz
            End If
            Do While Rowjsq <= .Rows - 1
                If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                    Coljsq = Coljsq + 1
                    If Coljsq > .Cols - 1 Then
                        Rowjsq = Rowjsq + 1
                        Coljsq = Qslz
                    End If
                Else
                    Exit Do
                End If
            Loop
            If Rowjsq > .Rows - 1 Then
                Rowjsq = .Rows - 1
            End If
            Changelock = True
            .Select Rowjsq, Coljsq
            Changelock = False
            Exit Sub
        End If
        
        '接受用户录入
        Select Case KeyAscii
            Case 0 To 32
          
                '显示录入载体
                Call xswbk
            
            Case Else
     
                '防止非编辑字段SendKeys()出现死循环
                If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
                    Exit Sub
                End If
          
                If GridBoolean(.Col, 3) Then
             
                    '列表框录入
                    Call xswbk
             
                Else
                  
                    Ydtext.Text = ""
                    Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
                If KeyAscii = 0 Then
                    Exit Sub
                End If
              
                '写有效行数据标志
                Call Xyxhbz(.Row)
                Call xswbk
                Ydtext.Text = ""
                SendKeys Chr(KeyAscii)
          
        
            End If
        End Select
    End With
    
End Sub

Private Sub Qkwlzd(sjh As Long, Sjl As Long)                            '清空为零字段
  
    If Not GridBoolean(Sjl, 5) Then
        Exit Sub
    End If
    With WglrGrid
        If Val(Trim(.TextMatrix(sjh, Sjl))) = 0 Then
            .TextMatrix(sjh, Sjl) = ""
        End If
    End With
    
End Sub
Private Sub fhyxh()                                                     '返回录入数据有效行,同时让得到焦点网格可见
  
    With WglrGrid
        If .Row >= .FixedRows Then
            If .TextMatrix(.Row, 0) <> "*" Then
                For Rowjsq = .FixedRows To .Rows - 1
                    If .TextMatrix(Rowjsq, 0) <> "*" Then
                        Exit For
                    End If
                Next Rowjsq
                If Rowjsq <= .Rows - 1 Then
                    Changelock = True
                    .Select Rowjsq, .Col
                    Changelock = False
                Else
                    Changelock = True
                    .Select .Rows - 1, .Col
                    Changelock = False
                End If
            End If
            Call Xldqh
        End If
    End With
    
End Sub

Private Sub Xldqh()                                                      '显露当前行
  
    Dim Toprowte As Long
    
    With WglrGrid
        Toprowte = 0
        Do While .CellTop + .RowHeight(.Row) + Fzxwghs * Sjhgd > .Height And .TopRow <> Toprowte
            Toprowte = .TopRow
            .TopRow = .TopRow + 1
        Loop
        Toprowte = 0
        Do While .CellTop < .FixedRows * .RowHeight(0) And .TopRow <> Toprowte
            Toprowte = .TopRow
            If .TopRow > 1 Then
                .TopRow = .TopRow - 1
            End If
        Loop
    End With
    
End Sub

Private Sub Xldql()                                                     '显露当前列
 
    Dim Leftcolte As Long
    With WglrGrid
        If .Col >= Qslz Then
            If .LeftCol > .Col Then
                .LeftCol = .Col
            End If
            Leftcolte = 0
            Do While .CellLeft + .CellWidth > .Width And .LeftCol <> Leftcolte
                Leftcolte = .LeftCol
                .LeftCol = .LeftCol + 1
            Loop
        End If
    End With
    
End Sub

Private Function pdhwk(sjh As Long)                                     '判断网格行是否为空行(所有录入字段均为空*非录入字段除外)
 
    With WglrGrid
        For Coljsq = Qslz To .Cols - 1
            If Len(Trim(.TextMatrix(sjh, Coljsq))) <> 0 And GridBoolean(Coljsq, 1) Then
                pdhwk = False
                Exit Function
            End If
        Next Coljsq
        pdhwk = True
    End With
    
End Function

Private Sub Xyxhbz(sjh As Long)                                         '写行有效性标志,并判断是否增行
    
    With WglrGrid
        If .TextMatrix(sjh, 0) = "*" Then
            Exit Sub
        End If
        .TextMatrix(sjh, 0) = "*"
    End With
   
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 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 = 0                                  '报 表 表 尾 行 数
    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
    
    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

Private Sub Delete_AvgPrice()        '保存平均单价

    With WglrGrid

        Cw_DataEnvi.DataConnect.BeginTrans
        
        For Jsqte = .FixedRows To .Rows - 1

            '保存单价
            Cw_DataEnvi.DataConnect.Execute ("UPDATE Chhs_Mate SET EndPrice=0 WHERE MateId='" & Val(.TextMatrix(Jsqte, 1)) & "' ")
        Next Jsqte
     
        Cw_DataEnvi.DataConnect.CommitTrans

    End With

End Sub

Private Sub Sub_Query()                                    '生成查询结果

    Dim Rec_Query As New ADODB.Recordset                     '查询结果动态集
    Dim Rectemp As New ADODB.Recordset                      '查询结果动态集
    Dim SqlStr As String
    Dim FindRow As Long
    Dim Jsqfz As Long
 
       
    SqlStr = Replace(mQuery_cond, "view", "Chhs_V_Mate", , , vbTextCompare)
    If Opt_Price(0).Value Then
        SqlStr = "SELECT * FROM Chhs_V_Mate WHERE KjYear='" & PGKjYear & "' and Period='" & PGNowmon & "' AND EndPrice<=0 AND " + SqlStr
    Else
        SqlStr = "SELECT * FROM Chhs_V_Mate WHERE KjYear='" & PGKjYear & "' and Period='" & PGNowmon & "' AND  " + SqlStr
    End If
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)
 
    WglrGrid.Rows = WglrGrid.FixedRows
 
    With Rec_Query
 
        Do While Not .EOF
            
            If .Fields("Outquan") <> 0 Then
                WglrGrid.AddItem ""
                Jsqte = WglrGrid.Rows - 1
                WglrGrid.RowHeight(Jsqte) = Sjhgd
                
                WglrGrid.TextMatrix(Jsqte, 0) = "*"
                WglrGrid.TextMatrix(Jsqte, 1) = Trim(.Fields("MateId"))
                WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("WhName") & "")
                WglrGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("MName") & "")
                WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("MNumber") & "")
                If Not .Fields("startquan") = 0 Then
                    WglrGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = Val(.Fields("startquan"))
                End If
                If Not .Fields("startPrice") = 0 Then
                    WglrGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Val(.Fields("startPrice"))
                End If
                If Not .Fields("startMoney") = 0 Then
                    WglrGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = Val(.Fields("startMoney"))
                End If
                If Not .Fields("InQuan") = 0 Then
                    WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Val(.Fields("InQuan"))
                End If
                If Not .Fields("InPrice") = 0 Then
                    WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Val(.Fields("InPrice"))
                End If
                If Not .Fields("InMoney") = 0 Then
                    WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Val(.Fields("InMoney"))
                End If
                If Not .Fields("OutQuan") = 0 Then
                    WglrGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Val(.Fields("OutQuan"))
                End If
                If Not .Fields("EndPrice") = 0 Then
                    WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Val(.Fields("EndPrice"))
                End If
                If Not .Fields("OutQuan") = 0 Then
                    WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Format(Val(.Fields("OutQuan")) * Val(.Fields("EndPrice")), "####.0" + String(Xtjexsws, "0"))
                End If
                
                SqlStr = "SELECT sum(outquan) as sumoutquan,sum(outmoney) as sumoutmoney FROM Chhs_List WHERE sfjeztflag=1 and KjYear='" & PGKjYear & "' and Period='" & PGNowmon & "'" & _
                        " and whcode='" & Trim(Rec_Query.Fields("whcode")) & "' and mnumber='" & Trim(Rec_Query.Fields("mnumber")) & "'"
                Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                If Not Rectemp.EOF Then
                    If Not IsNull(Rectemp.Fields("sumoutquan")) Then
                        WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Val(.Fields("OutQuan") - Val(Rectemp.Fields("sumoutquan"))) * Val(.Fields("EndPrice")) + Val(Rectemp.Fields("sumoutmoney"))
                    End If
                Else
                    WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Format(Val(.Fields("OutQuan")) * Val(.Fields("EndPrice")), "####.0" + String(Xtjexsws, "0"))
                End If
                
                If Val(WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls))) = 0 Then
                    WglrGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = ""
                End If
            End If
            .MoveNext
        Loop
     
        If WglrGrid.Rows > WglrGrid.FixedRows Then
            WglrGrid.Select WglrGrid.FixedRows, Sydz("007", GridStr(), Szzls)
        End If
     
    End With
    
    Set Rec_Query = Nothing
    
    
End Sub

Public Property Let Query_Cond(ByVal vNewValue As Variant)
    mQuery_cond = vNewValue
End Property