📄 frmhandup.frm
字号:
VERSION 5.00
Begin VB.Form frmHandUp
BorderStyle = 1 'Fixed Single
Caption = "用户缴费"
ClientHeight = 2850
ClientLeft = 45
ClientTop = 330
ClientWidth = 6120
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 2850
ScaleWidth = 6120
Begin VB.ComboBox cmbBuild
Height = 300
Left = 630
Style = 2 'Dropdown List
TabIndex = 10
Top = 120
Width = 2010
End
Begin VB.ListBox lstUser
Height = 1860
Left = 630
TabIndex = 9
Top = 480
Width = 2010
End
Begin VB.CommandButton cmdReturn
Cancel = -1 'True
Caption = "返回"
Height = 420
Left = 4725
TabIndex = 8
Top = 2325
Width = 1200
End
Begin VB.CommandButton cmdAdd
Caption = "添加"
Default = -1 'True
Height = 420
Left = 3420
TabIndex = 7
Top = 2325
Width = 1200
End
Begin VB.Frame Frame1
Caption = "缴纳费用:"
Height = 1950
Left = 2895
TabIndex = 0
Top = 120
Width = 3075
Begin VB.TextBox txtFee
Height = 360
Left = 1125
TabIndex = 1
Top = 1215
Width = 1155
End
Begin VB.Label Label8
Caption = "元"
Height = 255
Left = 2475
TabIndex = 6
Top = 540
Width = 255
End
Begin VB.Label Label6
Caption = "元"
Height = 255
Left = 2475
TabIndex = 5
Top = 1260
Width = 255
End
Begin VB.Label Label7
Alignment = 1 'Right Justify
Caption = "缴纳金额:"
Height = 255
Left = 225
TabIndex = 4
Top = 1260
Width = 855
End
Begin VB.Label lblFee
Alignment = 2 'Center
BorderStyle = 1 'Fixed Single
Height = 345
Left = 1125
TabIndex = 3
Top = 495
Width = 1155
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
Caption = "总金额:"
Height = 255
Left = 225
TabIndex = 2
Top = 540
Width = 825
End
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "楼:"
Height = 255
Left = 0
TabIndex = 12
Top = 165
Width = 525
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
Caption = "门牌:"
Height = 255
Left = 0
TabIndex = 11
Top = 525
Width = 525
End
End
Attribute VB_Name = "frmHandUp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/07/09
'描 述：CBB三表户外计量系统 Ver 5.2
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Dim rcUser As Recordset
Dim rcUserFee As Recordset
Dim curUserID As Integer
Dim curDevID As Integer
Dim curUserAddress As Integer
Dim curTypeID As Integer
Dim curMinFee As Currency
Dim curShutFee As Currency
Sub SelectUserFee()
lblFee = ""
txtFee = ""
If cmbBuild.ListIndex < 0 Or lstUser.ListIndex < 0 Then
Exit Sub
End If
rcUser.MoveFirst
rcUser.Move lstUser.ListIndex
If Not IsNull(rcUser!UserID) Then
curUserID = rcUser!UserID
Else
Exit Sub
End If
SQL = "select SumFee,Ctrlstatus from UserMap where userid=" + Format(curUserID)
Set rcUserFee = dbCbb.OpenRecordset(SQL, dbOpenDynaset)
If rcUserFee.RecordCount > 0 Then
If IsNull(rcUserFee!Sumfee) Then
rcUserFee.Edit
rcUserFee!Sumfee = 0
rcUserFee.Update
Else
lblFee = rcUserFee!Sumfee
End If
End If
End Sub
Private Sub cmbBuild_Click()
Dim curUnit As String
Dim curFloor As String
Dim curDoor As String
Dim curName As String
Dim temUserStr As String
Dim SQL As String
lstUser.Clear
If cmbBuild.ListCount > 0 Then
If cmbBuild.ListIndex < 0 Then
Exit Sub
End If
SQL = "select UserID,Unit,Floor,Door,UserName from UserMap where trim(BuildID)=""" + Trim(cmbBuild.List(cmbBuild.ListIndex)) + """ and trim(UserName)<>""总表"" "
SQL = SQL + "order by val(Unit) ASC,val(Floor) ASC,val(Door) ASC"
Set rcUser = dbCbb.OpenRecordset(SQL, dbOpenSnapshot)
If rcUser.RecordCount > 0 Then
Do While Not rcUser.EOF
If IsNull(curUnit) Then
curUnit = ""
Else
curUnit = Trim(rcUser!Unit)
End If
If IsNull(rcUser!Floor) Then
curFloor = ""
Else
curFloor = Trim(rcUser!Floor)
End If
If IsNull(rcUser!Door) Then
curDoor = ""
Else
curDoor = Trim(rcUser!Door)
End If
If IsNull(rcUser!userName) Then
curName = ""
Else
curName = Trim(rcUser!userName)
End If
temUserStr = curUnit + "单元/" + curFloor + "层/" + curDoor + "号/" + curName
lstUser.AddItem temUserStr
rcUser.MoveNext
Loop
End If
If lstUser.ListCount > 0 Then
lstUser.ListIndex = 0
End If
End If
SelectUserFee
End Sub
Sub fill_cmbBuild()
Dim rcBuild As Recordset
cmbBuild.Clear
SQL = "select distinct BuildID from BuildMap "
Set rcBuild = dbCbb.OpenRecordset(SQL, dbOpenSnapshot)
If rcBuild.RecordCount > 0 And Not rcBuild.EOF And Not rcBuild.BOF Then
Do Until rcBuild.EOF
cmbBuild.AddItem rcBuild!BuildID
rcBuild.MoveNext
Loop
If cmbBuild.ListCount > 0 Then
cmbBuild.ListIndex = 0
End If
End If
End Sub
Private Sub cmdAdd_Click()
Dim temCloseStatus As Boolean
Dim temOpenStatus As Boolean
If rcUserFee.RecordCount > 0 Then
If Trim(txtFee) <> "" And IsNumeric(txtFee) Then
If MsgBox("确定所填写的金额吗？", 4 + 64, "用户缴费") = vbNo Then
Exit Sub
End If
rcUserFee.Edit
'status
AppendStatusInfo "楼" & cmbBuild.List(cmbBuild.ListIndex) & _
"门牌" & lstUser.List(lstUser.ListIndex) & _
" 缴费" & Val(txtFee) & "元", icoBLUE
SaveLog "楼" & cmbBuild.List(cmbBuild.ListIndex) & _
"门牌" & lstUser.List(lstUser.ListIndex) & _
" 缴费" & Val(txtFee) & "元", 0
rcUserFee!Sumfee = rcUserFee!Sumfee + Val(txtFee)
Select Case rcUserFee!Sumfee
Case Is <= gCurShutFee
If gCurAutoShut = 1 Then
'status
AppendStatusInfo "楼" & cmbBuild.List(cmbBuild.ListIndex) & _
"门牌" & lstUser.List(lstUser.ListIndex) & _
"存款余额低于关断金额(自动关断)", icoRED
SaveLog "楼" & cmbBuild.List(cmbBuild.ListIndex) & _
"门牌" & lstUser.List(lstUser.ListIndex) & _
"存款余额低于关断金额(自动关断)", 1
If IsNull(rcUserFee!CtrlStatus) Then
rcUserFee!CtrlStatus = 4
'fCloseStatus = CloseUserGate(curUserAddress)
ElseIf rcUserFee!CtrlStatus <> 4 Then
rcUserFee!CtrlStatus = 4
'fCloseStatus = CloseUserGate(curUserAddress)
End If
Else
'status
AppendStatusInfo "楼" & cmbBuild.List(cmbBuild.ListIndex) & _
"门牌" & lstUser.List(lstUser.ListIndex) & _
"存款余额低于关断金额(警告)", icoRED
SaveLog "楼" & cmbBuild.List(cmbBuild.ListIndex) & _
"门牌" & lstUser.List(lstUser.ListIndex) & _
"存款余额低于关断金额(警告)", 1
If IsNull(rcUserFee!CtrlStatus) Then
rcUserFee!CtrlStatus = 3
ElseIf rcUserFee!CtrlStatus < 3 Then
rcUserFee!CtrlStatus = 3
End If
End If
Case Is <= gCurMinFee
If gCurAutoOpenLamp = 1 Then
'status
AppendStatusInfo "楼" & cmbBuild.List(cmbBuild.ListIndex) & _
"门牌" & lstUser.List(lstUser.ListIndex) & _
"存款余额低于警告金额", icoYELLOW
SaveLog "楼" & cmbBuild.List(cmbBuild.ListIndex) & _
"门牌" & lstUser.List(lstUser.ListIndex) & _
"存款余额低于警告金额", 2
If IsNull(rcUserFee!CtrlStatus) Then
rcUserFee!CtrlStatus = 1
ElseIf rcUserFee!CtrlStatus <> 4 Then
rcUserFee!CtrlStatus = 1
End If
Else
'status
AppendStatusInfo "楼" & cmbBuild.List(cmbBuild.ListIndex) & _
"门牌" & lstUser.List(lstUser.ListIndex) & _
"存款余额低于警告金额", icoYELLOW
SaveLog "楼" & cmbBuild.List(cmbBuild.ListIndex) & _
"门牌" & lstUser.List(lstUser.ListIndex) & _
"存款余额低于警告金额", 1
If IsNull(rcUserFee!CtrlStatus) Then
rcUserFee!CtrlStatus = 1
ElseIf rcUserFee!CtrlStatus < 1 Then
rcUserFee!CtrlStatus = 1
End If
End If
Case Else
If rcUserFee!CtrlStatus = 4 Then
'status
AppendStatusInfo "楼" & cmbBuild.List(cmbBuild.ListIndex) & _
"门牌" & lstUser.List(lstUser.ListIndex) & _
"电表自动打开", icoBLUE
SaveLog "楼" & cmbBuild.List(cmbBuild.ListIndex) & _
"门牌" & lstUser.List(lstUser.ListIndex) & _
"电表自动打开", 0
'temOpenStatus = OpenUserGate(curUserAddress)
End If
rcUserFee!CtrlStatus = 0
End Select
rcUserFee.Update
lblFee = rcUserFee!Sumfee
Else
MsgBox "输入的金额不是有效数据！" & Chr(10) & "请重新输入", , "用户缴费"
End If
End If
txtFee = ""
FreshUserStatus
End Sub
Private Sub cmdReturn_Click()
Unload Me
End Sub
Private Sub Form_Load()
If UBound(curForm) > 0 Then
curForm(UBound(curForm)).Enabled = False
End If
ReDim Preserve curForm(UBound(curForm) + 1)
Set curForm(UBound(curForm)) = Me
fill_cmbBuild
End Sub
Private Sub Form_Unload(Cancel As Integer)
ReDim Preserve curForm(UBound(curForm) - 1)
If UBound(curForm) > 0 Then
curForm(UBound(curForm)).Enabled = True
End If
End Sub
Private Sub lstUser_Click()
SelectUserFee
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -