frmoptions.frm

这是一个用vb 写的聊天室

    frmOptions.Label2.Enabled = What
    frmOptions.Label3.Enabled = What
    frmOptions.Label4.Enabled = What
    frmOptions.Label5.Enabled = What
    frmOptions.Label6.Enabled = What
    frmOptions.Label7.Enabled = What
    frmOptions.Label8.Enabled = What
    frmOptions.Label9.Enabled = What
    frmOptions.Label10.Enabled = What
    frmOptions.Label11.Enabled = What
End Function

Private Function OptionsEnable2(What As Boolean)
    frmOptions.Frame7.Enabled = What
    frmOptions.Frame8.Enabled = What
    frmOptions.Frame9.Enabled = What
    frmOptions.Frame10.Enabled = What
    frmOptions.txtCity1.Enabled = What
    frmOptions.txtCity1.Text = ""
    frmOptions.txtFirst1.Enabled = What
    frmOptions.txtFirst1.Text = ""
    frmOptions.txtLast1.Enabled = What
    frmOptions.txtLast1.Text = ""
    frmOptions.txtMiddle1.Enabled = What
    frmOptions.txtMiddle1.Text = ""
    frmOptions.txtState1.Enabled = What
    frmOptions.txtState1.Text = ""
    frmOptions.txtStreet1.Enabled = What
    frmOptions.txtStreet1.Text = ""
    frmOptions.txtZip1.Enabled = What
    frmOptions.txtZip1.Text = ""
    frmOptions.txtPass1.Enabled = What
    frmOptions.txtPass1.Text = ""
    frmOptions.txtBDay1.Enabled = What
    frmOptions.txtBDay1.Text = ""
    frmOptions.txtVPass1.Enabled = What
    frmOptions.txtVPass1.Text = ""
    frmOptions.Label12.Enabled = What
    frmOptions.Label13.Enabled = What
    frmOptions.Label14.Enabled = What
    frmOptions.Label15.Enabled = What
    frmOptions.Label16.Enabled = What
    frmOptions.Label17.Enabled = What
    frmOptions.Label18.Enabled = What
    frmOptions.Label19.Enabled = What
    frmOptions.Label20.Enabled = What
    frmOptions.Label21.Enabled = What
End Function

Private Sub cmdApply_Click()
If picOptions(0).Tag = "Visible" Then
    If txtPass = txtVPass Then
      With frmUsrNFO.dtaUsrNfo.Recordset
        .AddNew
        !Login = txtLogin.Text
        RC4ini ("AcKhTTaSBtCC")                                 '  The en/decrypt password
        !Pass = EnDeCrypt(txtPass.Text)
        !StreetAddy = txtStreet.Text
        !Zip = txtZip.Text
        !City = txtCity.Text
        !State = txtState.Text
        !BDay = txtBDay.Text
        !First = txtFirst.Text
        !Middle = txtMiddle.Text
        !Last = txtLast.Text
        !Status = "Online"
        .Update
      End With
      MsgBox "Added User: " & txtLogin.Text
      Call OptionsEnable(False)
      cmdCheck.Enabled = True
      Label1.Enabled = True
      txtLogin.Enabled = True
      txtLogin = ""
    Else
        MsgBox "Passwords do not match!", vbOKOnly, "Amojeba Chat"
        txtPass.Text = ""
        txtVPass.Text = ""
        txtPass.SetFocus
    End If
ElseIf picOptions(2).Tag = "Visible" Then
    If txtPass1 = txtVPass1 Then
      frmUsrNFO.dtaUsrNfo.Recordset.MoveFirst
        Do: DoEvents
          If LCase(frmOptions.cboUsers.Text) = LCase(frmUsrNFO.txtLogin) Then
            With frmUsrNFO.dtaUsrNfo.Recordset
                .Edit
                RC4ini ("AcKhTTaSBtCC")                                 '  The en/decrypt password
                !Pass = EnDeCrypt(txtPass1.Text)
                !StreetAddy = txtStreet1.Text
                !Zip = txtZip1.Text
                !City = txtCity1.Text
                !State = txtState1.Text
                !BDay = txtBDay1.Text
                !First = txtFirst1.Text
                !Middle = txtMiddle1.Text
                !Last = txtLast1.Text
                .Update
            End With
            MsgBox "Edit Complete"
            Call OptionsEnable2(False)
            cmdEdit.Enabled = True
            Label22.Enabled = True
            cboUsers.Enabled = True
            Exit Do
          End If
            frmUsrNFO.dtaUsrNfo.Recordset.MoveNext                  '  If there arnt any matches try the next person
        Loop Until frmUsrNFO.dtaUsrNfo.Recordset.EOF
       Else
          MsgBox "Passwords do not match!", vbOKOnly, "Amojeba Chat"
          txtPass1.Text = ""
          txtVPass1.Text = ""
          txtPass1.SetFocus
      End If
End If
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdCheck_Click()
Dim FindLogin
      frmUsrNFO.dtaUsrNfo.Recordset.MoveFirst                       'Sets the database to the start
      FindLogin = 0
        Do: DoEvents                                                '*** Start Checking
            If LCase(frmOptions.txtLogin.Text) = LCase(frmUsrNFO.txtLogin) Then           '  Check to see if they match
                FindLogin = 1                                       '  They do.. set the var to let the comp remember
            End If
            frmUsrNFO.dtaUsrNfo.Recordset.MoveNext                  '  If there arnt any matches try the next person
        Loop Until frmUsrNFO.dtaUsrNfo.Recordset.EOF
      If FindLogin = 0 Then
        Label1.Enabled = False
        txtLogin.Enabled = False
        cmdCheck.Enabled = False
        Call OptionsEnable(True)
        txtFirst.SetFocus
      Else
        MsgBox "A user with the name: (" & frmOptions.txtLogin.Text & ") already exists, try a new name!", vbOKOnly, "Amojeba Chat"
        frmOptions.txtLogin.Text = ""
        frmOptions.txtLogin.SetFocus
      End If
End Sub

Private Sub cmdEdit_Click()
    Call OptionsEnable2(True)
    cmdEdit.Enabled = False
    Label22.Enabled = False
    cboUsers.Enabled = False
    frmUsrNFO.dtaUsrNfo.Recordset.MoveFirst
    Do: DoEvents
        If LCase(frmUsrNFO.txtLogin.Text) = LCase(cboUsers.Text) Then
            With frmUsrNFO.dtaUsrNfo.Recordset
                txtFirst1.Text = !First
                txtMiddle1.Text = !Middle
                txtLast1.Text = !Last
                txtStreet1.Text = !StreetAddy
                txtCity1.Text = !City
                txtState1.Text = !State
                txtZip1.Text = !Zip
                txtBDay1.Text = !BDay
            End With
            Exit Do
        End If
        frmUsrNFO.dtaUsrNfo.Recordset.MoveNext
    Loop Until frmUsrNFO.dtaUsrNfo.Recordset.EOF
End Sub

Private Sub cmdOK_Click()
    cmdApply_Click
    Unload Me
End Sub

Private Sub cmdRemoveUsr_Click()
  Dim CheckDel As Variant
  CheckDel = MsgBox("Are you sure you wish to remove (" & txtRemoveName.Text & ") from the database?", vbYesNo, "Amojeba Chat")
  If CheckDel = vbYes Then
        frmUsrNFO.dtaUsrNfo.Recordset.MoveFirst
        Do: DoEvents
            If LCase(frmOptions.txtRemoveName.Text) = LCase(frmUsrNFO.txtLogin) Then
                frmUsrNFO.dtaUsrNfo.Recordset.Delete
                Exit Do
            End If
            frmUsrNFO.dtaUsrNfo.Recordset.MoveNext
        Loop Until frmUsrNFO.dtaUsrNfo.Recordset.EOF
        MsgBox "Removed: " & txtRemoveName.Text & " from the database!"
        txtRemoveName.Text = ""
            lstRemoveUsr.Clear
            frmUsrNFO.dtaUsrNfo.Recordset.MoveFirst
            Do: DoEvents
                lstRemoveUsr.AddItem frmUsrNFO.txtLogin.Text
                frmUsrNFO.dtaUsrNfo.Recordset.MoveNext
            Loop Until frmUsrNFO.dtaUsrNfo.Recordset.EOF
  End If
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim i As Integer
    'handle ctrl+tab to move to the next tab
    If Shift = vbCtrlMask And KeyCode = vbKeyTab Then
        i = tbsOptions.SelectedItem.Index
        If i = tbsOptions.Tabs.Count Then
            'last tab so we need to wrap to tab 1
            Set tbsOptions.SelectedItem = tbsOptions.Tabs(1)
        Else
            'increment the tab
            Set tbsOptions.SelectedItem = tbsOptions.Tabs(i + 1)
        End If
    End If
