frmdata.frm

信息管理数据库

            Index           =   5
            Visible         =   0   'False
         End
      End
      Begin VB.Menu DocuDiv4 
         Caption         =   "-"
      End
      Begin VB.Menu numRem 
         Caption         =   "刷新(&R)"
         Shortcut        =   {F5}
      End
      Begin VB.Menu numPass 
         Caption         =   "修改密码(&P)"
      End
   End
   Begin VB.Menu DocuInquir 
      Caption         =   "查询(&I)"
      Visible         =   0   'False
      Begin VB.Menu DocuSeek 
         Caption         =   "查询(&K)"
         Shortcut        =   ^K
      End
   End
   Begin VB.Menu DocuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu About 
         Caption         =   "关于(&A)..."
         Shortcut        =   {F1}
      End
   End
End
Attribute VB_Name = "frmData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'本程序是我初学VB时的作品，中文注释。
'现在看来有很多语句没有优化，算法也一般。
'由于时间关系，我没有修改，现提供源代码，
'若有疑问，欢迎来信，我们可以共同探讨。
'[e-mail]
Option Explicit
Public mdbFile, mdbDataName As String
Public DataNumbel As Integer
Public Uo As Boolean
Public ListView_Name, ListView_QQ, ListView_Love As String
Public ListViewItem As Integer
Public Password As String


Private Sub TuBiao()
  '初始化任务栏图标
   Me.Move (Screen.Width - Me.Width) / 3, (Screen.Height - Me.Height) / 3
    TrayIcon.cbSize = Len(TrayIcon)
    TrayIcon.hwnd = Me.hwnd
    TrayIcon.uId = vbNull
    TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    TrayIcon.ucallbackMessage = WM_MOUSEMOVE
    TrayIcon.hIcon = Me.Icon ' 提供任务栏图标
    TrayIcon.szTip = "Mind's Tray Icon Example" & Chr$(0)
     '将图标放到任务栏
    Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
    App.TaskVisible = False
End Sub

Private Sub About_Click() '关于版本
frmabout.Show vbModal
End Sub

Private Sub DeleteAll_Click()
     Dim Result
  If Not Data1.Recordset.EOF And Not Data1.Recordset.BOF Then
         Result = MsgBox("所有记录将被删除！", vbYesNo, "警告")
          SetWindowPos Me.hwnd, HWND_topmost, 0, 0, 0, 0, flag '设置窗口在前
         If Result = vbYes Then
            frmData.Data1.Recordset.MoveLast
            frmData.Data1.Recordset.MoveFirst
             Dim i As Integer
             For i = 1 To frmData.Data1.Recordset.RecordCount
                 Data1.Recordset.Delete
                 frmData.Data1.Recordset.MoveNext
             Next i
            Data1.Refresh
            ListRefresh
          End If
  Else
    Result = MsgBox("无法删除记录！", vbOKOnly, "提示")
  End If
  SetWindowPos Me.hwnd, HWND_notopmost, 0, 0, 0, 0, flag
End Sub

Private Sub DocuAdd_Click() '添加记录
Uo = False
  frmTJ.Command2.Enabled = False
  Load frmTJ
  frmTJ.Show vbModal
End Sub

Public Sub DocuDelete_Click() '删除记录
  Dim Result
  If Not Data1.Recordset.EOF And Not Data1.Recordset.BOF Then
     If frmData.ListView1.ListItems.Count > 0 Then
       If ListView1.SelectedItem.Index > 0 Then
         Result = MsgBox("当前记录将被删除！", vbYesNo, "警告")
          SetWindowPos Me.hwnd, HWND_topmost, 0, 0, 0, 0, flag '设置窗口在前
         If Result = vbYes Then
             Data1.Recordset.Delete
             Data1.Refresh
             ListRefresh
         End If
       Else
         Result = MsgBox("请选择要删除的记录！", vbOKOnly, "警告")
          SetWindowPos Me.hwnd, HWND_topmost, 0, 0, 0, 0, flag '设置窗口在前
       End If
    End If
  Else
    Result = MsgBox("无法删除当前记录！", vbOKOnly, "提示")
  End If
  SetWindowPos Me.hwnd, HWND_notopmost, 0, 0, 0, 0, flag
 ' ListRefresh
