⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frmmemberlevel.frm

📁 星级酒店管理系统（附带系统自写控件源码）
💻 FRM
📖 第 1 页 / 共 4 页
字号:
🔍
1234 

 On Error GoTo WriteERR
 
 Dim intMethod As Integer
 
   '查询是否合格
    If CCur(ftDown0(8).Text) > CCur(ftDown0(9).Text) Then
       MsgBox "对不起,最低数大于最高数？   ", vbInformation
       ftDown0(8).SetFocus
       Exit Sub
    End If
    If CCur(ftDown0(10).Text) > CCur(ftDown0(11).Text) Then
       MsgBox "对不起,最低数大于最高数？   ", vbInformation
       ftDown0(10).SetFocus
       Exit Sub
    End If
    If CCur(ftDown0(12).Text) > CCur(ftDown0(13).Text) Then
       MsgBox "对不起,最低数大于最高数？   ", vbInformation
       ftDown0(12).SetFocus
       Exit Sub
    End If
    If CCur(ftDown0(14).Text) > CCur(ftDown0(15).Text) Then
       MsgBox "对不起,最低数大于最高数？   ", vbInformation
       ftDown0(14).SetFocus
       Exit Sub
    End If

    intMethod = 2
 
 '保存到数据库中
  Dim cnDB As Connection
  Dim cnRS As Recordset
  Set cnDB = CreateObject("ADODB.Connection")
  Set cnRS = CreateObject("ADODB.Recordset")
      cnDB.Open Constr
      cnRS.ActiveConnection = cnDB
      cnRS.Open "tbdLevel", , adOpenStatic, adLockOptimistic, adCmdTable
      cnRS.Fields("DDown") = CCur(ftDown0(0).Text)
      cnRS.Fields("DUP") = CCur(ftDown0(1).Text)
      cnRS.Fields("DCashDown") = CCur(ftDown0(8).Text)
      cnRS.Fields("DCashUP") = CCur(ftDown0(9).Text)
      cnRS.Fields("DDiscount") = CCur(ftDown0(20))
      cnRS.Fields("DMethod") = intMethod
      cnRS.Update
      cnRS.MoveNext
      cnRS.Fields("DDown") = CCur(ftDown0(2).Text)
      cnRS.Fields("DUP") = CCur(ftDown0(3).Text)
      cnRS.Fields("DCashDown") = CCur(ftDown0(10).Text)
      cnRS.Fields("DCashUP") = CCur(ftDown0(11).Text)
      cnRS.Fields("DDiscount") = CCur(ftDown0(21))
      cnRS.Fields("DMethod") = intMethod
      cnRS.Update
      cnRS.MoveNext
      cnRS.Fields("DDown") = CCur(ftDown0(4).Text)
      cnRS.Fields("DUP") = CCur(ftDown0(5).Text)
      cnRS.Fields("DCashDown") = CCur(ftDown0(12).Text)
      cnRS.Fields("DCashUP") = CCur(ftDown0(13).Text)
      cnRS.Fields("DDiscount") = CCur(ftDown0(22))
      cnRS.Fields("DMethod") = intMethod
      cnRS.Update
      cnRS.MoveNext
      cnRS.Fields("DDown") = CCur(ftDown0(6).Text)
      cnRS.Fields("DUP") = CCur(ftDown0(7).Text)
      cnRS.Fields("DCashDown") = CCur(ftDown0(14).Text)
      cnRS.Fields("DCashUP") = CCur(ftDown0(15).Text)
      cnRS.Fields("DDiscount") = CCur(ftDown0(23))
      cnRS.Fields("DMethod") = intMethod
      cnRS.Update
      cnRS.MoveNext
      
      cnRS.Close
      cnDB.Close
  Set cnRS = Nothing
  Set cnDB = Nothing
  
  Unload Me
  
  Exit Sub
WriteERR:
   MsgBox "对不起,写入会员级别数据库错误:" & Err.Description, vbExclamation
   Exit Sub
   
End Sub

Private Sub Command1_Click()

   Unload Me
   
End Sub

Private Sub Form_Load()

  GetFormSet Me, Screen
  
  optUpdate(1).Value = True
 
  GetMemberData
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

  SaveFormSet Me
  
End Sub

Private Sub ftDown0_Change(Index As Integer)

 On Error Resume Next
 
 If ftDown0(Index) = "" Then
    If Index >= 16 Then
        ftDown0(Index) = "100"
        ftDown0(Index).SelStart = 0
        ftDown0(Index).SelLength = 3
      Else
        ftDown0(Index) = "0"
        ftDown0(Index).SelStart = 0
        ftDown0(Index).SelLength = 1
    End If
    Exit Sub
 End If

 If ftDown0(Index) = "0" And Index >= 16 Then
    ftDown0(Index) = "100"
    ftDown0(Index).SelStart = 0
    ftDown0(Index).SelLength = 3
    Exit Sub
 End If
 
 If Index = 1 Then
    ftDown0(2).Text = ftDown0(1).Text
    Exit Sub
 End If
 If Index = 3 Then
    ftDown0(4).Text = ftDown0(3).Text
    Exit Sub
 End If
 If Index = 5 Then
    ftDown0(6).Text = ftDown0(5).Text
    Exit Sub
 End If
 If Index = 9 Then
    ftDown0(10).Text = ftDown0(9).Text
    Exit Sub
 End If
 If Index = 11 Then
    ftDown0(12).Text = ftDown0(11).Text
    Exit Sub
 End If
 If Index = 13 Then
    ftDown0(14).Text = ftDown0(13).Text
    Exit Sub
 End If
     
End Sub

Private Sub ftDown0_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)

  On Error Resume Next
  
  Select Case KeyCode
         Case 13
          If optUpdate(0).Value = True Then
             If Index >= 0 And Index < 7 Then
                ftDown0(Index + 1).SetFocus
             End If
             If Index = 7 Then
                ftDown0(16).SetFocus
                Exit Sub
             End If
             If Index >= 16 And Index < 19 Then
                ftDown0(Index + 1).SetFocus
             End If
             If Index = 19 Then
                cmdSet.SetFocus
                Exit Sub
             End If
             Exit Sub
            Else
             If Index >= 8 And Index < 15 Then
                ftDown0(Index + 1).SetFocus
             End If
             If Index = 15 Then
                cmdSet.SetFocus
                Exit Sub
             End If
             Exit Sub
          End If
         Case 38
          If optUpdate(0).Value = True Then
             If Index > 0 And Index <= 7 Then
                ftDown0(Index - 1).SetFocus
             End If
             If Index = 0 Then
                cmdSet.SetFocus
                Exit Sub
             End If
             If Index > 16 And Index <= 19 Then
                ftDown0(Index - 1).SetFocus
             End If
             If Index = 16 Then
                ftDown0(7).SetFocus
                Exit Sub
             End If
             Exit Sub
            Else
             If Index > 8 And Index <= 15 Then
                ftDown0(Index - 1).SetFocus
             End If
             If Index = 8 Then
                cmdSet.SetFocus
                Exit Sub
             End If
             If Index > 20 And Index <= 23 Then
                ftDown0(Index - 1).SetFocus
             End If
             If Index = 20 Then
                ftDown0(15).SetFocus
                Exit Sub
             End If
             Exit Sub
          End If
         Case 0
         '向下
          If optUpdate(0).Value = True Then
             If Index >= 0 And Index < 7 Then
                ftDown0(Index + 1).SetFocus
             End If
             If Index = 7 Then
                ftDown0(16).SetFocus
                Exit Sub
             End If
             If Index >= 16 And Index < 19 Then
                ftDown0(Index + 1).SetFocus
             End If
             If Index = 19 Then
                cmdSet.SetFocus
                Exit Sub
             End If
             Exit Sub
            Else
             If Index >= 8 And Index < 15 Then
                ftDown0(Index + 1).SetFocus
             End If
             If Index = 15 Then
                ftDown0(20).SetFocus
                Exit Sub
             End If
             If Index >= 20 And Index < 23 Then
                ftDown0(Index + 1).SetFocus
             End If
             If Index = 23 Then
                cmdSet.SetFocus
                Exit Sub
             End If
             Exit Sub
          End If
  End Select

End Sub


Private Sub optUpdate_Click(Index As Integer)

  Dim nIndex As Integer
  
  If Index = 0 Then
     For nIndex = 0 To 7
         Label2(nIndex).Enabled = True
         ftDown0(nIndex).Enabled = True
     Next
     For nIndex = 16 To 19
         Label2(nIndex).Enabled = True
         ftDown0(nIndex).Enabled = True
     Next
     For nIndex = 8 To 15
         Label2(nIndex).Enabled = False
         ftDown0(nIndex).Enabled = False
     Next
     For nIndex = 20 To 23
         Label2(nIndex).Enabled = False
         ftDown0(nIndex).Enabled = False
     Next
   Else
     For nIndex = 0 To 7
         Label2(nIndex).Enabled = False
         ftDown0(nIndex).Enabled = False
     Next
     For nIndex = 16 To 19
         Label2(nIndex).Enabled = False
         ftDown0(nIndex).Enabled = False
     Next
     For nIndex = 8 To 15
         Label2(nIndex).Enabled = True
         ftDown0(nIndex).Enabled = True
     Next
     For nIndex = 20 To 23
         Label2(nIndex).Enabled = True
         ftDown0(nIndex).Enabled = True
     Next
  End If
  
End Sub

Private Sub GetMemberData()
 
  On Error GoTo WriteERR
  Dim intMethod As Integer
  
 '给出数据
  Dim cnDB As Connection
  Dim cnRS As Recordset
  Set cnDB = CreateObject("ADODB.Connection")
  Set cnRS = CreateObject("ADODB.Recordset")
      cnDB.Open Constr
      cnRS.ActiveConnection = cnDB
      cnRS.Open "tbdLevel", , adOpenStatic, adLockOptimistic, adCmdTable
      ftDown0(0).Text = cnRS.Fields("DDown")
      ftDown0(1).Text = cnRS.Fields("DUP")
      ftDown0(8).Text = cnRS.Fields("DCashDown")
      ftDown0(9).Text = cnRS.Fields("DCashUP")
      intMethod = cnRS.Fields("DMethod")
      ftDown0(16) = cnRS.Fields("DDiscount")
      ftDown0(20) = cnRS.Fields("DDiscount")
      
      cnRS.MoveNext
      ftDown0(2).Text = cnRS.Fields("DDown")
      ftDown0(3).Text = cnRS.Fields("DUP")
      ftDown0(10).Text = cnRS.Fields("DCashDown")
      ftDown0(11).Text = cnRS.Fields("DCashUP")
      ftDown0(17) = cnRS.Fields("DDiscount")
      ftDown0(21) = cnRS.Fields("DDiscount")
      
      cnRS.MoveNext
      ftDown0(4).Text = cnRS.Fields("DDown")
      ftDown0(5).Text = cnRS.Fields("DUP")
      ftDown0(12).Text = cnRS.Fields("DCashDown")
      ftDown0(13).Text = cnRS.Fields("DCashUP")
      ftDown0(18) = cnRS.Fields("DDiscount")
      ftDown0(22) = cnRS.Fields("DDiscount")
      
      cnRS.MoveNext
      ftDown0(6).Text = cnRS.Fields("DDown")
      ftDown0(7).Text = cnRS.Fields("DUP")
      ftDown0(14).Text = cnRS.Fields("DCashDown")
      ftDown0(15).Text = cnRS.Fields("DCashUP")
      ftDown0(19) = cnRS.Fields("DDiscount")
      ftDown0(23) = cnRS.Fields("DDiscount")
            
      cnRS.Close
      cnDB.Close
  Set cnRS = Nothing
  Set cnDB = Nothing
 
  
  Exit Sub
WriteERR:
   MsgBox "对不起,给出会员级别错误:" & Err.Description, vbExclamation
   Exit Sub
   
End Sub
1234

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -