VB开发的ERP系统

    
    Lrzt = 1
    Call Toolbjzt
    Call Cshlrxx(Lrzt, 0)
    LrText(0).Enabled = False
    LrText(1).Enabled = True
    LrText(2).Enabled = False
    LrText(3).Enabled = False
    LrText(4).Enabled = True
    LrText(5).Enabled = True
    LrText(0).Text = Format(Xtrq, "yyyy-mm-dd")
    LrText(1).SetFocus
    XsGrid.Rows = XsGrid.FixedRows
    GsToolbar.Visible = False

End Sub
Private Sub CzxsGrid_DblClick()                                         '显示当前编码记录
    
    If CzxsGrid.Rows = CzxsGrid.FixedRows Then Exit Sub
    Lrzt = 2
    Call Toolbjzt
    Call Cshlrxx(Lrzt, Val(CzxsGrid.TextMatrix(CzxsGrid.Row, 0)))
    LrText(0).Enabled = False
    LrText(1).Enabled = False
    LrText(2).Enabled = False
    LrText(3).Enabled = False
    LrText(4).Enabled = False
    LrText(5).Enabled = False
    GsToolbar.Visible = False
    
End Sub

Private Sub Toolbjzt()                                                  'Toolbar状态(编辑状态)

    StTab.TabEnabled(1) = True
    StTab.Tab = 1
    Frame1.Enabled = True
    StTab.TabEnabled(0) = False
    CzxsGrid.Enabled = False
    
    With SzToolbar
        .Buttons("ymsz").Enabled = False
        .Buttons("dy").Enabled = False
        .Buttons("yl").Enabled = False
        .Buttons("zj").Enabled = False
        .Buttons("cx").Enabled = False
        .Buttons("Bill").Enabled = False
        .Buttons("sx").Enabled = False
        .Buttons("fq").Enabled = True
        If Lrzt = 1 Then
            .Buttons("bc").Enabled = True
            Ydcommand1(1).Visible = True
        Else
            .Buttons("bc").Enabled = False
            Ydcommand1(1).Visible = False
        End If
    End With
  
End Sub

Private Sub Toolfbjzt()                                                 'Toolbar状态(非编辑状态)

    StTab.TabEnabled(0) = True
    StTab.Tab = 0
    CzxsGrid.Enabled = True
    Frame1.Enabled = False
    StTab.TabEnabled(1) = False
    
    With SzToolbar
        If CzxsGrid.Rows = CzxsGrid.FixedRows Then
            .Buttons("ymsz").Enabled = True
            .Buttons("dy").Enabled = True
            .Buttons("yl").Enabled = True
            .Buttons("cx").Enabled = True
            .Buttons("Bill").Enabled = False
            .Buttons("zj").Enabled = True
            .Buttons("bc").Enabled = False
            .Buttons("fq").Enabled = False
            .Buttons("sx").Enabled = True
        Else
            .Buttons("ymsz").Enabled = True
            .Buttons("dy").Enabled = True
            .Buttons("yl").Enabled = True
            .Buttons("cx").Enabled = True
            .Buttons("Bill").Enabled = True
            .Buttons("zj").Enabled = True
            .Buttons("bc").Enabled = False
            .Buttons("fq").Enabled = False
            .Buttons("sx").Enabled = True
        End If
    End With
  
End Sub


Private Sub CzxsGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)           '网格列发生移动时自动交换网格索引信息
  
    Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
  
End Sub

Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)   '表格格式设置(通用)

    Select Case Button.Key
        Case "bcgs"                                       '保存表格格式
            Call Bcwggs(CzxsGrid, GridCode, GridStr())
        Case "hfmrgs"                                     '恢复默认格式
            Call Hfmrgs(CzxsGrid, GridCode, GridStr())
        Case "szxsxm"                                     '设置显示项目
            Call Szxsxm(CzxsGrid, 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
    Bbxbt(1) = " "
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  
    Call Scyxsjb(CzxsGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If
    
End Sub

'************以下为文本框录入处理程序(固定不变部分)*************'

Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  
    '以下为依据实际情况自定义部分[
    
        '在此填写文本框录入事后处理程序
        Dim Rectemp As Recordset
        
        TextChangeLock = True
        
        If Index = 1 Then
            LrText(4).Text = ""
            XsGrid.Rows = XsGrid.FixedRows
            If Trim(LrText(Index)) = "" Then
                LrText(1).Tag = ""
                LrText(2).Text = ""
                LrText(2).Tag = ""
                LrText(3).Text = ""
                LrText(4).Text = ""
                XsGrid.Clear 1
            Else
                '显示存货名称、计划单价
                Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select mnumber,mname,model,planprice,InvSortCode from gy_material where mnumber ='" & Trim(LrText(1).Text) & "'")
                LrText(1).Tag = Trim(Rectemp.Fields("invsortcode") & "")
                LrText(2).Text = Trim(Rectemp.Fields("mname") & "")
                LrText(2).Tag = Trim(Rectemp.Fields("model") & "")
                LrText(3).Text = Rectemp.Fields("planprice")
                
                With XsGrid
                    '显示结存
                    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from chhs_v_mate where kjyear=" & Xtyear & " and period=" & Xtmm & " and mnumber='" & Trim(LrText(1).Text) & "' and pricemode='计划价法' ")
                    If Not Rectemp.EOF Then
                        .Rows = .FixedRows
                        Do While Not Rectemp.EOF
                            .AddItem ""
                            .RowHeight(.Rows - 1) = Sjhgd
                            .TextMatrix(.Rows - 1, 0) = Trim(Rectemp.Fields("whcode"))
                            .TextMatrix(.Rows - 1, 1) = Trim(Rectemp.Fields("whname"))
                            .TextMatrix(.Rows - 1, 2) = Val(Rectemp.Fields("startquan")) + Val(Rectemp.Fields("inquan")) - Val(Rectemp.Fields("Outquan"))
                            .TextMatrix(.Rows - 1, 3) = Val(Rectemp.Fields("startmoney")) + Val(Rectemp.Fields("inmoney")) - Val(Rectemp.Fields("Outmoney"))
                            Rectemp.MoveNext
                        Loop
                    Else
                        .Rows = .FixedRows
                    End If
                End With
            End If
        End If
        
        Set Rectemp = Nothing
        
        TextChangeLock = False
        
    ']以上为依据实际情况自定义部分
  
End Sub

Private Sub LrText_Change(Index As Integer)

    '屏蔽程序改变控制
    If TextChangeLock Then
        Exit Sub
    End If
    
    TextValiJudgeLock(Index) = False    '打开有效性判断锁
    
    '限制字段录入长度
          
    TextChangeLock = True  '加锁(防止执行Lrtext_Change)
     
    Select Case Textint(Index, 1)
        Case 8, 11       '金额型
            Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
        Case 9, 12       '数量型
            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
        
    '计算现金额
    If Index = 4 Then
        With XsGrid
            For Jsqte = .FixedRows To .Rows - 1
                .TextMatrix(Jsqte, 4) = Format(Val(.TextMatrix(Jsqte, 2)) * Val(LrText(4)), "###0." + String(Xtjexsws, "0"))
                .TextMatrix(Jsqte, 5) = Val(.TextMatrix(Jsqte, 4)) - Val(.TextMatrix(Jsqte, 3))
            Next Jsqte
        End With
    End If
    
    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
    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
    End If
   
    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