frmmain.frm

提供一个网吧管理系统的VB源代码供大家学习

  frmBiaoBiao.DTP2.Year = Year(Date) + 1
 Else
  frmBiaoBiao.DTP2.Month = Month(Date) + 1
 End If
Else
 frmBiaoBiao.DTP2.Month = Month(Date)
End If
frmBiaoBiao.DTP1.Hour = 0
frmBiaoBiao.DTP1.Minute = 0
frmBiaoBiao.DTP1.Second = 0
frmBiaoBiao.DTP2.Hour = 23
frmBiaoBiao.DTP2.Minute = 59
frmBiaoBiao.DTP2.Second = 59

End Sub

Private Sub cdTJ22_Click()
frmBiaoBiao.Show , Me
frmBiaoBiao.Combo1.Text = cdTJ22.Caption
frmBiaoBiao.DTP1.Year = Year(Date)
frmBiaoBiao.DTP1.Day = Abs(Data7.Recordset.Fields("每月开始时间"))
frmBiaoBiao.DTP2.Year = Year(Date)
frmBiaoBiao.DTP2.Day = Abs(Data7.Recordset.Fields("每月结束时间"))

If Data7.Recordset.Fields("每月开始时间") < 0 Then
 If Month(Date) = 1 Then
  frmBiaoBiao.DTP1.Month = 12
  frmBiaoBiao.DTP1.Year = Year(Date) - 1
 Else
  frmBiaoBiao.DTP1.Month = Month(Date) - 1
 End If
Else
 frmBiaoBiao.DTP1.Month = Month(Date)
End If
If Data7.Recordset.Fields("每月结束时间") < 0 Then
 If Month(Date) = 12 Then
  frmBiaoBiao.DTP2.Month = 1
  frmBiaoBiao.DTP2.Year = Year(Date) + 1
 Else
  frmBiaoBiao.DTP2.Month = Month(Date) + 1
 End If
Else
 frmBiaoBiao.DTP2.Month = Month(Date)
End If
frmBiaoBiao.DTP1.Hour = 0
frmBiaoBiao.DTP1.Minute = 0
frmBiaoBiao.DTP1.Second = 0
frmBiaoBiao.DTP2.Hour = 23
frmBiaoBiao.DTP2.Minute = 59
frmBiaoBiao.DTP2.Second = 59

End Sub

Private Sub cdTJ23_Click()
frmBiaoBiao.Show , Me
frmBiaoBiao.Combo1.Text = cdTJ23.Caption
frmBiaoBiao.DTP1.Year = Year(Date)
frmBiaoBiao.DTP1.Day = Abs(Data7.Recordset.Fields("每月开始时间"))
frmBiaoBiao.DTP2.Year = Year(Date)
frmBiaoBiao.DTP2.Day = Abs(Data7.Recordset.Fields("每月结束时间"))

If Data7.Recordset.Fields("每月开始时间") < 0 Then
 If Month(Date) = 1 Then
  frmBiaoBiao.DTP1.Month = 12
  frmBiaoBiao.DTP1.Year = Year(Date) - 1
 Else
  frmBiaoBiao.DTP1.Month = Month(Date) - 1
 End If
Else
 frmBiaoBiao.DTP1.Month = Month(Date)
End If
If Data7.Recordset.Fields("每月结束时间") < 0 Then
 If Month(Date) = 12 Then
  frmBiaoBiao.DTP2.Month = 1
  frmBiaoBiao.DTP2.Year = Year(Date) + 1
 Else
  frmBiaoBiao.DTP2.Month = Month(Date) + 1
 End If
Else
 frmBiaoBiao.DTP2.Month = Month(Date)
End If
frmBiaoBiao.DTP1.Hour = 0
frmBiaoBiao.DTP1.Minute = 0
frmBiaoBiao.DTP1.Second = 0
frmBiaoBiao.DTP2.Hour = 23
frmBiaoBiao.DTP2.Minute = 59
frmBiaoBiao.DTP2.Second = 59

End Sub

Private Sub cdView1_Click()
ListView1.View = lvwIcon
cdView1.Checked = True
cdView2.Checked = False
cdView3.Checked = False
cdView4.Checked = False
End Sub

Private Sub cdView10_Click()
'还原为默认
LoadShow True
End Sub

Private Sub cdView2_Click()
ListView1.View = lvwSmallIcon
cdView1.Checked = False
cdView2.Checked = True
cdView3.Checked = False
cdView4.Checked = False

End Sub

Private Sub cdView3_Click()
ListView1.View = lvwList
cdView1.Checked = False
cdView2.Checked = False
cdView3.Checked = True
cdView4.Checked = False

End Sub

