📄 frmqu_de.vb
字号:
End Sub
Private Sub cmdnext_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdnext.Click
On Error Resume Next
rs.MoveNext()
If rs.EOF Then
MsgBox("已经在数据库最后一条记录!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
rs.MoveLast()
End If
Call viewdata()
End Sub
Private Sub cmdok_Click()
End Sub
Private Sub cmdprevious_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdprevious.Click
On Error Resume Next
rs.MovePrevious()
If rs.BOF Then
MsgBox("已经在数据库第一条记录!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
rs.MoveFirst()
End If
Call viewdata()
End Sub
Private Sub cmdsave_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdsave.Click
db = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
rs = db.OpenRecordset("payout")
'判断各输入框的内容是否为空
If Trim(txt_order.Text) = "" Then
MsgBox("开支编号不能为空,请输入开支编号!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
txt_order.Focus()
Exit Sub
End If
If Trim(DTPicker_date.Value) = "" Then
MsgBox("开支日期不能为空,请选择开支日期!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
DTPicker_date.Focus()
Exit Sub
End If
If Trim(cbo_usename.Text) = "" Then
MsgBox("开支人不能为空,请选择开支人!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
cbo_usename.Focus()
Exit Sub
End If
If Trim(cbo_kind.Text) = "" Then
MsgBox("开支类别不能为空,请选择开支类别!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
cbo_kind.Focus()
Exit Sub
End If
If Trim(cbo_xkind.Text) = "" Then
MsgBox("开支小类别不能为空,请选择开支类别!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
cbo_xkind.Focus()
Exit Sub
End If
If Trim(txt_money.Text) = "" Then
MsgBox("开支金额不能为空,请输入开支金额!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
txt_money.Focus()
Exit Sub
End If
'判断开支编号是否输入数字.
If Not IsNumeric(Trim(txt_order.Text)) Then
MsgBox("请输入数字,开支编号要是数字!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
txt_order.Focus()
txt_order.Text = ""
Exit Sub
End If
'检查有没有修改开支编号
Dim k As Boolean
If Trim(txt_order.Text) <> txtchange Then
k = True
Else
k = False
End If
'检查有没有重复的记录
Dim db1 As DAO.Database
Dim rst1 As DAO.Recordset
Dim sql As String
db1 = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
sql = "select * from payout where pay_order=" & (txt_order.Text)
rst1 = db.OpenRecordset(sql)
Dim sql2 As String
If k = True And rst1.EOF = False Then
MsgBox("开支编号重复,请重新输入", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
rst1.Close()
txt_order.Focus()
'使各按钮有效
cmdfirst.Enabled = True
cmdlast.Enabled = True
cmdnext.Enabled = True
cmdprevious.Enabled = True
cmddelete.Enabled = True
rs.Index = "pay_order"
'使各文本框无效
txt_order.ReadOnly = True
'UPGRADE_ISSUE: ComboBox 属性 cbo_usename.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
cbo_usename.Locked = True
'UPGRADE_ISSUE: ComboBox 属性 cbo_kind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
cbo_kind.Locked = True
'UPGRADE_ISSUE: ComboBox 属性 cbo_xkind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
cbo_xkind.Locked = True
txt_money.ReadOnly = True
DTPicker_date.Enabled = False
Exit Sub
'使保存按钮无效
cmdsave.Enabled = False
ElseIf k = True And rst1.EOF = True Then
db1 = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
sql2 = "delete * from payout where pay_order = " & txtchange
db1.Execute((sql2))
With rs
.AddNew()
.Fields("pay_order").Value = txt_order.Text
'UPGRADE_WARNING: 未能解析对象 DTPicker_date.Value 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
.Fields("pay_date").Value = DTPicker_date.Value
.Fields("pay_usename").Value = cbo_usename.Text
.Fields("pay_kind").Value = cbo_kind.Text
.Fields("payx_kind").Value = cbo_xkind.Text
.Fields("pay_money").Value = Trim(txt_money.Text)
.Update()
End With
rs.Index = "pay_order"
MsgBox("你已经成功的修改了记录!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
'使各按钮有效
cmdfirst.Enabled = True
cmdlast.Enabled = True
cmdnext.Enabled = True
cmdprevious.Enabled = True
cmddelete.Enabled = True
'使各文本框无效
txt_order.ReadOnly = True
'UPGRADE_ISSUE: ComboBox 属性 cbo_usename.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
cbo_usename.Locked = True
'UPGRADE_ISSUE: ComboBox 属性 cbo_kind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
cbo_kind.Locked = True
'UPGRADE_ISSUE: ComboBox 属性 cbo_xkind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
cbo_xkind.Locked = True
txt_money.ReadOnly = True
DTPicker_date.Enabled = False
'使保存按钮无效
cmdsave.Enabled = False
Else : k = False
Do Until rst1.EOF
rst1.Delete()
rst1.MoveNext()
Loop
rs.MoveFirst()
With rs
.AddNew()
.Fields("pay_order").Value = txt_order.Text
'UPGRADE_WARNING: 未能解析对象 DTPicker_date.Value 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
.Fields("pay_date").Value = DTPicker_date.Value
.Fields("pay_usename").Value = cbo_usename.Text
.Fields("pay_kind").Value = cbo_kind.Text
.Fields("payx_kind").Value = cbo_xkind.Text
.Fields("pay_money").Value = Trim(txt_money.Text)
.Update()
rs.Index = "pay_order"
End With
MsgBox("你已经成功的修改了记录!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
'使各按钮有效
cmdfirst.Enabled = True
cmdlast.Enabled = True
cmdnext.Enabled = True
cmdprevious.Enabled = True
cmddelete.Enabled = True
'使各文本框无效
txt_order.ReadOnly = True
'UPGRADE_ISSUE: ComboBox 属性 cbo_usename.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
cbo_usename.Locked = True
'UPGRADE_ISSUE: ComboBox 属性 cbo_kind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
cbo_kind.Locked = True
'UPGRADE_ISSUE: ComboBox 属性 cbo_xkind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
cbo_xkind.Locked = True
txt_money.ReadOnly = True
DTPicker_date.Enabled = False
'使保存按钮无效
cmdsave.Enabled = False
End If
'是保存按钮无效
cmdsave.Enabled = False
End Sub
Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click
rs.Seek("=", txt_order.Text)
On Error GoTo kk
Call viewdata()
kk:
End Sub
Private Sub DTPicker_date_Change(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles DTPicker_date.Change
'rs.FindFirst "pay_date=dtpicker_date.value"
End Sub
Private Sub DTPicker_date_KeyPressEvent(ByVal eventSender As System.Object, ByVal eventArgs As AxMSComCtl2.DDTPickerEvents_KeyPressEvent) Handles DTPicker_date.KeyPressEvent
If eventArgs.KeyAscii = 13 Then
System.Windows.Forms.SendKeys.Send("{TAB}")
End If
End Sub
'UPGRADE_WARNING: Form 事件 frmmodi_del.Activate 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
Private Sub frmmodi_del_Activated(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Activated
Dim dkrs As DAO.Recordset
dkrs = db.OpenRecordset("dkind")
If Not dkrs.EOF Then
dkrs.MoveFirst()
Do Until dkrs.EOF
cbo_kind.Items.Add(Trim(dkrs.Fields("dkind_name").Value))
dkrs.MoveNext()
Loop
Else
MsgBox("数据库中没有大类别数据,请在添加!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "设置大类别")
End If
End Sub
Private Sub frmmodi_del_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
db = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
rs = db.OpenRecordset("payout")
If rs.EOF Then
MsgBox("记录表中没有记录,请添加记录!")
Else
rs.MoveFirst()
txt_order.Text = rs.Fields("pay_order").Value
DTPicker_date._Value = rs.Fields("pay_date").Value
cbo_usename.Text = rs.Fields("pay_usename").Value
cbo_kind.Text = rs.Fields("pay_kind").Value
txt_money.Text = rs.Fields("pay_money").Value
cbo_xkind.Text = rs.Fields("payx_kind").Value
End If
'使保存按钮无效
cmdsave.Enabled = False
'使各文本框无效
txt_order.ReadOnly = True
'UPGRADE_ISSUE: ComboBox 属性 cbo_usename.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
cbo_usename.Locked = True
'UPGRADE_ISSUE: ComboBox 属性 cbo_kind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
cbo_kind.Locked = True
'UPGRADE_ISSUE: ComboBox 属性 cbo_xkind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
cbo_xkind.Locked = True
txt_money.ReadOnly = True
DTPicker_date.Enabled = False
rs.Index = ("pay_order")
rs.MoveFirst()
Call viewdata()
StatusBar1.Panels(3).Text = "总记录为:" & (rs.RecordCount) & "条 " & "当前为:" & ((rs.PercentPosition) + 1) & "条"
End Sub
'UPGRADE_WARNING: Form 事件 frmmodi_del.Unload 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
Private Sub frmmodi_del_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
frmmain.DefInstance.Show()
End Sub
Private Sub Timer1_Tick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Timer1.Tick
StatusBar1.Panels(2).Text = TimeString
StatusBar1.Panels(1).Text = DateString & WeekDayName(WeekDay(CDate(DateString)), 0, 1)
End Sub
Private Sub txt_money_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles txt_money.KeyPress
Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
If KeyAscii = 13 Then
System.Windows.Forms.SendKeys.Send("{TAB}")
End If
If KeyAscii = 0 Then
eventArgs.Handled = True
End If
End Sub
Private Sub txt_order_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles txt_order.KeyPress
Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
If KeyAscii = 13 Then
System.Windows.Forms.SendKeys.Send("{TAB}")
End If
If KeyAscii = 0 Then
eventArgs.Handled = True
End If
End Sub
End Class
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -