VB开发的ERP系统

    WglrGrid.Redraw = False
    'Call Sub_Query
    WglrGrid.Redraw = True
    
    '设置状态为修改状态
    Lab_OperStatus = "2"
 
End Sub
Private Sub Form_Unload(Cancel As Integer)           '窗体卸载

   '卸载打印页面窗体
   Unload Dyymctbl

End Sub
Private Sub Sub_Query()                            '生成查询结果
    Dim RsTemp As New Recordset
    Dim Jsq As Integer
    Dim strTemp As String
    Dim TempCode As String
    
    If RsTemp.State Then RsTemp.Close
    strTemp = "SELECT * FROM Xs_V_ConsignBill where cuscode='" & Trim(LrText(0).Tag) & "' and convert(char,consignDate,112) like '" & _
            Format(LrText(1), "yyyymmdd") & "%' and checker<>''"
    If Flag.Text = 0 Then
        If Xs_IfInvoice = False Then
            strTemp = strTemp + " and ConsignFlag=0 "
        Else
            strTemp = strTemp + " and ConsignFlag=0 and returnmoneyflag='1'"
        End If
    Else
        strTemp = strTemp + " and ConsignFlag=1 and (kdflag=0 or billtype=1 or (kdflag=1 and receiveflag=1))"
    End If
    If BlChoice Then
'        StrTemp = StrTemp + " and billtype=0"
    Else
        strTemp = strTemp + " and billtype=1"
    End If
    strTemp = strTemp + " and abs(recquantity)-abs(invquantity)>0"      '开票数量大于0
    strTemp = strTemp + " order by warecode"
    RsTemp.Open strTemp, Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
    With WglrGrid
        .Clear 1
        .Rows = .FixedRows + RsTemp.RecordCount
        If RsTemp.RecordCount > 0 Then .Row = .FixedRows
        Do While Not RsTemp.EOF
                .TextMatrix(.Row, 0) = "*"
                .TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = ""
                .TextMatrix(.Row, Sydz("002", GridStr(), Szzls)) = Trim(RsTemp.Fields("consigncode"))       '发货单
                .TextMatrix(.Row, Sydz("012", GridStr(), Szzls)) = Trim(RsTemp.Fields("consignbillmainid")) '发货单
                .TextMatrix(.Row, Sydz("003", GridStr(), Szzls)) = Trim(RsTemp.Fields("whname"))            '仓库
                .TextMatrix(.Row, Sydz("004", GridStr(), Szzls)) = Trim(RsTemp.Fields("warecode"))          '货物编码
                .TextMatrix(.Row, Sydz("005", GridStr(), Szzls)) = Trim(RsTemp.Fields("mname"))             '货物名称
                .TextMatrix(.Row, Sydz("006", GridStr(), Szzls)) = Trim(RsTemp.Fields("model"))             '规格
                .TextMatrix(.Row, Sydz("007", GridStr(), Szzls)) = Trim(RsTemp.Fields("saleunitname"))      '单位
                .TextMatrix(.Row, Sydz("008", GridStr(), Szzls)) = Val(RsTemp.Fields("Recquantity") & "")   '实收数量
                .TextMatrix(.Row, Sydz("009", GridStr(), Szzls)) = Val(RsTemp.Fields("Invquantity") & "")   '已开票数量
                .TextMatrix(.Row, Sydz("010", GridStr(), Szzls)) = ""                                       '开票数量
                .TextMatrix(.Row, Sydz("011", GridStr(), Szzls)) = Val(RsTemp.Fields("taxUnitPrice") & "")  '含税单价
            TempCode = Trim(RsTemp.Fields("warecode"))
            RsTemp.MoveNext
            If RsTemp.EOF Then
                .AddItem ""
                .Row = .Row + 1
                .TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = "小计"
                .Cell(flexcpBackColor, .Row, 0, .Row, .Cols - 1) = Lab_Color(3).BackColor
                Exit Do
            End If
            If TempCode <> Trim(RsTemp.Fields("warecode")) Then
                .AddItem ""
                .Row = .Row + 1
                .TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = "小计"
                .Cell(flexcpBackColor, .Row, 0, .Row, .Cols - 1) = Lab_Color(3).BackColor
            End If
            .Row = .Row + 1
        Loop
    End With

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)        '录入数据字段有效性判断,同时进行字段录入事后处理
 Dim Str_JudgeText As String            '临时有效性判断字段内容
 Dim Coljsq As Long                     '临时列计数器
 Dim RecTemp As New ADODB.Recordset     '临时使用动态集
 Dim Dbl_Qcye As Double                 '临时期初余额
 
 With WglrGrid
    
    '非录入状态有效性为合法
    If Yxxpdlock Or .Row < .FixedRows Then
       sjzdyxxpd = True
       Exit Function
    End If
 
     Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
     Select Case GridStr(Dqpdwgl, 1)
         
         '以下为自定义部分[
               '1.放置字段有效性判断程序
            Case "010"
                If Not Trim(Str_JudgeText) = "" Then
                    If Not IsNumeric(Trim(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)))) Then
                        Tsxx = "数据格式有误!"
                        Lrywlz = Sydz("010", GridStr(), Szzls)
                        GoTo Lrcwcl
                    End If
                If Val(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls))) < 0 Then
                    .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = -Abs(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)))
                    Tsxx = "开票数量不能小于 "
                Else
                    Tsxx = "开票数量不能大于 "
                    .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = Abs(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)))
                End If
                If Abs(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls))) - Abs(.TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls))) < Abs(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls))) Then
                    Tsxx = Tsxx & Val(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls))) - Val(.TextMatrix(Dqpdwgh, Sydz("009", GridStr(), Szzls))) & "  "
                    Lrywlz = Sydz("010", GridStr(), Szzls)
                    GoTo Lrcwcl
                Else
                    If Val(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls))) <> 0 Then
                        .TextMatrix(Dqpdwgh, 1) = "*"
                        .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = "*"
                    Else
                        .TextMatrix(Dqpdwgh, 1) = ""
                        .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = ""
                        .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = ""
                    End If
                    Call Sub_Total(Dqpdwgh)
                End If
                End If
        End Select
     
     '字段录入正确后为零字段清空
      Call Qkwlzd(Dqpdwgh, Dqpdwgl)
    
     sjzdyxxpd = True
     Yxxpdlock = True
     Exit Function
 End With
  