Private Sub cdView4_Click()
ListView1.View = lvwReport
cdView1.Checked = False
cdView2.Checked = False
cdView3.Checked = False
cdView4.Checked = True

End Sub

Private Sub cdView5_Click()
'ListView1.SortKey = Index
'ListView1.Sorted = True
'ListView1.Refresh
Timer2_Timer
End Sub

Private Sub cdView6_Click()
cdView6.Checked = IIf(cdView6.Checked, fals, True)
ListView1.GridLines = cdView6.Checked
End Sub

Private Sub cdView7_Click()
'设置字体

On Error Resume Next
ComDlg.CancelError = True
ComDlg.Flags = 3 Or &H100

 ComDlg.FontSize = ListView1.Font.Size
 ComDlg.FontItalic = ListView1.Font.Italic
 ComDlg.FontBold = ListView1.Font.Bold
 ComDlg.FontName = ListView1.Font.Name
 ComDlg.Color = ListView1.ForeColor


ComDlg.ShowFont
If Err = 0 Then
ListView1.Font.Size = ComDlg.FontSize
ListView1.Font.Italic = ComDlg.FontItalic
ListView1.Font.Bold = ComDlg.FontBold
ListView1.Font.Name = ComDlg.FontName
ListView1.ForeColor = ComDlg.Color
With Data8.Recordset
 .MoveFirst
 For i = 1 To .RecordCount
   If .Fields("用户名称") = UserName Then
    .Edit
     .Fields("字体") = ComDlg.FontName
     .Fields("字号") = ComDlg.FontSize
     .Fields("字体颜色") = ComDlg.Color
     .Fields("粗体") = ComDlg.FontBold
     .Fields("斜体") = ComDlg.FontItalic
    .Update
    Exit Sub
   End If
   .MoveNext
 Next i
 
 
End With
End If
End Sub

Private Sub cdView8_Click()
'设置图片
On Error Resume Next
ComDlg.Filter = "所有图型文件|*.dib;*.bmp;*.wmf;*.emf;*.gif;*.jpg|" & _
         "位图文件(*.bmp,*.dib)|*.bmp;*.dib|" & _
         "GIF图像(*.gif)|*.gif|" & _
         "JPEG图像(*.jpg)|*.jpg|" & _
         "元文件(*.wmf,*.emf)|*.wmf;*.emf|" & _
         "图标文件(*.ico,*.cur|*.ico;*.cur|"

ComDlg.ShowOpen
If Err = 0 Then
 ListView1.Picture = LoadPicture(ComDlg.FileName)
 If Err = 0 Then
   With Data8.Recordset
   .MoveFirst
   For i = 1 To .RecordCount
    If .Fields("用户名称") = UserName Then
     .Edit
     .Fields("背景") = ComDlg.FileName
     .Update
     Exit Sub
     End If
   '   MsgBox .Fields("背景")
     .MoveNext
      Next i
    End With
  Else
   MsgBox Error, vbCritical
 End If
End If
End Sub

Private Sub cdView9_Click()
'背景颜色
On Error Resume Next
With ComDlg
 .CancelError = True
 .Flags = 2 Or 1
 .Color = ListView1.BackColor
 .ShowColor
If Err = 0 Then
ListView1.BackColor = .Color


End If
End With
With Data8.Recordset
 .MoveFirst
 For i = 1 To .RecordCount
   If .Fields("用户名称") = UserName Then
    .Edit
     .Fields("背景颜色") = ComDlg.Color
    .Update
    Exit Sub
   End If
   .MoveNext
 Next i
 
 
End With
End Sub







Private Sub Form_Load()
On Error Resume Next
If App.PrevInstance = True Then End

SystemPath = App.Path
If Right(SystemPath, 1) <> "\" Then SystemPath = SystemPath + "\"

'MsgBox SupperMsgbox("ASFDF", vbYesNo, "asd")



Image2.Top = 4095


Data1.DatabaseName = SystemPath + "dbase.mdb" '机时表
Data1.Connect = ";pwd=123456"
Data1.RecordSource = "yxsjb"
Data1.Refresh
Data1.Recordset.MoveLast
Data1.Recordset.MoveFirst

Data2.DatabaseName = SystemPath + "dbase.mdb" '商品临时记录表
Data2.Connect = ";pwd=123456"
Data2.RecordSource = "splsjlb"
Data2.Refresh
Data2.Recordset.MoveLast
Data2.Recordset.MoveFirst

Data3.DatabaseName = SystemPath + "dbase.mdb" '商品库存表
Data3.Connect = ";pwd=123456"
Data3.RecordSource = "spkcb"
Data3.Refresh
Data3.Recordset.MoveLast
Data3.Recordset.MoveFirst

Data4.DatabaseName = SystemPath + "dbase.mdb" '上机流水帐表
Data4.Connect = ";pwd=123456"
Data4.RecordSource = "sjlszb"
Data4.Refresh
Data4.Recordset.MoveLast
Data4.Recordset.MoveFirst

Data5.DatabaseName = SystemPath + "dbase.mdb" '客户商品表
Data5.Connect = ";pwd=123456"
Data5.RecordSource = "khspb"
Data5.Refresh
Data5.Recordset.MoveLast
Data5.Recordset.MoveFirst

Data6.DatabaseName = SystemPath + "dbase.mdb" '储金卡管理
Data6.Connect = ";pwd=123456"
Data6.RecordSource = "cjkgl"
Data6.Refresh
Data6.Recordset.MoveLast
Data6.Recordset.MoveFirst

Data7.DatabaseName = SystemPath + "dbase.mdb" '系统设置
Data7.Connect = ";pwd=123456"
Data7.RecordSource = "xtsz"
Data7.Refresh
Data7.Recordset.MoveLast
Data7.Recordset.MoveFirst

Data8.DatabaseName = SystemPath + "dbase.mdb" '用户设置表
Data8.Connect = ";pwd=123456"
Data8.RecordSource = "yhszb"
Data8.Refresh
Data8.Recordset.MoveLast
Data8.Recordset.MoveFirst

Data9.DatabaseName = SystemPath + "dbase.mdb" '客户设置表
Data9.Connect = ";pwd=123456"
Data9.RecordSource = "khglb"
Data9.Refresh
Data9.Recordset.MoveLast
Data9.Recordset.MoveFirst

Data10.DatabaseName = SystemPath + "dbase.mdb" '客户设置表
Data10.Connect = ";pwd=123456"
Data10.RecordSource = "quickhttp"
Data10.Refresh
Data10.Recordset.MoveLast
Data10.Recordset.MoveFirst

Data11.DatabaseName = SystemPath + "dbase.mdb" '客户设置表
Data11.Connect = ";pwd=123456"
Data11.RecordSource = "hickhttp"
Data11.Refresh
Data11.Recordset.MoveLast
Data11.Recordset.MoveFirst

'If ISRegRight = False Then
'  Dim adata As String * 10, ndata As Date
'  adata = String(10, 32)
'  Open SystemPath + "wbjfq.exe" For Binary As #1
'    Get #1, LOF(1) - 11, adata
    'MsgBox adata, , LOF(1)
   
'  Close #1
 ' ndata = adata
 ' Dim areg As String, breg As String
 ' areg = CStr((Year(ndata) + Month(ndata) + Day(ndata)) * 9)
 '  RegReadValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion", "CommonClass", 1, breg
 '  If areg <> breg Then
 '    If MsgBox("您的使用期已过，请您注册！", vbCritical + vbOKCancel) = vbOK Then
 '     frmRegSoft.Show vbModal, Me
   
 '    End If
 '     End
 '  End If
 
 ' If DateDiff("d", ndata, Date) > 50 Then
 ' If MsgBox("您的使用期已过，请您注册！", vbCritical + vbOKCancel) = vbOK Then
 '  frmRegSoft.Show vbModal, Me
   
 ' End If
 '    End
 ' End If
'End If

Longin
FlashShangPin

LoadShow False
'ListView1.ListItems.Add , , "全部计算机", 1
For i = 1 To Data1.Recordset.RecordCount
Select Case Data1.Recordset.Fields("状态").Value
  Case "Y"
   st = 3
  Case "N"
   st = 2
  Case "P"
   st = 4
  Case "S"
   st = 5
End Select
ListView1.ListItems.Add i, , Data1.Recordset.Fields("名称").Value, st, st
FlashListView (i)
Data1.Recordset.MoveNext
Next i
Form_Resize

ListView1_ItemClick ListView1.SelectedItem
Combo1.Text = Combo1.List(0)
Winsock2.Listen

End Sub

Private Sub Form_Resize()
'改变窗体大小
On Error Resume Next
ListView1.Width = Me.Width - 120
ListView1.Height = Me.Height - Toolbar1.Height - StatusBar1.Height - 800


End Sub

Private Sub Form_Unload(Cancel As Integer)
If MsgBox("如果当前还有机器正在记时，将无法正确提示时间！" + vbCrLf + "真的要退出吗？", vbQuestion + vbYesNo + vbDefaultButton2, "确实要退出吗？") = vbNo Then
 Cancel = True
End If

End Sub






Private Sub ListView1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
ListView1_DblClick
End If
End Sub

Private Sub ListView1_DblClick()
'MsgBox ListView1.SelectedItem.Index
'xx = Screen.TwipsPerPixelX
'yy = Screen.TwipsPerPixelY
Beep