frmaddnew.frm

对家庭的开支有一个全面的了解和统计

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmaddnew 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "添加一条新开支记录"
   ClientHeight    =   3300
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6150
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   3300
   ScaleWidth      =   6150
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox cbo_xkind 
      Height          =   300
      Left            =   4560
      TabIndex        =   15
      Top             =   1680
      Width           =   1335
   End
   Begin VB.CommandButton cmdexit 
      Caption         =   "退出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   4560
      TabIndex        =   7
      Top             =   2280
      Width           =   1095
   End
   Begin VB.CommandButton cmdcancel 
      Caption         =   "取消"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2640
      TabIndex        =   8
      Top             =   2280
      Width           =   1215
   End
   Begin VB.CommandButton cmdok 
      Caption         =   "确定"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   360
      TabIndex        =   6
      Top             =   2280
      Width           =   1215
   End
   Begin VB.TextBox txt_order 
      Height          =   375
      Left            =   1440
      MaxLength       =   9
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
   Begin VB.TextBox txt_money 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "￥#,###.00"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   2052
         SubFormatType   =   0
      EndProperty
      Height          =   375
      Left            =   1440
      TabIndex        =   5
      Top             =   1680
      Width           =   1215
   End
   Begin VB.ComboBox cbo_usename 
      Height          =   300
      ItemData        =   "frmaddnew.frx":0000
      Left            =   1440
      List            =   "frmaddnew.frx":000A
      TabIndex        =   2
      Text            =   "王训"
      Top             =   960
      Width           =   1215
   End
   Begin VB.ComboBox cbo_kind 
      Height          =   300
      ItemData        =   "frmaddnew.frx":001C
      Left            =   4560
      List            =   "frmaddnew.frx":001E
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   960
      Width           =   1335
   End
   Begin MSComCtl2.DTPicker DTPicker_date 
      BeginProperty DataFormat 
         Type            =   1
         Format          =   "yyyy-MM-dd"
         HaveTrueFalseNull=   0
         FirstDayOfWeek  =   0
         FirstWeekOfYear =   0
         LCID            =   2052
         SubFormatType   =   3
      EndProperty
      Height          =   375
      Left            =   4560
      TabIndex        =   1
      Top             =   120
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   661
      _Version        =   393216
      Format          =   23855105
      CurrentDate     =   37940
   End
   Begin VB.Label Label2 
      Caption         =   "开支小类别："
      Height          =   255
      Left            =   3240
      TabIndex        =   14
      Top             =   1680
      Width           =   1095
   End
   Begin VB.Label Label1 
      Height          =   375
      Left            =   720
      TabIndex        =   13
      Top             =   2880
      Width           =   4695
   End
   Begin VB.Label laborder 
      Caption         =   "开支编号："
      Height          =   375
      Left            =   120
      TabIndex        =   12
      Top             =   120
      Width           =   1095
   End
   Begin VB.Label labdate 
      Caption         =   "开支日期："
      Height          =   375
      Left            =   3240
      TabIndex        =   11
      Top             =   120
      Width           =   1095
   End
   Begin VB.Label ladusename 
      Caption         =   "开支人："
      Height          =   375
      Left            =   120
      TabIndex        =   10
      Top             =   960
      Width           =   1095
   End
   Begin VB.Label labkind 
      Caption         =   "开支大类别："
      Height          =   375
      Left            =   3240
      TabIndex        =   9
      Top             =   960
      Width           =   1095
   End
   Begin VB.Label labmoney 
      Caption         =   "开支金额："
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Top             =   1680
      Width           =   1095
   End
End
Attribute VB_Name = "frmaddnew"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Database
Dim rs As Recordset
Dim neworder As String
Dim newdate As Date
Dim newusename As String
Dim newkind As String
Dim newxkind As String
Dim newmoney As Currency

Private Sub cbo_kind_Click()
Dim sql As String
Dim xkrs As Recordset
sql = "select xkind_name from xkind where dkind_name ='" & Trim$(cbo_kind.Text) & "'"
Set xkrs = db.OpenRecordset(sql)
cbo_xkind.Clear
If Not xkrs.EOF Then
   xkrs.MoveFirst
   Do Until xkrs.EOF
       cbo_xkind.AddItem Trim$(xkrs!xkind_name)
       xkrs.MoveNext
    Loop
Else
  MsgBox "数据库中没有小类别数据,请在添加!", vbOKOnly + vbInformation, "设置小类别"
End If
cbo_xkind.ListIndex = 0
End Sub

Private Sub cbo_kind_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub

Private Sub cbo_usename_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub

Private Sub cmdcancel_Click()
txt_order.Text = ""
'DTPicker_date.Value = "date$(now)"
cbo_usename.Text = ""
cbo_kind.Text = ""
txt_money.Text = ""
cmdexit.SetFocus
End Sub

Private Sub cmdexit_Click()
Unload Me
frmmain.Show
End Sub

Private Sub cmdok_Click()
'判断各输入框的内容是否为空
If Trim$(txt_order.Text) = "" Then
   MsgBox "开支编号不能为空,请输入开支编号!", vbOKOnly + vbExclamation, "警告"
   txt_order.SetFocus
   Exit Sub
End If

If Trim$(DTPicker_date.Value) = "" Then
   MsgBox "开支日期不能为空,请选择开支日期!", vbOKOnly + vbExclamation, "警告"
   DTPicker_date.SetFocus
   Exit Sub
End If

If Trim$(cbo_usename.Text) = "" Then
   MsgBox "开支人不能为空,请选择开支人!", vbOKOnly + vbExclamation, "警告"
   cbo_usename.SetFocus
   Exit Sub
End If

If Trim$(cbo_kind.Text) = "" Then
   MsgBox "开支大类别不能为空,请选择开支类别!", vbOKOnly + vbExclamation, "警告"
   cbo_kind.SetFocus
   Exit Sub
End If

If Trim$(cbo_xkind.Text) = "" Then
   MsgBox "开支小类别不能为空,请选择开支类别!", vbOKOnly + vbExclamation, "警告"
   cbo_xkind.SetFocus
   Exit Sub
End If


If Trim$(txt_money.Text) = "" Then
   MsgBox "开支金额不能为空,请输入开支金额!", vbOKOnly + vbExclamation, "警告"
   txt_money.SetFocus
   Exit Sub
End If


'判断开支编号是否输入数字.
If Not IsNumeric(Trim$(txt_order.Text)) Then
   MsgBox "请输入数字,开支编号要是数字!", vbOKOnly + vbExclamation, "警告"
   txt_order.SetFocus
   txt_order.Text = ""
   Exit Sub
End If
'检查有没有重复的记录
Dim db1 As Database
Dim rst1 As Recordset
Dim sql As String

Set db1 = OpenDatabase(App.Path & "\payout.mdb")
sql = "select * from payout where pay_order=" & (txt_order.Text)
Set rst1 = db.OpenRecordset(sql)

If rst1.EOF = False Then
   MsgBox "开支编号重复,请重新输入", vbOKOnly + vbExclamation, "警告"
   rst1.Close
   txt_order.SetFocus
   txt_order.Text = ""
   Exit Sub
Else
   rst1.Close
   '添加记录
   neworder = Trim$(txt_order.Text)
   newdate = Trim$(DTPicker_date.Value)
   newusename = Trim$(cbo_usename.Text)
   newkind = Trim$(cbo_kind.Text)
   newxkind = Trim$(cbo_xkind.Text)
   newmoney = Trim$(txt_money.Text)
   
   With rs
   .addnew
   !pay_order = CLng(neworder)
   !pay_date = newdate
   !pay_usename = newusename
   !pay_kind = newkind
   !payx_kind = newxkind
   !pay_money = newmoney
   .Update
   End With
End If
MsgBox "你已经成功地把一条新记录加到数据库中了。", vbInformation + vbOKOnly, "成功增加新记录"
txt_order.Text = ""
'DTPicker_date.Value = Date
'cbo_usename.Text = ""
'cbo_kind.Text = ""
cbo_xkind.Text = ""
txt_money.Text = ""
cbo_kind.SetFocus



' 判断现在是几月，来决定开支编号中月份的写法
Dim yue As String
If Month(Date) >= 10 Then
   yue = Month(Date)
Else
   yue = "0" & Month(Date)
End If


' 判断数据库中该月的开支条数，来决定开支编号中开支编号部分的写法

