VB开发的ERP系统

Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
   Valilock = True       '屏蔽文本框失去焦点进行有效性判断
   With WglrGrid
     If Changelock Then
        Exit Sub
     End If
     If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
        Exit Sub
     End If
     If .Row <> Dqlkwgh Then
        If Not Sjhzyxxpd(Dqlkwgh) Then
           Exit Sub
        End If
     End If
   End With
   Call fhyxh
   Call Xldql
   
End Sub


Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
    Dim Jsq As Integer
    Dim strTemp As String
    Dim DblTemp As Double
    Dim BlTemp As Boolean
    
    With WglrGrid
        If .TextMatrix(.Row, 0) = "*" Then
            If .Col <> Sydz("010", GridStr(), Szzls) Then
                If Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))) <> "*" And Abs(Val(.TextMatrix(.Row, Sydz("008", GridStr(), Szzls)))) - Abs(Val(.TextMatrix(.Row, Sydz("009", GridStr(), Szzls)))) > 0 Then
                    .TextMatrix(.Row, 1) = "*"
                    .TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = "*"
                    .TextMatrix(.Row, Sydz("010", GridStr(), Szzls)) = Val(.TextMatrix(.Row, Sydz("008", GridStr(), Szzls))) - Val(.TextMatrix(.Row, Sydz("009", GridStr(), Szzls)))
                Else
                    .TextMatrix(.Row, 1) = ""
                    .TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = ""
                    .TextMatrix(.Row, Sydz("010", GridStr(), Szzls)) = ""
                End If
                Call Sub_Total(.Row)
            Else
                Call xswbk
            End If
        End If
    End With
End Sub
Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框
 Valilock = True
   Ydtext.Visible = False
   YdCombo.Visible = False
   Ydcommand.Visible = False
End Sub
Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  With WglrGrid
    Select Case KeyCode
      Case vbKeyEscape                'ESC 键放弃录入
           Valilock = True
            .SetFocus
            Call Ycwbk
           Valilock = False
      Case vbKeyReturn                '回 车 键 =13
           KeyCode = 0
           .SetFocus
           Call Lrsjhx
           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
            .Select Rowjsq, Coljsq
       Case vbKeyLeft                  '左 箭 头 =37
           If .Col - 1 = Qslz Then
              If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                 GoTo jzzx
              End If
           End If
           If .Col > Qslz Then
              KeyCode = 0
              .SetFocus
              Call Lrsjhx
              Coljsq = .Col - 1
              Do While Coljsq > Qslz
                 If Coljsq - 1 = Qslz Then
                    If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                       GoTo jzzx
                    End If
                 End If
                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                    Coljsq = Coljsq - 1
                 Else
                      Exit Do
                 End If
               Loop
               .Select .Row, Coljsq
           End If

      Case vbKeyRight                 '右 箭 头 =39
            KeyCode = 0
            .SetFocus
            Call Lrsjhx
             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
              .Select Rowjsq, Coljsq
      Case Else
   End Select
   
jzzx:
   
 End With
End Sub
Private Sub YdCombo_LostFocus()
  With WglrGrid                                    '因为选中网格会先发生Rowcolchange事件置Valiock
    If Not Valilock Then                           '为TRUE
       Call Lrsjhx
       If Not Sjhzyxxpd(Dqlrwgh) Then
          Exit Sub
       End If
    End If
  End With
End Sub
Private Sub Ydcommand_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
   Call Lrzdbz
