formd2.frm

基于VB开

               .CellBackColor = intCly
            Next
            If bytMod = 3 Then
               For i = 1 To N1
                  .Row = i
                   For j = 1 To 4
                      .Col = j: .Text = " " & arrLb(i, j)
                   Next
               Next
            End If
       End With
       Call P_clr2
       Command2.Enabled = True
       Label5.Caption = strBzs
       bytMod = IIf(Len(Trim(Text1(0).Text)) = 0, 1, 2)           ' 模式
    End If
End Sub

Private Sub Command3_Click()                                      ' 存盘处理
    strMcp = Trim(Text1(0))
    strJcp = Trim(Text1(1))
    strBzp = Trim(Text1(2))
    If bytMod = 3 Then
       StrMsg = " 确实要将排序的结果存盘吗 ？ "                   ' 排序
       If MsgBox(StrMsg, 33, " 请确认") = 1 Then
          With MSFlexGrid1
               For i = 1 To N1
                  .Row = i: strXhp = Trim(Str(i + 100))
                  .Col = 1: strDmp = Trim(.Text)
                   MyRs1.MoveFirst
                   Do While Not MyRs1.EOF
                      If MyRs1![dm] = strDmp Then
                            MyRs1![Xh] = strXhp
                         MyRs1.Update
                         Exit Do
                      End If
                      MyRs1.MoveNext
                   Loop
               Next
          End With
          Call P_clr1
          Command2.Caption = "排  序"
          Command2.Enabled = True
          Label5.Caption = strBzs
       End If
       With MSFlexGrid1
           .Row = bytRow
            For j = 1 To 4: .Col = j: .CellBackColor = intCly: Next
            bytRow = 1
            bytRoy = 1
       End With
       Exit Sub
    End If
    strMcp = Trim(Text1(0).Text)
       If Len(strMcp) = 0 Then
          Text1(0).SetFocus: Exit Sub
       End If
    strJcp = myF_Left(Trim(Text1(1).Text), 12): If Len(strJcp) = 0 Then strJcp = " "
    strBzp = myF_Left(Trim(Text1(2).Text), 30): If Len(strBzp) = 0 Then strBzp = " "
    If bytMod = 1 Then
       StrMsg = " 确实要将输入的条目存盘吗 ？ "                   ' 追加
       If MsgBox(StrMsg, 33, " 请确认") = 1 Then
          strDmp = Left(strDmp, 2) & Right((Str(Val(Right(strDmp, 3) + 10001))), 3)
          strXhp = Trim(Str(Val(strXhp) + 1))
          strMcp = myF_Left(strMcp, 30)
          strJcp = myF_Left(strJcp, 12)
          strBzp = myF_Left(strBzp, 30)
          StrSQL = "INSERT INTO  " & strT0 & "( Dm,Xh,Mc,Jc,Bz) VALUES " & _
                   "('" & strDmp & "','" & strXhp & "','" & strMcp & "','" & strJcp & "','" & strBzp & "' ) "
          cnnTce.Execute StrSQL
       End If
    Else                                                          ' 修改
       If arrTmp(bytRoy, 2) = strMcp And _
          arrTmp(bytRoy, 2) = strMcp And arrTmp(bytRoy, 2) <> strMcp Then Exit Sub
       StrMsg = " 确实要将修改的信息存盘吗 ？ "
       If MsgBox(StrMsg, 33, " 请确认") = 1 Then
          Set MyRs0 = New Recordset
          StrSQL = "Select * From " & strT0 & " Where Dm = '" & strDmd & "'"
          MyRs0.Open StrSQL, cnnTce, adOpenKeyset, adLockOptimistic
           If MyRs0.RecordCount > 0 Then
              MyRs0.MoveFirst
                 MyRs0![Mc] = myF_Left(strMcp, 30): arrTmp(bytRoy, 3) = strMcp
                 MyRs0![Jc] = myF_Left(strJcp, 12): arrTmp(bytRoy, 4) = strJcp
                 MyRs0![Bz] = myF_Left(strBzp, 30): arrTmp(bytRoy, 5) = strBzp
              MyRs0.Update
              With MSFlexGrid1
                  .Row = bytRoy
                   For i = 2 To 4
                      .Col = i: .Text = " " & arrTmp(bytRoy, i + 1)
                       Text1(i - 2).Text = ""
                   Next
              End With
              Call P_clr2
              Command2.Caption = "排  序"
              Command2.Enabled = True
              Label5.Caption = strBzs
           If strTmm = "系统" Then Call P_xgmc
           Else
              MsgBox " Not Find Datas ... ", 48, "  Error !"
           End If
       End If
    End If
       bytMod = 1
       If strDm = "Lb" Then
          Call P_ini1
          Call P_grd1
       Else
          Call P_ini2
          Call P_grd2
       End If
    Text1(0).SetFocus
End Sub

Function F_ascm(Dh As String) As String
    F_ascm = Chr(Asc(Dh) + 1)
End Function

Private Sub P_clr1()
    bytMod = 1
    Select Case strDm
           Case "Lb"
                Call P_ini0
                Call P_ini1
                Call P_grd1
           Case "Xm"
                Call P_ini0
                Call P_ini2
                Call P_grd2
    End Select
End Sub

Private Sub P_clr2()                                              ' 恢复
    Command2.Caption = "排  序"
    Command3.Caption = "确  认"
    Command2.Enabled = True
    Command3.Enabled = False
    Command4.Enabled = False
    Label5 = ""
    bytMod = 1                                                    ' 追加
       For i = 0 To 2
           Text1(i).Text = "": Text1(i).Enabled = IIf(i = 0, True, False)
       Next
    If bytDh = 15 Then             ' 系统   ????
       Label5.Top = MSFlexGrid1.Top + MSFlexGrid1.Height + 200
       If N1 = 3 Then
          For i = 0 To 2: Text1(i).Enabled = False: Next
          MSFlexGrid1.Col = 2
          MSFlexGrid1.SetFocus
       End If
       Command2.Enabled = False
    Else
       For i = 0 To 2: Text1(i).Enabled = True: Next
       Text1(0).SetFocus
    End If