Lrcwcl:    '录入错误处理
  With WglrGrid
      Call Xtxxts(Tsxx, 0, 1)
      Changelock = True
      .Select Dqpdwgh, Dqpdwgl
      Changelock = False
      Call xswbk
      sjzdyxxpd = False
      Exit Function
   End With
End Function
Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
 Dim Lrywlz As Long                     '录入错误列值
 Dim RecTemp As New ADODB.Recordset     '临时使用动态集
 Dim Sqlstr As String                   '临时查询字符串
 Dim Dbl_Ori(1 To 12) As Double         '科目记录原数据
 Dim Dbl_Now(1 To 12) As Double         '科目记录现数据
 Dim Str_Ccode As String                '操作科目
 Dim Rec_AccSum As New ADODB.Recordset  '科目总帐动态集
 Dim Bln_Foreign As Boolean             '外币核算
 Dim Lng_GridRow As Long                '定位科目所在网格行
 
 With WglrGrid
  If Yxxpdh > (.Rows - .FixedRows) Then Exit Function
  '行没有发生变化则不进行有效性判断
  If Hyxxpdlock Then
     Sjhzyxxpd = True
     Exit Function
  End If
  
   '以下为自定义部分[

        '1.放置行有效性判断程序

           '首先进行为空判断(固定不变)
           For Jsqte = Qslz To .Cols - 1
               If (GridInt(Jsqte, 5) = 1 And Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Or (GridInt(Jsqte, 5) = 2 And Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Then
                  Tsxx = GridStr(Jsqte, 2)
                  Lrywlz = Jsqte
                  GoTo Lrcwcl
                  Exit For
               End If
           Next Jsqte
           
         '<<]

   '以上为自定义部分]
 

 Sjhzyxxpd = True
 Hyxxpdlock = True
 Exit Function
End With
Lrcwcl:      '录入错误处理
  With WglrGrid
      Call Xtxxts(Tsxx, 0, 1)
      Changelock = True
      .Select Yxxpdh, Lrywlz
      Changelock = False
      Call xswbk

      Sjhzyxxpd = False
      Exit Function
  End With
End Function

'===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改======================='
Private Sub Lrzdbz()                                                      '录入字段帮助
   If Not Ydcommand.Visible Then
      Exit Sub
   End If
  Valilock = True
  With WglrGrid
       
    Changelock = True        '调入另外窗体必须加锁
       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
       Else
          Ydtext.Text = Xtfhcsfz
       End If
    End If
        
  Valilock = False
  If Ydtext.Visible Then
    Ydtext.SetFocus
  End If
 End With
End Sub
Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
   Call Cxxswbk
End Sub
Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  Fun_Drfrmyxxpd = True
  With WglrGrid
   
   '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  
   If Ydtext.Visible Or YdCombo.Visible Then
        Call Lrsjhx
        If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
           Fun_Drfrmyxxpd = False
           Exit Function
        End If
   End If
   
   '进行行有效性判断
   If Not Sjhzyxxpd(.Row) Then
      Fun_Drfrmyxxpd = False
      Exit Function
   End If
   
  End With
End Function

Private Sub Option1_Click()
    Flag.Text = "0"
    Call Sub_Query
End Sub

Private Sub Option2_Click()
    Flag.Text = "1"
    Call Sub_Query
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_LostFocus()                                    '录入网格失去焦点

  '用以屏蔽调用其它窗体时发生网格失去焦点事件
  If Changelock Then
     Exit Sub
  End If

  '引发网格RowcolChange事件
  With WglrGrid
    If Not (Ydtext.Visible Or YdCombo.Visible) Then
       .Select 0, 0
    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
 
 With WglrGrid
  If Ydtext.Visible Or YdCombo.Visible Then
     Gdtlock = True
     .TopRow = Dqtoprow
     .LeftCol = Dqleftcol
     Gdtlock = False
     Exit Sub
  End If
  
 End With
End Sub
Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  If Changelock Then
     Exit Sub
  End If

  '记录刚刚离开网格单元的行列值
  Dqlkwgh = WglrGrid.Row
  Dqlkwgl = WglrGrid.Col

  '判断是否需要录入数据回写
  If Not (Ydtext.Visible Or YdCombo.Visible) Then
     Exit Sub
  End If
  Call Lrsjhx
End Sub