End Sub
Private Sub ydtext_KeyDown(KeyCode As Integer, Shift As Integer)
   Dim Rowjsq As Long, Coljsq As Long
  With WglrGrid
    Select Case KeyCode
      Case vbKeyF2
           Call Lrzdbz
      Case vbKeyEscape                'ESC 键放弃录入
           Valilock = True
            Call Ycwbk
           .SetFocus
      Case vbKeyReturn                '回 车 键 =13
           KeyCode = 0
           .SetFocus
           Call Lrsjhx
           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
               .Select Rowjsq, Coljsq
            End If
      Case vbKeyUp                    '上 箭 头 =38
           KeyCode = 0
           .SetFocus
           Call Lrsjhx
           If .Row > .FixedRows Then
              .Row = .Row - 1
           End If
      Case vbKeyDown                  '下 箭 头 =40
           KeyCode = 0
           .SetFocus
           Call Lrsjhx
           If .Row < .Rows - 1 Then
              .Row = .Row + 1
           End If
       Case vbKeyLeft                  '左 箭 头 =37
           If .Col - 1 = Qslz Then
              If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                 GoTo jzzx
              End If
           End If
           If Ydtext.SelStart = 0 And .Col > Qslz Then
              KeyCode = 0
              .SetFocus
              Call Lrsjhx
              Coljsq = .Col - 1
              Do While Coljsq > Qslz
                 If Coljsq - 1 = Qslz Then
                    If .ColHidden(Qslz) Or (Not GridBoolean(Qslz, 1)) Then
                       GoTo jzzx
                    End If
                 End If
                 If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                    Coljsq = Coljsq - 1
                 Else
                      Exit Do
                 End If
               Loop
               .Select .Row, Coljsq
           End If
jzzx:
           
           
      Case vbKeyRight                 '右 箭 头 =39
            wblong = Len(Ydtext.Text)
            If (Ydtext.SelStart = wblong Or Ydtext.SelLength = wblong) Then
               KeyCode = 0
               .SetFocus
               Call Lrsjhx
                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
                 .Select Rowjsq, Coljsq
               End If
      Case Else
   End Select
 End With
End Sub
Private Sub ydtext_KeyPress(KeyAscii As Integer)         '录入字符事中控制
  Call InputFieldLimit(Ydtext, GridInt(WglrGrid.Col, 1), KeyAscii)
End Sub
Private Sub ydtext_Change()                              '录入事中变化处理

  '防止程序改变但不进行处理

  If Wbkbhlock Then
     Exit Sub
  End If

  With WglrGrid

    '限制字段录入长度
     Wbkbhlock = True
     Call TextChangeLimit(Ydtext, GridInt(.Col, 1))  '去掉无效字符

       Select Case GridInt(.Col, 1)
          Case 8
            Call Sjgskz(Ydtext, Xtjezws - Xtjexsws - 1, Xtjexsws)
          Case 9
            Call Sjgskz(Ydtext, Xtslzws - Xtslxsws - 1, Xtslxsws)
          Case 10
            Call Sjgskz(Ydtext, Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
          Case Else
             If GridInt(.Col, 3) <> 0 Or GridInt(.Col, 4) <> 0 Then
                Call Sjgskz(Ydtext, GridInt(.Col, 3), GridInt(.Col, 4))
             End If
       End Select
      Wbkbhlock = False
  End With
End Sub
Private Sub ydtext_LostFocus()            '如果由于选中网格之外的控件而发生有效性判断(选中网格会先发生Rowcolchange事件置Valiock为TRUE)
  With WglrGrid
    If Not Valilock Then
       Call Lrsjhx
       If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
          Exit Sub
       End If
       If Not Sjhzyxxpd(Dqlrwgh) Then
          Exit Sub
       End If
    End If
  End With
End Sub
Private Sub xswbk()                       '在当前选中单元显示文本框,列表框,帮助按钮(通用)
  Dim Wbkpy As Integer, Wbkpy1 As Integer '文本框偏移量
  
  '如果单据操作状态为浏览状态则不能显示录入载体
   If Trim(Lab_OperStatus.Caption) = "1" Then
      Exit Sub
   End If
   
       
  '显示文本框前返回有效行列（解决滚动条问题）
  Call Xldqh
  Call Xldql
  
  '隐藏文本框,帮助按钮,列表组合框
  Call Ycwbk
  
    With WglrGrid
        Dqlrwgh = .Row
        Dqlrwgl = .Col
        If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
           Exit Sub
        End If
         
        Wbkpy = 30
        Wbkpy1 = 15
        On Error Resume Next
    
    If GridBoolean(.Col, 3) Then
       YdCombo.Left = .CellLeft + .Left + Wbkpy
       YdCombo.Top = .CellTop + .Top + Wbkpy
       YdCombo.Width = .CellWidth - Wbkpy1
       Call Wbkcl
       YdCombo.Visible = True
       YdCombo.SetFocus
       Ydcommand.Visible = False
       Ydtext.Visible = False
    Else
      If GridBoolean(.Col, 2) Then
        Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
        Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
        Ydcommand.Visible = True
      Else
        Ydcommand.Visible = False
      End If