+

VB开发的ERP系统

         Index           =   4
         Left            =   6075
         TabIndex        =   22
         Top             =   210
         Width           =   915
      End
      Begin VB.Label Lab_Mark 
         Caption         =   "待选项目:"
         Height          =   165
         Index           =   3
         Left            =   2220
         TabIndex        =   21
         Top             =   195
         Width           =   825
      End
   End
   Begin VB.TextBox Txt_FLimit 
      Height          =   2295
      Left            =   105
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   90
      Width           =   9885
   End
End
Attribute VB_Name = "Stand_FrmLimit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'*    模 块 名 称 :标准表限定条件
'*    功 能 描 述 :设置标准表的限定条件。
'*    程序员姓名  :田建秀
'*    最后修改人  :田建秀
'*    最后修改时间:2002/01/04
'*    备        注:
'*******************************************************

Option Explicit
Const STATUS_VIEW As Integer = 0
Const STATUS_ADD As Integer = 1
Const STATUS_EDIT As Integer = 2
Dim cn As Connection
Dim sFieldOld As String
Dim iNowState As Integer
Dim Sql As String
Dim Rsc As New ADODB.Recordset

Private Sub Cmd_Save_Click()
    Dim cQuerys As New CQuery
    Dim sSqlWhere As String
    '验证限定条件
    Set cQuerys.PB_CheckStatus = Me.PB_CheckStatus
    If cQuerys.CheckFormula(Trim(Me.Txt_FLimit.Text)) = True Then
        sSqlWhere = cQuerys.FormulaSQL
        Me.Txt_FLimit.Text = cQuerys.FormulaOld
        '存储限定条件
        If Rsc.State = 1 Then Rsc.Close
        Sql = "select * from PM_StandTbl where BzbNO=" & _
            Stand_FrmFirst.CzxsGrid.TextMatrix(Stand_FrmFirst.CzxsGrid.Row, 0)
        Rsc.Open Sql, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With Rsc
            !BzbConUser = Trim(Txt_FLimit.Text)
            !BzbCond = sSqlWhere
            .Update
        End With
     
        On Error GoTo Err1
        With Cw_DataEnvi.DataConnect
            .BeginTrans
            .Execute Sql
            .CommitTrans
        End With
        Call Xtxxts("保存成功!", 0, 4)
        Unload Me
        Exit Sub
    Else
        Exit Sub
    End If
Err1:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Call Xtxxts("保存不成功!", 0, 1)
End Sub

Private Sub Cmd_Cancel_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    InitView Me.TV_PreField, " ltrim(rtrim(TableName))= 'rs_basicInfo' or ltrim(rtrim(TableName))= 'rs_ExtendInfo'" '填充字段树
    If Rsc.State = 1 Then Rsc.Close
    Sql = "select * from PM_StandTbl where BzbNO=" & _
        Stand_FrmFirst.CzxsGrid.TextMatrix(Stand_FrmFirst.CzxsGrid.Row, 0)
    Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)
    If Not Rsc.EOF Then
        Me.Txt_FLimit.Text = Trim(Rsc!BzbConUser & "")
    Else
       Call Xtxxts("这一标准表已被删除!", 0, 1)
       Unload Me
    End If
End Sub
Private Sub Cmd_Change_Click()
    '交换数字和操作符
    With Me.Fm_Number
    If Trim(.Caption) = "数字符号:" Then
        Cmd_Number(0).Caption = " +"
        Cmd_Number(1).Caption = " -"
        Cmd_Number(2).Caption = " *"
        Cmd_Number(3).Caption = " /"
        Cmd_Number(4).Caption = " ="
        Cmd_Number(5).Caption = " <>"
        Cmd_Number(6).Caption = " >"
        Cmd_Number(7).Caption = " >="
        Cmd_Number(8).Caption = " <"
        Cmd_Number(9).Caption = " <="
        Cmd_Number(10).Caption = " ("
        Cmd_Number(11).Caption = " )"
        Cmd_Number(12).Caption = " OR"
        .Caption = "运算符号:"
    Else
        Cmd_Number(0).Caption = "1"
        Cmd_Number(1).Caption = "2"
        Cmd_Number(2).Caption = "3"
        Cmd_Number(3).Caption = "4"
        Cmd_Number(4).Caption = "5"
        Cmd_Number(5).Caption = "6"
        Cmd_Number(6).Caption = "7"
        Cmd_Number(7).Caption = "8"
        Cmd_Number(8).Caption = "9"
        Cmd_Number(9).Caption = "0"
        Cmd_Number(10).Caption = "%"
        Cmd_Number(11).Caption = "."
        Cmd_Number(12).Caption = " AND"
        .Caption = "数字符号:"
      End If
    End With
End Sub
Private Sub Cmd_Number_Click(Index As Integer)
    '向本框中添加数字或操作符
    Dim s As String
    s = Me.Cmd_Number(Index).Caption
'        添加限定条件
    With Me.Txt_FLimit
        If .SelLength <> 0 Then
            .Text = ReplByPos(.Text, s, .SelStart + 1, .SelStart + .SelLength + 1)
        Else
            .Text = .Text & s
        End If
    End With

    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set Rsc = Nothing
End Sub

Private Sub TV_PreField_BeforeLabelEdit(Cancel As Integer)
    Cancel = 1
End Sub


Private Sub TV_PreField_DblClick()
    '添加此字段到相应位置
    Dim nod As Node
    With Me.TV_PreField
        '如果当前没有选中接点,退出
        Set nod = .SelectedItem
        If nod Is Nothing Then
            Exit Sub
        End If
        '如果不是字段.退出
        If nod.Children <> 0 Then
            Set nod = Nothing
            Exit Sub
        End If
        '如果是根结点,推出
        If nod.Parent Is Nothing Then
            Exit Sub
        End If
        '添加节点到相应位置
        Me.Txt_FLimit.Text = Me.Txt_FLimit.Text & " " & nod.Parent.Text & "." & nod.Text

    End With
    '如果当前节点有相关帮助,并且不是上一次选中的节点,填充相关帮助
    If sFieldOld <> nod.Key Then
        FillValue2TV nod.Tag, Me.TV_FieldValue
        sFieldOld = nod.Key
    End If
    Set nod = Nothing
End Sub
Private Sub TV_FieldValue_BeforeLabelEdit(Cancel As Integer)
    Cancel = 1
End Sub

Private Sub TV_FieldValue_NodeClick(ByVal Node As MSComctlLib.Node)
    '添加字段到相应位置
    Dim nod As Node
    With Me.TV_FieldValue
        Set nod = .SelectedItem
        If nod Is Nothing Then
            Exit Sub
        End If
        If nod.Parent Is Nothing Then
            Set nod = Nothing
            Exit Sub
        End If
        Me.Txt_FLimit.Text = Me.Txt_FLimit.Text & " " & nod.Text
    End With
    Set nod = Nothing
    
End Sub
Private Sub Cmd_Guide_Click()
    Dim s As String
    Dim frm As New Formula_Guide_Frm
    
    With frm
        .Show 1
        s = .sFunction
    End With
    
    
    '向文本框中添加函数
    If s <> "" Then
        '添加限定条件
        With Me.Txt_FLimit
            If .SelLength <> 0 Then
                .Text = ReplByPos(.Text, s, .SelStart + 1, .SelStart + .SelLength + 1)
            Else
                .Text = .Text & " " & s
            End If
        End With
    End If
    Set frm = Nothing
End Sub