End Sub

Private Sub DocuExit_Click() '退出程序
  Unload frmData
  
End Sub

Private Sub DocuSeek_Click() '查询记录
numRem_Click
  Load frmCX
  frmCX.Show vbModal
  
End Sub


Private Sub Form_Resize()
 If WindowState = 1 Then Me.Visible = False
End Sub
Private Sub Form_Load() '程序初始化
 If App.PrevInstance Then
     Dim Recut As Integer
     Recut = MsgBox("程序已经运行，请检查窗口是否已被最小化！", 48, "提示")
      Unload Me
     Exit Sub
 End If
 ListViewStyle_Click '使ListView控件可以整行选择
 ListViewStyleBiaoG_Click  '使ListView控件有表格风格
 ListViewStyleOne_Click '允许单击选择
 ListViewStyleTwo_Click '允许双击选择
 
   Frm_Load
  TuBiao
 ' SetWindowPos Me.hwnd, HWND_topmost, 0, 0, 0, 0, flag '设置窗口在前
  Dim i As String
  Dim j As Integer
  '开始初始化
  For j = 0 To 13
     Text1(j).Text = ""
  Next j
End Sub

Private Sub numMPgl_Click()
 On Error GoTo ErrHandle
 frmData.Caption = "信息管理 -- " & mdbFile & "[" & mdbDataName & "]"
'设置字符串变量来调用SQL语句

  SQLoriginal = "select * from " & frmData.mdbDataName '"Data"
  SQLadd = " where Name=Name"
  SQLorder = ""
  Data1.DatabaseName = mdbFile '"\MyNote.mdb"
  Data1.RecordSource = SQLoriginal + SQLadd + SQLorder
  Data1.Refresh
 ListRefresh
  Exit Sub
  '错误处理
ErrHandle:
 MsgBox Err.Description
End Sub

Private Sub ListView1_Click()
If ListView1.ListItems.Count > 0 Then
Dim i, Count As Integer
  Count = ListView1.SelectedItem.Index
  Data1.Recordset.MoveFirst
  i = 1
  Do While i < Count
    Data1.Recordset.MoveNext
    i = i + 1
  Loop
  '("Name")
  '("Oicq")
  ListViewItem = Count
   frmData.Text1(0).Text = frmData.Data1.Recordset.Fields("Sex") 'lPassword(frmData.Data1.Recordset.Fields("Sex"))
   frmData.Text1(1).Text = frmData.Data1.Recordset.Fields("Age") ' lPassword(frmData.Data1.Recordset.Fields("Year"))
  'Age年龄
  
   frmData.Text1(2).Text = frmData.Data1.Recordset.Fields("Year") 'lPassword(frmData.Data1.Recordset.Fields("Constell"))
   frmData.Text1(3).Text = frmData.Data1.Recordset.Fields("Constell")
   frmData.Text1(4).Text = frmData.Data1.Recordset.Fields("Attributive")
   frmData.Text1(5).Text = frmData.Data1.Recordset.Fields("Blood") 'lPassword(frmData.Data1.Recordset.Fields("Address"))
   
   frmData.Text1(6).Text = frmData.Data1.Recordset.Fields("Address") 'lPassword(frmData.Data1.Recordset.Fields("Address"))
   frmData.Text1(7).Text = frmData.Data1.Recordset.Fields("TelepNo") ' lPassword(frmData.Data1.Recordset.Fields("TelepNo"))
   frmData.Text1(8).Text = frmData.Data1.Recordset.Fields("MoveCall") 'lPassword(frmData.Data1.Recordset.Fields("MoveCall"))
   frmData.Text1(9).Text = frmData.Data1.Recordset.Fields("Home") 'lPassword(frmData.Data1.Recordset.Fields("Home"))
   frmData.Text1(10).Text = frmData.Data1.Recordset.Fields("Call") 'lPassword(frmData.Data1.Recordset.Fields("Call"))
   frmData.Text1(11).Text = frmData.Data1.Recordset.Fields("Fax") 'lPassword(frmData.Data1.Recordset.Fields("Fax"))
   frmData.Text1(12).Text = frmData.Data1.Recordset.Fields("Email") ' lPassword(frmData.Data1.Recordset.Fields("Email"))
   frmData.Text1(13).Text = frmData.Data1.Recordset.Fields("Appendix") 'lPassword(frmData.Data1.Recordset.Fields("Appendix"))