End Sub

Private Sub Command4_Click()                                      ' 删除
    strMcd = Trim(arrLb(bytRoy, 2))
    StrMsg = " 确实要删除有关 " & strMcd & " 的条目信息吗 ？ "                          ' 追加
    If MsgBox(StrMsg, 33, " 请确认") = 1 Then
       strDmd = Trim(arrLb(bytRoy, 1))
       StrSQL = "Delete From " & strT0 & " Where Dm = '" & strDmd & "'"
       cnnTce.Execute StrSQL
       Call P_clr1
    Else
       Call Command2_Click                                        ' 放弃
    End If
End Sub

Private Sub Command5_Click()                                      ' 返回
    Frame1.Visible = False
    Command2.Caption = "排  序"
    Command3.Caption = "存  盘"
End Sub

Private Sub Option1_Click(Index As Integer)
    Call P_grd1
    Sz = IIf(Option1(0), "s", "z")
    Text1(0) = ""
    Text1(1) = Sz
    Text1(2) = ""
    Call P_ini1
    Text1(0).SetFocus
End Sub

Private Sub Text1_GotFocus(Index As Integer)
    Text1(Index).SelStart = 0                                     ' 聚焦时反白显示
    Text1(Index).SelLength = Len(Text1(Index).Text)
End Sub

Private Sub Text1_Change(Index As Integer)                        ' 合法性检验
    If Trim(Text1(Index)) = "" Then
       Command3.Enabled = False
       Exit Sub
    End If
    If Index = 0 Then
       strMcp = Trim(Text1(0))
       If myF_Len(strMcp) > 30 Then
          MsgBox "  条目名称不得超过 15 个汉字 ...  ", 48, "  请注意"
          Text1(0) = " " & myF_Left(strMcp, 30)
       End If
       If strDm = "Xm" Then
          Text1(1).Enabled = True
       Else
          Command3.Enabled = True
       End If
    Else
       strBzp = Trim(Text1(2))
       Command3.Enabled = True
    End If
End Sub

Private Sub Text1_LostFocus(Index As Integer)
    Text1(Index) = " " & Trim(Text1(Index))
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer) ' 检验
    If KeyAscii <> 13 Then Exit Sub
    strMcd = Trim(Text1(0).Text)
    'strjcd = Trim(Text1(1).Text)
    strBzd = Trim(Text1(2).Text)
          If Len(strMcd) = 0 Then
             MsgBox "  必须录入条目名称 ...  ", 48, "  请注意"
             Text1(0).SetFocus: Exit Sub
          End If
    If N1 > 1 Then                                                ' 检验是否重复
       If Index = 0 Then
          Call P_jy03
       Else
          Call P_jy04
       End If
    End If
    Select Case Index
           Case 0
                If strDm = "Xm" Then
                   Text1(1).SetFocus
                Else
                   Command3.SetFocus
                End If
           Case 1
                Text1(2).SetFocus
           Case 2
                If strDm = "Xm" Then
                   If Trim(Text1(0)) = "" Or Trim(Text1(1)) = "" Then
                      Command3.Enabled = False
                      Text1(0).SetFocus
                   Else
                      Command3.Enabled = True
                      Command3.SetFocus
                   End If
                Else
                   If Trim(Text1(0)) = "" Or Trim(Text1(2)) = "" Then
                      Command3.Enabled = False
                      Text1(0).SetFocus
                   Else
                      Command3.Enabled = True
                      Command3.SetFocus
                   End If
                End If
    End Select
End Sub

Private Sub P_jy01()                                              ' 检验名称长度
End Sub

Private Sub P_jy02()                                              ' 检验代号长度
End Sub

Private Sub P_jy03()                                              ' 检验名称是否重复
    MyRs0.MoveFirst
       Do While Not MyRs1.EOF
          If Trim(MyRs1![Mc]) = strMcd Then
             MsgBox "  条目名称重复，须修改录入 ...  ", 48, "  请注意"
             Command3.Enabled = False
             Text1(0).SelStart = 0                                ' 聚焦时反白显示
             Text1(0).SelLength = Len(Text1(1).Text)
             Text1(0).SetFocus
             Exit Do
          End If
          MyRs0.MoveNext
       Loop
End Sub

Private Sub P_jy04()                                              ' 检验代号是否重复
    MyRs0.MoveFirst
       Do While Not MyRs0.EOF
          If Trim(MyRs0![Bz]) = strBzd Then
             MsgBox "  条目代号重复，须修改录入 ...  ", 48, "  请注意"
             Command3.Enabled = False
             Text1(2).SelStart = 0                                ' 聚焦时反白显示
             Text1(2).SelLength = Len(Text1(2).Text)
             Text1(2).SetFocus
             Exit Do
          End If
       Loop
End Sub


Private Sub P_xgmc()
    Form0.Label1.Caption = strMcp
    Form0.Label1.Left = (Screen.Width - Form0.Label1.Width) / 2
    Form0.Label3.Caption = strJcp & "·" & strBzp & "  " & StrDte
    Form0.Label3.Left = (Screen.Width - Form0.Label3.Width) / 2
End Sub

Private Sub Form_Unload(Cancel As Integer)
 On Error Resume Next
    MyRs0.Close: Set MyRs0 = Nothing                              ' 关闭记录集，释放对象
End Sub