¿

VB开发的ERP系统

    End If
    TextValiJudgeLock(Index) = False    '打开有效性判断锁
    
    '限制字段录入长度
    
    TextChangeLock = True  '加锁(防止执行Lrtext_Change)
    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 13
        SendKeys "{TAB}"
    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_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case 13
        SendKeys "{TAB}"
    End Select
    
End Sub

Private Sub YDCommand1_KeyPress(Index As Integer, KeyAscii As Integer)
    Select Case KeyCode
    Case 13
        SendKeys "{TAB}"
    End Select
    
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
    End If
    If Index = 2 Then
        Dim RecTemp As New ADODB.Recordset     '临时使用动态集
        Dim TempStr As String
        Dim tDept, tPerson, tCus, tSupplier, tItem As Boolean
        Dim tItemclass  As String
        TempStr = "SELECT * FROM cwzz_acccode Where ccode='" & Xtfhcs & "' or ccode='" & Xtfhcs & "'"
        Set RecTemp = Cw_DataEnvi.dataconnect.Execute(TempStr)
        If Not RecTemp.EOF Then
            tDept = Trim(RecTemp.Fields("deptflag"))
            tPerson = Trim(RecTemp.Fields("personflag"))
            tCus = Trim(RecTemp.Fields("cusflag"))
            tItem = Trim(RecTemp.Fields("itemflag"))
            tSupplier = Trim(RecTemp.Fields("supplierflag"))
            tItemclass = Trim(RecTemp.Fields("itemclasscode") & "")
        End If
        Frame1.Enabled = False
        For i = 3 To 8
            LrText(i).Enabled = False
            YDCommand1(i).Enabled = False
        Next i
        For i = 3 To 8
            LrText(i).Text = ""
        Next i
        Label4.Enabled = False
        Label6.Enabled = False
        Label7.Enabled = False
        Label8.Enabled = False
        Label11.Enabled = False
        Label1.Enabled = False
        If tDept = True Then
            Frame1.Enabled = True
            Label6.Enabled = True
            LrText(3).Enabled = True
            YDCommand1(3).Enabled = True
        End If
        If tPerson = True Then
            Frame1.Enabled = True
            Label4.Enabled = True
            LrText(4).Enabled = True
            YDCommand1(4).Enabled = True
        End If
        If tItemclass <> "" Then
            Frame1.Enabled = True
            Label8.Enabled = True
            LrText(5).Enabled = True
            YDCommand1(5).Enabled = True
        End If
        If tItem = True Then
            Frame1.Enabled = True
            Label11.Enabled = True
            LrText(6).Enabled = True
            YDCommand1(6).Enabled = True
        End If
        If tCus = True Then
            Frame1.Enabled = True
            Label7.Enabled = True
            LrText(7).Enabled = True
            YDCommand1(7).Enabled = True
        End If
        If tSupplier = True Then
            Frame1.Enabled = True
            Label1.Enabled = True
            LrText(8).Enabled = True
            YDCommand1(8).Enabled = True
        End If
    End If
    
    TextValiJudgeLock(Index) = False
    If Index <> 2 Then
        LrText(Index).SetFocus
    End If
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, 1) 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 TextValiJudgeLock(Index) Then    '文本框内容未曾改变不进行有效性判断
        TextYxxpd = True
        Exit Function
    End If
    If Trim(LrText(Index)) = "" Then
        LrText(Index).Tag = ""
        Call Wbklrwbcl(Index)
        TextValiJudgeLock(Index) = True
        TextYxxpd = True
        Exit Function
    End If
    Select Case Textint(Index, 4)
    Case 1      '编码型
        Sqlstr = Trim(Textstr(Index, 5))
        Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
        Set Findrec = Cw_DataEnvi.dataconnect.Execute(Sqlstr)
        If (Index = 3 Or Index = 6) And Trim(LrText(Index).Text) = "*" Then
            TextValiJudgeLock(Index) = True
            TextYxxpd = True
            Exit Function
        End If
        If Findrec.EOF Then
            Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
            LrText(Index).SetFocus
            Exit Function
        Else
            Select Case Textint(Index, 3)
            Case 0
                If Len(Trim(Textstr(Index, 2))) <> 0 Then
                    LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
                End If
                If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
                    LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
                End If
            Case 1
                If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
                    LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
                End If
                If Len(Trim(Textstr(Index, 2))) <> 0 Then
                    If Index = 2 Then
                        Frame1.Enabled = False
                        For i = 3 To 8
                            LrText(i).Enabled = False
                            YDCommand1(i).Enabled = False
                        Next i
                        Label4.Enabled = False
                        Label6.Enabled = False
                        Label7.Enabled = False
                        Label8.Enabled = False
                        Label11.Enabled = False
                        Label1.Enabled = False
                        If Trim(Findrec.Fields("deptflag")) = True Then
                            Frame1.Enabled = True
                            Label6.Enabled = True
                            LrText(3).Enabled = True
                            YDCommand1(3).Enabled = True
                        End If
                        If Trim(Findrec.Fields("personflag")) = True Then
                            Frame1.Enabled = True
                            Label4.Enabled = True
                            LrText(4).Enabled = True
                            YDCommand1(4).Enabled = True
                        End If
                        If Trim(Findrec.Fields("itemclasscode")) <> "" Then
                            Frame1.Enabled = True
                            Label8.Enabled = True
                            LrText(5).Enabled = True
                            YDCommand1(5).Enabled = True
                        End If
                        If Trim(Findrec.Fields("itemflag")) = True Then
                            Frame1.Enabled = True
                            Label11.Enabled = True
                            LrText(6).Enabled = True
                            YDCommand1(6).Enabled = True
                        End If
                        If Trim(Findrec.Fields("cusflag")) = True Then
                            Frame1.Enabled = True
                            Label7.Enabled = True
                            LrText(7).Enabled = True
                            YDCommand1(7).Enabled = True
                        End If
                        If Trim(Findrec.Fields("supplierflag")) = True Then
                            Frame1.Enabled = True
                            Label1.Enabled = True
                            LrText(8).Enabled = True
                            YDCommand1(8).Enabled = True
                        End If
                    End If
                    LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
                End If
            End Select
        End If
    Case 2      '日期型
        If IsDate(LrText(Index).Text) Then
            LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
        Else
            Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(Index).SetFocus
            Exit Function
        End If
    Case 3      '其他类型
        '[>>开始
        Select Case Index
        Case 0
            If Not IsNumeric(LrText(0).Text) Then
                If Trim(LrText(0).Text) <> "本年" And Trim(LrText(0).Text) <> "去年" Then
                    Tsxx = "年份必须输入本年、去年或数字!"
                    Call Xtxxts(Tsxx, 0, 4)
                    Exit Function
                End If
            End If
        Case 1
            If IsNumeric(LrText(1).Text) Then
                If Val(LrText(1).Text) > 12 Or Val(LrText(1).Text) < 1 Then
                    Tsxx = "月份范围错误!"
                    Call Xtxxts(Tsxx, 0, 4)
                    LrText(1).SetFocus
                    Exit Function
                End If
            Else
                If Trim(LrText(1).Text) <> "本月" And Trim(LrText(1).Text) <> "上月" Then
                    Tsxx = "月份必须输入本月、上月或1-12数字!"
                    Call Xtxxts(Tsxx, 0, 4)
                    LrText(1).SetFocus
                    Exit Function
                End If
            End If
        End Select
        '完毕<<]
    End Select
    TextValiJudgeLock(Index) = True
    TextYxxpd = True
End Function