End If
End Sub


Private Sub ListView1_DblClick() '双击修改
ListView1_Click
numUo_Click
End Sub

Private Sub ListView1_ItemClick(ByVal Item As ComctlLib.ListItem)
'---------------------
ListView1_Click
End Sub


Private Sub mdbFileData_Click(Index As Integer)
   mdbDataName = "Data" & CStr(Index)
   numMPgl_Click
End Sub

Private Sub numAcess_Click() '新建数据库
mdbFile = DialogFile(Me.hwnd, 0, "新建数据库记录", "MyData", "Access(*.mdb)" & Chr(0) & "*.mdb" & Chr(0) & "All files(*.*)" & Chr(0) & "*.*", App.Path, "mdb")
If mdbFile = "" Then Exit Sub
DataNumbel = 0
New_click '新建数据库
nummdbData_Click
Dim i As Integer
For i = 2 To 5
      mdbFileData(i).Visible = False
Next i
DocuManage.Visible = True
DocuInquir.Visible = True
numOption.Visible = True
End Sub

Private Sub nummdbData_Click() '新建数据表
cmdCreate_Click
AddNumbel '修改数据表记录
ReadNumbel '读数据表记录
numData.Enabled = True
numMPgl_Click
End Sub

Private Sub numOpen_Click()
On Error GoTo ErrHandle
mdbFile = DialogFile(Me.hwnd, 1, "打开数据库记录", "", "Access(*.mdb)" & Chr(0) & "*.mdb" & Chr(0) & "All files(*.*)" & Chr(0) & "*.*", App.Path, "mdb")
If mdbFile = "" Then Exit Sub
nummdbData.Enabled = True
Dim i As Integer
For i = 2 To 5
      mdbFileData(i).Visible = False
Next i
DocuManage.Visible = True
DocuInquir.Visible = True
numOption.Visible = True
frmLogin.Show vbModal

If NoLogin = True Then End
ReadNumbel
mdbDataName = "data1"
numMPgl_Click
Exit Sub
ErrHandle: Exit Sub
End Sub


'-------------------------*********任务栏图标**********-------------------------------
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static Message As Long
Static RR As Boolean
    Message = X / Screen.TwipsPerPixelX
    If RR = False Then
        RR = True
        Select Case Message
            Case WM_LBUTTONDBLCLK  'DblClick
               If WindowState = 1 Then
                 SetWindowPos Me.hwnd, HWND_topmost, 0, 0, 0, 0, flag '设置窗口在前
                 WindowState = 0 'Me.Show
                 Me.Visible = True
                 SetWindowPos Me.hwnd, HWND_notopmost, 0, 0, 0, 0, flag '设置窗口在前
               Else
                 WindowState = 1
                 Me.Visible = False
               End If
            Case WM_RBUTTONUP
                Me.PopupMenu numFile
        End Select
        RR = False
    End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    TrayIcon.cbSize = Len(TrayIcon)
    TrayIcon.hwnd = Me.hwnd
    TrayIcon.uId = vbNull
    '删除任务栏图标
    Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)
End Sub

Private Sub numPass_Click()
     frmLog.Show vbModal
End Sub

