企业管理

开发平台：
Visual Basic

+：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form Stand_FrmLimit 
   Appearance      =   0  'Flat
   BackColor       =   &H80000004&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "标准表限定条件"
   ClientHeight    =   6165
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   10110
   HelpContextID   =   221201202
   Icon            =   "基础设置_标准表限定条件.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6165
   ScaleWidth      =   10110
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin MSComctlLib.ProgressBar PB_CheckStatus 
      Height          =   420
      Left            =   150
      TabIndex        =   25
      Top             =   5685
      Visible         =   0   'False
      Width           =   7440
      _ExtentX        =   13123
      _ExtentY        =   741
      _Version        =   393216
      BorderStyle     =   1
      Appearance      =   1
      Scrolling       =   1
   End
   Begin VB.CommandButton Cmd_Cancel 
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   8880
      TabIndex        =   24
      Top             =   5760
      Width           =   1120
   End
   Begin VB.CommandButton Cmd_Save 
      Caption         =   "保存(&S)"
      Height          =   300
      Left            =   7650
      TabIndex        =   23
      Top             =   5760
      Width           =   1120
   End
   Begin VB.Frame Frame3 
      Caption         =   "标准表限定条件输入参照:"
      Height          =   3180
      Left            =   90
      TabIndex        =   1
      Top             =   2475
      Width           =   9900
      Begin VB.Frame Fm_Number 
         Caption         =   "数字符号:"
         Height          =   2790
         Left            =   105
         TabIndex        =   2
         Top             =   285
         Width           =   2010
         Begin VB.CommandButton Cmd_Change 
            Caption         =   "切换"
            Height          =   300
            Left            =   90
            TabIndex        =   18
            Top             =   315
            Width           =   1830
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   "."
            Height          =   300
            Index           =   11
            Left            =   1500
            TabIndex        =   17
            Top             =   1545
            Width           =   420
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   "%"
            Height          =   300
            Index           =   10
            Left            =   1035
            TabIndex        =   16
            Top             =   1545
            Width           =   420
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   "0"
            Height          =   315
            Index           =   9
            Left            =   555
            TabIndex        =   15
            Top             =   1545
            Width           =   420
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   "9"
            Height          =   315
            Index           =   8
            Left            =   90
            TabIndex        =   14
            Top             =   1545
            Width           =   420
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   "8"
            Height          =   300
            Index           =   7
            Left            =   1500
            TabIndex        =   13
            Top             =   1140
            Width           =   420
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   "7"
            Height          =   300
            Index           =   6
            Left            =   1035
            TabIndex        =   12
            Top             =   1140
            Width           =   420
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   "6"
            Height          =   315
            Index           =   5
            Left            =   555
            TabIndex        =   11
            Top             =   1140
            Width           =   420
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   "5"
            Height          =   315
            Index           =   4
            Left            =   90
            TabIndex        =   10
            Top             =   1140
            Width           =   420
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   "4"
            Height          =   300
            Index           =   3
            Left            =   1500
            TabIndex        =   9
            Top             =   735
            Width           =   420
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   "3"
            Height          =   300
            Index           =   2
            Left            =   1035
            TabIndex        =   8
            Top             =   750
            Width           =   420
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   "2"
            Height          =   315
            Index           =   1
            Left            =   555
            TabIndex        =   7
            Top             =   735
            Width           =   420
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   "1"
            Height          =   315
            Index           =   0
            Left            =   90
            TabIndex        =   6
            Top             =   735
            Width           =   420
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   " AND "
            Height          =   300
            Index           =   12
            Left            =   75
            TabIndex        =   5
            Top             =   1965
            Width           =   900
         End
         Begin VB.CommandButton Cmd_Guide 
            Caption         =   "函数向导"
            Height          =   300
            Left            =   75
            TabIndex        =   4
            Top             =   2355
            Width           =   1815
         End
         Begin VB.CommandButton Cmd_Number 
            Caption         =   " LIKE"
            Height          =   300
            Index           =   13
            Left            =   1035
            TabIndex        =   3
            Top             =   1965
            Width           =   870
         End
      End
      Begin MSComctlLib.TreeView TV_PreField 
         Height          =   2640
         Left            =   2205
         TabIndex        =   19
         Top             =   420
         Width           =   3795
         _ExtentX        =   6694
         _ExtentY        =   4657
         _Version        =   393217
         LabelEdit       =   1
         LineStyle       =   1
         Style           =   7
         Appearance      =   1
      End
      Begin MSComctlLib.TreeView TV_FieldValue 
         Height          =   2655
         Left            =   6075
         TabIndex        =   20
         Top             =   405
         Width           =   3690
         _ExtentX        =   6509
         _ExtentY        =   4683
         _Version        =   393217
         LabelEdit       =   1
         LineStyle       =   1
         Style           =   7
         Appearance      =   1
      End
      Begin VB.Label Lab_Mark 
         Caption         =   "关联项:"
         Height          =   195
         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

						