frmsfgz.frm

采用面向负荷控制技术

            Caption         =   "参数"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   210
            Left            =   1320
            TabIndex        =   3
            Top             =   960
            Width           =   420
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Caption         =   "算法代号*"
            BeginProperty Font 
               Name            =   "宋体"
               Size            =   10.5
               Charset         =   134
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   210
            Index           =   0
            Left            =   960
            TabIndex        =   2
            Top             =   360
            Width           =   945
         End
      End
      Begin MSDataGridLib.DataGrid DataGrid3 
         Height          =   5535
         Left            =   -74040
         TabIndex        =   42
         Top             =   3360
         Width           =   12255
         _ExtentX        =   21616
         _ExtentY        =   9763
         _Version        =   393216
         HeadLines       =   1
         RowHeight       =   15
         BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ColumnCount     =   2
         BeginProperty Column00 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column01 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         SplitCount      =   1
         BeginProperty Split0 
            BeginProperty Column00 
            EndProperty
            BeginProperty Column01 
            EndProperty
         EndProperty
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As New ADODB.Recordset
Option Explicit
Dim mconn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset


Private Sub Cmdadd2_Click()
Dim i As Integer
    Cmdadd2.Enabled = False
    Cmddel2.Enabled = False
    Cmdok2.Enabled = True
    Cmdcancel2.Enabled = True
    DataGrid3.Enabled = False
    For i = 0 To rs2.Fields.Count - 1
       text2(i) = ""
    Next
    text2(0).SetFocus
End Sub


Private Sub Cmdcancel2_Click()
  Cmdadd2.Enabled = True
  Cmddel2.Enabled = True
  Cmdok2.Enabled = False
  'Cmdcancel3.Enabled = False
  DataGrid2.Enabled = True

End Sub

Private Sub Cmddel2_Click()
Dim yn As Integer
    yn = MsgBox("确认删除吗？", vbYesNo)
    If yn = vbNo Then
        Exit Sub
    End If
    rs2.Delete
    If rs2.EOF Then
       rs2.MoveLast
    Else
        rs2.MoveNext
    End If
    Call opengz
End Sub

Private Sub Cmdexit2_Click()
  Cmdadd2.Enabled = True
  Cmddel2.Enabled = True
  Cmdok2.Enabled = False
  Cmdcancel2.Enabled = False
  DataGrid3.Enabled = True
  Unload Me
End Sub

Private Sub Cmdok2_Click()
Dim i As Integer, ss As String
'On Error GoTo ErrMsg
    rs2.AddNew
    For i = 0 To rs2.Fields.Count - 1
        ss = CStr(Trim(text2(i).Text))
        rs2(i) = ss
    Next i
    rs2.Update
  Cmdadd2.Enabled = True
  Cmddel2.Enabled = True
  Cmdok2.Enabled = False
  Cmdcancel2.Enabled = False
  DataGrid3.Enabled = True
   Call opengz

End Sub


Private Sub comadd_Click()
Dim findrs As New ADODB.Recordset
  Dim msg As Integer
  msg = MsgBox("您确实要输入此想信息吗？", vbYesNo + vbQuestion)
  If msg = vbYes Then
      If Trim$(txtsfcode.Text) = "" Then
       MsgBox "请您输入算法代号!", vbExclamation + vbInformation
       Exit Sub
      End If
        If Trim$(txtsfname.Text) = "" Then
           MsgBox "请您输入算法名称！", vbExclamation + vbInformation
           Exit Sub
        End If
        If Trim$(txtsflx.Text) = "" Then
          MsgBox "请您输入问题类型！", vbExclamation + vbInformation
           Exit Sub
        End If
      
        If Trim$(txtsfcsh.Text) = "" Then
           MsgBox "请您输入算法的参数信息！", vbExclamation + vbInformation
           Exit Sub
        End If
         If Trim$(txtsfmsh.Text) = "" Then
           MsgBox "请您输入加载算法！", vbExclamation + vbInformation
           Exit Sub
        End If
                Set findrs = Nothing
                findrs.ActiveConnection = "dsn=dbw;uid=sa"
                findrs.CursorLocation = adUseClient
                findrs.CursorType = adOpenKeyset
                findrs.LockType = adLockOptimistic
                findrs.Source = "select * from t_Algorithm where sfcode='" & Trim$(txtsfcode.Text) & "'"
                findrs.Open
                If findrs.RecordCount <> 0 Then
                  MsgBox "本算法已经存在或算法代号重复！！", vbExclamation + vbInformation
                  Exit Sub
                End If
                rs.AddNew
                rs("sfcode") = Trim$(txtsfcode)
                rs("sfname") = Trim$(txtsfname)
                rs("sflx") = Trim$(txtsflx)
                rs("sfcsh") = Trim$(txtsfcsh)
                rs("sfmsh") = Trim$(txtsfmsh)
                If txtnote.Text <> "" Then rs("note") = CStr(txtnote.Text)
                rs.Update
                If rs.RecordCount <> 0 Then
                  comupdate.Enabled = True
                  comdelete.Enabled = True
                End If
                
   End If
