VB开发的ERP系统

     
      Ydtext.Left = .CellLeft + .Left + Wbkpy
      Ydtext.Top = .CellTop + .Top + Wbkpy
      If Ydcommand.Visible Then
        If Sfblbzkd Then
         Ydtext.Width = .CellWidth - Ydcommand.Width
        Else
         Ydtext.Width = .CellWidth - Wbkpy1
        End If
      Else
         Ydtext.Width = .CellWidth - Wbkpy1
      End If
      Ydtext.Height = .CellHeight - Wbkpy1
      
      If GridInt(.Col, 2) <> 0 Then
         Ydtext.MaxLength = GridInt(.Col, 2)
      Else
         Ydtext.MaxLength = 3000
      End If
      
      Call Wbkcl
      
      Ydtext.Visible = True
      Ydtext.SetFocus
    End If
    Dqtoprow = .TopRow
    Dqleftcol = .LeftCol
    
    '重置锁值
    Valilock = False
    Wbkbhlock = False
 End With
End Sub
Private Sub Cxxswbk()                                                  'Formresize中重新显示文本框,列表框,帮助按钮(通用)
                   
  Dim Wbkpy As Integer, Wbkpy1 As Integer
  Wbkpy = 30
  Wbkpy1 = 15
  With WglrGrid
     If YdCombo.Visible Then
       YdCombo.Left = .CellLeft + .Left + Wbkpy
       YdCombo.Top = .CellTop + .Top + Wbkpy
       YdCombo.Width = .CellWidth - Wbkpy1
     End If
     If Ydcommand.Visible Then
       Ydcommand.Left = .Left + .CellLeft + .CellWidth - Ydcommand.Width + Wbkpy
       Ydcommand.Top = .Top + .CellTop + .CellHeight - Ydcommand.Height + Wbkpy
     End If
     If Ydtext.Visible Then
       If Ydcommand.Visible Then
         If Sfblbzkd Then
         Ydtext.Width = .CellWidth - Ydcommand.Width
        Else
         Ydtext.Width = .CellWidth - Wbkpy1
        End If
       Else
         Ydtext.Width = .CellWidth - Wbkpy1
       End If
      
       Ydtext.Left = .CellLeft + .Left + Wbkpy
       Ydtext.Top = .CellTop + .Top + Wbkpy
       Ydtext.Height = .CellHeight - Wbkpy1
     End If
   End With

End Sub
Private Sub Lrsjhx()                                                   '文本框录入数据回写
  With WglrGrid
   If YdCombo.Visible Then
    .Text = Trim(YdCombo.Text)
   End If
   If Ydtext.Visible Then
    .Text = Trim(Ydtext.Text)
   End If
   
   '(如果字段录入内容发生变化,则打开有效性判断锁)
   If Zdlrqnr <> Trim(.Text) Then
      Yxxpdlock = False
      Hyxxpdlock = False
   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
           .Select Rowjsq, Coljsq
        End If
      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 xswbk
            Ydtext.Text = ""
            Valilock = True
              SendKeys Chr(KeyAscii), wait
              DoEvents
            Valilock = False

          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
      Call Xldqh
   End If
  End With
End Sub
Private Sub Xldqh() '显露当前行
On Error Resume Next
  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
       .TopRow = .TopRow - 1
    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 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 Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序

  '以下为依据实际情况自定义部分[
  
      '在此填写文本框录入事后处理程序
   
  ']以上为依据实际情况自定义部分
End Sub
Private Sub LrText_Change(Index As Integer)

   '屏蔽程序改变控制
   If TextChangeLock Then
      Exit Sub
   End If
   
   TextValiJudgeLock(Index) = False    '打开有效性判断锁
    
    '限制字段录入长度
          
     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
    Call TextChangeLimit(LrText(Index), Textint(Index, 1))  '去掉无效字符
     
        Select Case Textint(Index, 1)
           Case 8           '金额型
             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
           Case 9           '数量型
             Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
           Case 10          '单价型
             Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
           Case Else        '其他小数类型控制
              If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
                 Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
              End If
        End Select
     TextChangeLock = False '解锁
End Sub
Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
   Call TextShow(Index)
   CurTextIndex = Index
   LrText(Index).SelStart = Len(LrText(Index))
End Sub
Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
   Select Case KeyCode
      Case vbKeyF2
        Call Text_Help(Index)
   End Select
End Sub
Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
   Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
End Sub
Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
  If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
     Call TextYxxpd(Index)
  End If
End Sub
Private Sub Ydcommand1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
   Call Text_Help(Index)
End Sub
Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  If Not Textboolean(Index, 1) Then
     Exit Sub
  End If
   TextValiJudgeLock(Index) = True
   
     '先进行有效性判断
     If Not TextYxxpd(CurTextIndex) Then
        Exit Sub
     End If
   
     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
     If Len(Xtfhcs) <> 0 Then
        If Textint(Index, 3) = 1 Then
           LrText(Index).Text = Xtfhcsfz
           LrText(Index).Tag = Xtfhcs
        Else
           LrText(Index).Text = Xtfhcs
           LrText(Index).Tag = Xtfhcsfz
        End If
'        Call Sub_Query
     End If
   TextValiJudgeLock(Index) = False
   LrText(Index).SetFocus
End Sub
Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息

   '填写文本框得到焦点,进行相应信息处理程序
   
End Sub
Private Sub Wbkcsh()                          '录入文本框初始化
  Dim Jsqte As Integer
  
  '最大录入文本框索引值
  Max_Text_Index = Textvar(1)
  
  ReDim TextValiJudgeLock(Max_Text_Index)
  For Jsqte = 0 To Max_Text_Index
     
     If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
        If Textboolean(Jsqte, 1) Then
            If Jsqte <> 0 And Not Textboolean(Jsqte, 3) Then
                Load Ydcommand1(Jsqte)
            End If
            Ydcommand1(Jsqte).Visible = True
            Ydcommand1(Jsqte).Move LrText(Jsqte).Left + LrText(Jsqte).Width, LrText(Jsqte).Top
        End If
        TextChangeLock = True
         LrText(Jsqte).Text = ""
         LrText(Jsqte).Tag = ""
         If Textint(Jsqte, 5) <> 0 Then
            LrText(Jsqte).MaxLength = Textint(Jsqte, 5)
         End If
        TextChangeLock = False
     End If
     TextValiJudgeLock(Jsqte) = True
  Next Jsqte
End Sub
Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  Dim Sqlstr As String
  Dim Findrec As ADODB.Recordset
  If TextValiJudgeLoc