End Sub

Private Sub Form_Load()
    'center the form
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    Call OptionsEnable(False)
End Sub

Private Sub lstRemoveUsr_DblClick()
    txtRemoveName.Text = lstRemoveUsr.Text
End Sub

Private Sub tbsOptions_Click()
    
    Dim i As Integer
    'show and enable the selected tab's controls
    'and hide and disable all others
    For i = 0 To tbsOptions.Tabs.Count - 1
        If i = tbsOptions.SelectedItem.Index - 1 Then
            picOptions(i).Left = 190
            picOptions(i).Top = 570
            picOptions(i).Enabled = True
            picOptions(i).Tag = "Visible"
            If i = 1 Then
                lstRemoveUsr.Clear
                frmUsrNFO.dtaUsrNfo.Recordset.MoveFirst
                Do: DoEvents
                    lstRemoveUsr.AddItem frmUsrNFO.txtLogin.Text
                    frmUsrNFO.dtaUsrNfo.Recordset.MoveNext
                Loop Until frmUsrNFO.dtaUsrNfo.Recordset.EOF
            ElseIf i = 2 Then
                Call OptionsEnable2(False)
                cboUsers.Clear
                frmUsrNFO.dtaUsrNfo.Recordset.MoveFirst
                    cboUsers.Text = frmUsrNFO.txtLogin.Text
                Do: DoEvents
                    cboUsers.AddItem frmUsrNFO.txtLogin.Text
                    frmUsrNFO.dtaUsrNfo.Recordset.MoveNext
                Loop Until frmUsrNFO.dtaUsrNfo.Recordset.EOF
            End If
        Else
            picOptions(i).Left = -20000
            picOptions(i).Top = -20000
            picOptions(i).Enabled = False
            picOptions(i).Tag = "InVisible"
        End If
    Next
    
End Sub

Private Sub txtBDay_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys (vbTab)
        KeyAscii = 0
    End If
End Sub

Private Sub txtCity_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys (vbTab)
        KeyAscii = 0
    End If
End Sub

Private Sub txtFirst_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys (vbTab)
        KeyAscii = 0
    End If
End Sub

Private Sub txtLast_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys (vbTab)
        KeyAscii = 0
    End If
End Sub

Private Sub txtLogin_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        cmdCheck_Click
        KeyAscii = 0
    End If
End Sub

Private Sub txtMiddle_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys (vbTab)
        KeyAscii = 0
    End If
End Sub

Private Sub txtPass_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys (vbTab)
        KeyAscii = 0
    End If
End Sub

Private Sub txtRemoveName_Change()
    If txtRemoveName.Text = "" Then
        cmdRemoveUsr.Enabled = False
        cmdClear.Enabled = False
    Else
        cmdRemoveUsr.Enabled = True
        cmdClear.Enabled = True
    End If
End Sub

Private Sub txtState_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys (vbTab)
        KeyAscii = 0
    End If
End Sub

Private Sub txtStreet_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys (vbTab)
        KeyAscii = 0
    End If
End Sub

Private Sub txtVPass_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys (vbTab)
        KeyAscii = 0
    End If
End Sub

Private Sub txtZip_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys (vbTab)
        KeyAscii = 0
    End If
End Sub