Private Sub numRem_Click() '刷新数据窗口
 '把数据库显示恢复到原来形式
  frmData.Data1.DatabaseName = frmData.mdbFile 'App.Path + "\MyNote.mdb"
  SQLadd = " where Name=Name"
 frmData.Data1.RecordSource = SQLoriginal + SQLadd + SQLorder
  frmData.Data1.Refresh
  ListRefresh
  Unload frmCX
End Sub

Private Sub numUo_Click() '修改记录
If ListView1.ListItems.Count < 1 Then Exit Sub
If ListViewItem > 0 Then
ListView_Name = ListView1.ListItems(ListViewItem).SubItems(1)
  ListView_QQ = ListView1.ListItems(ListViewItem).SubItems(2)
  ListView_Love = ListView1.ListItems(ListViewItem).SubItems(3)
   Uo = True
   frmTJ.Command1.Enabled = False
   frmTJ.Show vbModal
Else
   MsgBox "请选择要修改的记录！", vbOKOnly, "警告"
   SetWindowPos Me.hwnd, HWND_topmost, 0, 0, 0, 0, flag
   SetWindowPos Me.hwnd, HWND_notopmost, 0, 0, 0, 0, flag
End If
End Sub
'-------------------------------------------------------------------------
'**********************************************************

Private Sub Frm_Load()
Dim clmX As ColumnHeader
App.Title = "ListView Sample"
  Set clmX = ListView1.ColumnHeaders.Add(, , "编号", 100)
  Set clmX = ListView1.ColumnHeaders.Add(, , "姓名", ListView1.Width / 3 - 750)
  Set clmX = ListView1.ColumnHeaders.Add(, , "QQ", ListView1.Width / 3 - 550)
   Set clmX = ListView1.ColumnHeaders.Add(, , "昵称", ListView1.Width / 3 - 330)
End Sub

Private Sub AddRead_Numbel()
 On Error GoTo ErrHandle
 frmData.Caption = "信息管理 -- " & mdbFile & "[mdbNumel]"
'设置字符串变量来调用SQL语句
  
  SQLoriginal = "select * from " & "mdbNumbel"
  SQLadd = " where Name=Name"
  SQLorder = ""
  Data1.DatabaseName = mdbFile '"\MyNote.mdb"
  Data1.RecordSource = SQLoriginal + SQLadd + SQLorder
  Data1.Refresh
   Exit Sub
  '错误处理
ErrHandle:
  Exit Sub
  'MsgBox Err.Description
End Sub
 
  Private Sub AddNumbel()
  On Error GoTo ErrHandle
  AddRead_Numbel
   '**********************
  If frmData.Data1.Recordset.RecordCount > 0 Then
     Data1.Recordset.Edit '编辑开始更改表总数的记录
  Else
     Data1.Recordset.AddNew
  End If
  Data1.Recordset.Fields("ID") = 1
  Data1.Recordset.Fields("Name") = "数据表总数"
  Data1.Recordset.Fields("Numbel") = DataNumbel + 1 '
  Data1.Recordset.Update '进行记录更新
  Data1.Refresh '更新数据库
  Exit Sub
  '错误处理
ErrHandle:
  Exit Sub
  'MsgBox Err.Description
  End Sub
Private Sub ReadNumbel()
On Error GoTo ErrHandle
AddRead_Numbel
  '------------------------------
  Dim i As Integer
  If Not frmData.Data1.Recordset.EOF Then
  '测量表中记录数目
   frmData.Data1.Recordset.MoveLast
   frmData.Data1.Recordset.MoveFirst
  ' For i = 1 To frmData.Data1.Recordset.RecordCount
         DataNumbel = frmData.Data1.Recordset.Fields("Numbel")
     frmData.Data1.Recordset.MoveNext
   'Next i
   '把数据表当前记录位置复原
   frmData.Data1.Recordset.MoveFirst
  End If
  If DataNumbel > 5 Then DataNumbel = 5
  For i = 1 To DataNumbel
      mdbFileData(i).Visible = True
  Next i
   '---------------------------------------------------------
  Exit Sub
  '错误处理
ErrHandle:
Exit Sub
  'MsgBox Err.Description
End Sub