End Sub

Private Sub comadd1_Click()
  Dim findrs As New ADODB.Recordset
  Dim msg As Integer
  msg = MsgBox("您确实要输入此信息吗？", vbYesNo + vbQuestion)
  If msg = vbYes Then
      If Trim$(txtcode.Text) = "" Then
       MsgBox "请您输入知识代号!", vbExclamation + vbInformation
       Exit Sub
      End If
        If Trim$(txtname.Text) = "" Then
           MsgBox "请您输入知识名称！", vbExclamation + vbInformation
           Exit Sub
        End If
        If Trim$(txtwt.Text) = "" Then
          MsgBox "请您输入问题类型！", vbExclamation + vbInformation
           Exit Sub
        End If
      
        If Trim$(txtmodel.Text) = "" Then
           MsgBox "请您输入车间模式！", vbExclamation + vbInformation
           Exit Sub
        End If
         If Trim$(txtdd.Text) = "" Then
           MsgBox "请您输入调度目标！", vbExclamation + vbInformation
           Exit Sub
        End If
        If Trim$(txtsf.Text) = "" Then
           MsgBox "请您输入算法代号！", vbExclamation + vbInformation
           Exit Sub
        End If
        
                Set findrs = Nothing
                findrs.ActiveConnection = "dsn=dbw;uid=sa"
                findrs.CursorLocation = adUseClient
                findrs.CursorType = adOpenKeyset
                findrs.LockType = adLockOptimistic
                findrs.Source = "select * from t_knowledge where zhshcode='" & Trim$(txtcode.Text) & "'"
                findrs.Open
                If findrs.RecordCount <> 0 Then
                  MsgBox "本规则已经存在或规则代号重复！！", vbExclamation + vbInformation
                  Exit Sub
                End If
                rs.AddNew
                rs("zhshcode") = Trim$(txtcode)
                rs("zhshname") = Trim$(txtname)
                rs("question") = Trim$(txtwt)
                rs("chjmodel") = Trim$(txtmodel)
                rs("sfcode") = Trim$(txtsf)
                rs("ddmb") = Trim$((txtdd.Text))
                rs.Update
                If rs.RecordCount <> 0 Then
                  Comupdate1.Enabled = True
                  Comdelete1.Enabled = True
                End If
                
   End If

End Sub

Private Sub Comclear_Click()
   Unload Me
End Sub

Private Sub comdelete_Click()
   Dim msg As Integer
  
  msg = MsgBox("您确实要删除当前记录吗？", vbYesNo + vbQuestion)
  If msg = vbYes Then
     rs.Delete
     DoEvents
     If rs.RecordCount = 0 Then
        comdelete.Enabled = False
        comupdate.Enabled = False
     End If
   End If
 
  
End Sub

Private Sub Comdelete1_Click()
    Dim msg As Integer
  
  msg = MsgBox("您确实要删除当前记录吗？", vbYesNo + vbQuestion)
  If msg = vbYes Then
     rs.Delete
     DoEvents
     If rs.RecordCount = 0 Then
        comdelete.Enabled = False
        comupdate.Enabled = False
     End If
   End If
 
End Sub

Private Sub comfind_Click()
    Dim lens As Integer
 Dim sql As String
 Dim find As String
 Dim msg As Integer
 Dim i As Integer
 
       sql = "select * from t_algorithm  "
        find = ""
            If Trim$(txtsfcode) <> "" Then
               find = "where sfcode='" & Trim$(txtsfcode.Text) & "'"
            End If
             
            If Trim$(txtsfname.Text) <> "" Then
              If find <> "" Then
                find = find & " and sfname='" & Trim$(txtsfname.Text) & "'"
              Else
                find = " where sfname='" & Trim$(txtsfname.Text) & "'"
              End If
            End If
            If Trim$(txtsflx.Text) <> "" Then
                If find <> "" Then
                  find = find & " and sflx='" & Trim$(txtsflx.Text) & "'"
                Else
                  find = "where sflx='" & Trim$(txtsflx.Text) & "'"
                End If