Dim kzsql As String
Dim kzrst As Recordset
Dim b As Integer
Set db = OpenDatabase(App.Path & "\payout.mdb")
rs.Index = ("pay_order")
kzsql = "select * from  payout where pay_date >= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "01" & " #"
'sql1 = "select * from payout where pay_date " & ">=" & "#" & Year(Date) & "-" & Month(Date$) & "-" & "01" & "#"
Set kzrst = db.OpenRecordset(kzsql)
b = kzrst.RecordCount

If Len(b) >= 4 Then
   txt_order.Text = Year(Now) & yue & (b + 1)
ElseIf Len(b) = 3 Then
   txt_order.Text = Year(Now) & yue & "0" & (b + 1)
ElseIf Len(b) = 2 Then
   txt_order.Text = Year(Now) & yue & "00" & (b + 1)
Else
   MsgBox "当月没有开支记录,请输入新的开支记录!", vbOKOnly + vbInformation, "提示"
End If




Dim dbs As Database
Dim xrs As Recordset
 Set dbs = OpenDatabase(App.Path & "\payout.mdb")
  'sql = "select * from payout where  pay_date >= #2003-12-1# "
  ' sql = "select * from  payout where pay_date >= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "01" & " #"
'  Set xrs = dbs.OpenRecordset(sql)
 ' xrs.MoveLast
  
 ' If xrs.RecordCount = 0 Then
 '     MsgBox "按你所指定的条件查询没有记录,请重新设置条件查询!", vbOKOnly + vbInformation, "查询没有记录"
'      Exit Sub
'   End If
'txt_order.Text = Year(Date$) & Month(Date$) & (0) & (xrs.RecordCount + 1)
Label1.Caption = "数据库中已有：" & (rs.RecordCount) & "条记录。"
End Sub

Private Sub cmdok_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub

Private Sub Command1_Click()
Dim rcord As Recordset
Dim kzsql As String
Dim dbx As Database
kzsql = "select * from  payout where pay_date >= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "01" & " #"
Set dbx = OpenDatabase(App.Path & "\payout.mdb")
Set rcord = db.OpenRecordset(kzsql)
Label3.Caption = rcord.RecordCount

End Sub

Private Sub DTPicker_date_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
  SendKeys "{TAB}"
End If

End Sub

Private Sub Form_Activate()
Dim dkrs As Recordset
Set dkrs = db.OpenRecordset("dkind")
If Not dkrs.EOF Then
   dkrs.MoveFirst
   Do Until dkrs.EOF
       cbo_kind.AddItem Trim$(dkrs!dkind_name)
       dkrs.MoveNext
    Loop
Else
  MsgBox "数据库中没有大类别数据,请在添加!", vbOKOnly + vbInformation, "设置大类别"
End If
End Sub

Private Sub Form_Load()
Set db = OpenDatabase(App.Path & "\payout.mdb")
Set rs = db.OpenRecordset("payout")
DTPicker_date.Value = Date

' 判断现在是几月，来决定开支编号中月份的写法
Dim yue As String
If Month(Date) >= 10 Then
   yue = Month(Date)
Else
   yue = "0" & Month(Date)
End If


' 判断数据库中该月的开支条数，来决定开支编号中开支编号部分的写法

Dim kzsql As String
Dim kzrst As Recordset
Dim b As Integer
Set db = OpenDatabase(App.Path & "\payout.mdb")
'Set rs = db.OpenRecordset("payout")
'rs.Index = ("pay_order")
'kzsql = "select * from payout where pay_order >=" & Year(Date$) & yue & "001"
kzsql = "select * from  payout where pay_date >= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "01" & " #"
Set kzrst = db.OpenRecordset(kzsql)
b = kzrst.RecordCount

If Len(b) >= 4 Then
   txt_order.Text = Year(Now) & yue & (b + 1)
ElseIf Len(b) = 3 Then
   txt_order.Text = Year(Now) & yue & "0" & (b + 1)
ElseIf Len(b) = 2 Then
   txt_order.Text = Year(Now) & yue & "00" & (b + 1)
Else
   MsgBox "当月没有开支记录,请输入新的开支记录!", vbOKOnly + vbInformation, "提示"
End If

End Sub


Private Sub Form_Unload(Cancel As Integer)
frmmain.Show
End Sub

Private Sub txt_money_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub

Private Sub txt_order_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub