📄 frmcharge.frm
字号:
Top = 1935
Width = 1575
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "最近修改日期："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3990
TabIndex = 22
Top = 1950
Width = 1725
End
Begin VB.Label Label9
Alignment = 2 'Center
Caption = "备注："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 105
TabIndex = 18
Top = 3195
Width = 1095
End
Begin VB.Label Label5
Alignment = 2 'Center
Caption = "收费单位："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 165
TabIndex = 17
Top = 1305
Width = 1215
End
Begin VB.Label Label4
Alignment = 2 'Center
Caption = "收费周期："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 4365
TabIndex = 16
Top = 1365
Width = 1410
End
Begin VB.Label Label2
Alignment = 2 'Center
Caption = "收费金额："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 4275
TabIndex = 15
Top = 645
Width = 1440
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "项目名称："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 14
Top = 645
Width = 1305
End
End
Attribute VB_Name = "frmCharge"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mrc As ADODB.Recordset
Dim myBookmark As Variant
Dim mcclean As Boolean
Dim ModifyFlag As Boolean
Private Sub cancelCommand_Click()
Unload Me
End Sub
Private Sub cmdAdd_Click()
ModifyFlag = False
mcclean = False
Frame2.Enabled = False
firstCommand.Enabled = False
previousCommand.Enabled = False
nextCommand.Enabled = False
lastCommand.Enabled = False
txtChargeName.Enabled = True
txtChargeMoney.Enabled = True
txtChargeUnit.Enabled = True
TxtChargeCircle.Enabled = True
txtComment.Enabled = True
txtChargeName.Text = ""
txtChargeMoney.Text = ""
txtChargeUnit.Text = ""
TxtChargeCircle.Text = ""
txtComment.Text = ""
myBookmark = mrc.Bookmark
End Sub
Private Sub deleteCommand_Click()
myBookmark = mrc.Bookmark
If MsgBox("是否删除当前记录？", vbOKCancel, "删除当前记录") = vbOK Then
mrc.MoveNext
If mrc.EOF Then
mrc.MoveFirst
myBookmark = mrc.Bookmark
mrc.MoveLast
mrc.Delete
mrc.Bookmark = myBookmark
Call viewData
Else
myBookmark = mrc.Bookmark
mrc.MovePrevious
mrc.Delete
mrc.Bookmark = myBookmark
Call viewData
End If
Else
mrc.Bookmark = myBookmark
Call viewData
End If
End Sub
Private Sub editCommand_Click()
ModifyFlag = True
mcclean = False
Frame2.Enabled = False
firstCommand.Enabled = False
previousCommand.Enabled = False
nextCommand.Enabled = False
lastCommand.Enabled = False
txtChargeMoney.Enabled = True
txtChargeUnit.Enabled = True
TxtChargeCircle.Enabled = True
txtComment.Enabled = True
myBookmark = mrc.Bookmark
End Sub
Private Sub firstCommand_Click()
mrc.MoveFirst
Call viewData
End Sub
Private Sub Form_Load()
ModifyFlag = True
UserName = "dfa"
CONN = "Provider=SQLOLEDB;Data Source=INET;User Id=sa;PWd=322167;Initial Catalog=House"
Dim txtSQL As String
Dim MsgText As String
txtSQL = "select * from Charge"
Set mrc = ExecuteSQL(txtSQL, MsgText)
mrc.MoveFirst
Call viewData
myBookmark = mrc.Bookmark
mcclean = True
End Sub
Public Sub viewData()
txtChargeName.Text = mrc.Fields(0)
txtChargeMoney.Text = mrc.Fields(1)
txtChargeUnit.Text = mrc.Fields(2)
TxtChargeCircle.Text = mrc.Fields(3)
txtComment.Text = mrc.Fields(4)
txtModifyName.Text = mrc.Fields(5)
txtModifyDate.Text = mrc.Fields(6)
End Sub
Private Sub lastCommand_Click()
mrc.MoveLast
Call viewData
End Sub
Private Sub nextCommand_Click()
mrc.MoveNext
If mrc.EOF Then
mrc.MoveFirst
End If
Call viewData
End Sub
Private Sub previousCommand_Click()
mrc.MovePrevious
If mrc.BOF Then
mrc.MoveLast
End If
Call viewData
End Sub
Private Sub Text3_Change()
End Sub
Private Sub updateCommand_Click()
Dim txtSQL As String
Dim MsgText As String
Dim mrcc As ADODB.Recordset
If mcclean Then
MsgBox "请先修收费项目信息", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
If Not Testtxt(txtChargeName.Text) Then
MsgBox "请输入收费项目名称！", vbOKOnly + vbExclamation, "警告"
txtChargeName.SetFocus
Exit Sub
End If
If Not Testtxt(txtChargeUnit.Text) Then
MsgBox "请输入收费单位！", vbOKOnly + vbExclamation, "警告"
txtChargeMoney.SetFocus
Exit Sub
End If
If Not IsNumeric(txtChargeMoney.Text) Then
MsgBox "请输入收费金额", vbOKOnly + vbExclamation, "警告"
txtChargeUnit.SetFocus
Exit Sub
End If
If Not IsNumeric(TxtChargeCircle.Text) Then
MsgBox "收费周期！", vbOKOnly + vbExclamation, "警告"
TxtChargeCircle.SetFocus
Exit Sub
End If
If ModifyFlag = True Then
mrc.Delete
End If
txtSQL = "select * from Charge where chargename = '" & Trim(txtChargeName.Text) & "'"
Set mrcc = ExecuteSQL(txtSQL, MsgText)
If mrcc.EOF = False Then
MsgBox "收费项目名称重复，请重新输入！", vbOKOnly + vbExclamation, "警告"
mrcc.Close
txtChargeName.SetFocus
Else
mrcc.Close
mrc.AddNew
mrc.Fields(0) = Trim(txtChargeName.Text)
mrc.Fields(1) = Trim(txtChargeMoney.Text)
mrc.Fields(2) = Trim(txtChargeUnit.Text)
mrc.Fields(3) = Trim(TxtChargeCircle.Text)
mrc.Fields(4) = Trim(txtComment.Text)
mrc.Fields(5) = UserName
mrc.Fields(6) = CStr(Date)
mrc.Update
MsgBox "收费项目信息更新成功！", vbOKOnly + vbExclamation, "收费项目信息更新"
mrc.Bookmark = myBookmark
Call viewData
Frame2.Enabled = True
firstCommand.Enabled = True
previousCommand.Enabled = True
nextCommand.Enabled = True
lastCommand.Enabled = True
txtChargeName.Enabled = False
txtChargeMoney.Enabled = False
txtChargeUnit.Enabled = False
TxtChargeCircle.Enabled = False
mcclean = True
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -