form1.frm

wu zi qi suan fa

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6540
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4590
   LinkTopic       =   "Form1"
   ScaleHeight     =   6540
   ScaleWidth      =   4590
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text2 
      Height          =   270
      Left            =   2880
      TabIndex        =   8
      Text            =   "0"
      Top             =   120
      Width           =   1695
   End
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   2400
      TabIndex        =   7
      Text            =   "0"
      Top             =   120
      Width           =   375
   End
   Begin VB.ListBox List1 
      Height          =   5940
      Left            =   0
      Style           =   1  'Checkbox
      TabIndex        =   6
      Top             =   480
      Width           =   4335
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Check1"
      Height          =   255
      Index           =   5
      Left            =   2040
      TabIndex        =   5
      Top             =   120
      Width           =   255
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Check1"
      Height          =   255
      Index           =   4
      Left            =   1680
      TabIndex        =   4
      Top             =   120
      Width           =   255
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Check1"
      Height          =   255
      Index           =   3
      Left            =   1320
      TabIndex        =   3
      Top             =   120
      Width           =   255
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Check1"
      Height          =   255
      Index           =   2
      Left            =   960
      TabIndex        =   2
      Top             =   120
      Width           =   255
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Check1"
      Height          =   255
      Index           =   1
      Left            =   600
      TabIndex        =   1
      Top             =   120
      Width           =   255
   End
   Begin VB.CheckBox Check1 
      Caption         =   "Check1"
      Height          =   255
      Index           =   0
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   255
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim AppPath As String
Dim dbsS As Database, dbsR As Recordset

Private Sub Check1_Click(Index As Integer)
Dim I As Integer, Ts As Integer, Tx As String
Dim mD(5) As Integer
mD(0) = 1
mD(1) = 2
mD(2) = 4
mD(3) = 8
mD(4) = 16
mD(5) = 32
Ts = 0
Tx = ""
For I = 0 To 5
    If Check1(I).Value = 1 Then
       Tx = Tx & "*"
       Ts = Ts + mD(I)
    Else:
       Tx = Tx & "O"
    End If
Next
Set dbsR = dbsS.OpenRecordset("SELECT * FROM Base WHERE Text='" & Tx & "'")
If dbsR.RecordCount = 0 Then
   List1.AddItem Tx & " " & Ts
   List1.ItemData(List1.ListCount - 1) = Ts
   dbsR.AddNew
   dbsR("Text") = Tx
   dbsR("Index") = Ts
   dbsR.Update
End If
End Sub

Private Sub Form_Load()
Dim Tx As String
AppPath = App.Path
If Right(AppPath, 1) <> "\" Then
    AppPath = AppPath & "\"
End If
Tx = AppPath & "BW.mdb"
If Len(Dir(Tx)) > 0 Then
   On Error GoTo ErOpenDB
   Set dbsS = OpenDatabase(Tx, 0, 0, ";PWD=")
   Set dbsR = dbsS.OpenRecordset("SELECT * FROM Base ORDER BY Index")
   If dbsR.RecordCount > 0 Then
      With dbsR
          Do Until .EOF
             List1.AddItem dbsR("Text") & " " & dbsR("Index")
             List1.ItemData(List1.ListCount - 1) = dbsR("Index")
             .MoveNext
          Loop
      End With
   End If
   Me.Show
Else:
   MsgBox " 数据库文件丢失！", 48
   End
End If
Exit Sub
ErOpenDB: MsgBox " 系统数据库错误！", 48
          End
End Sub

Private Sub List1_Click()
Ts = List1.ListIndex
If Ts >= 0 Then
   If List1.Selected(Ts) Then
      Set dbsR = dbsS.OpenRecordset("SELECT * FROM Base WHERE Index=" & CStr(List1.ItemData(Ts)))
      If dbsR.RecordCount = 1 Then
         dbsR.Edit
         dbsR("Mode") = Val(Text1)
         dbsR.Update
      End If
   End If
End If
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
   Set dbsR = dbsS.OpenRecordset("SELECT * FROM Base WHERE Mode=" & CStr(Val(Text1)) & " ORDER BY Index")
   List1.Clear
   If dbsR.RecordCount > 0 Then
      Tx = ""
      With dbsR
          Do Until .EOF
             Tx = Tx & dbsR("Index") & ","
             List1.AddItem dbsR("Text") & " " & dbsR("Index")
             List1.ItemData(List1.ListCount - 1) = dbsR("Index")
             .MoveNext
          Loop
          Text2 = Tx
      End With
   End If
End If
End Sub