📄 frmwatermeterinput_dateinput.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{C932BA88-4374-101B-A56C-00AA003668DC}#1.1#0"; "MSMASK32.OCX"
Begin VB.Form frmWaterMeterInput_DateInput
BorderStyle = 1 'Fixed Single
Caption = "日期/输入方式选择"
ClientHeight = 3210
ClientLeft = 45
ClientTop = 330
ClientWidth = 5610
Icon = "frmWaterMeterInput_DateInput.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3210
ScaleWidth = 5610
ShowInTaskbar = 0 'False
Begin VB.Frame Frame2
Caption = "输入方式"
Height = 975
Left = 150
TabIndex = 12
Top = 1410
Width = 5310
Begin VB.OptionButton optInputMode
Caption = "抄表机输入"
Height = 495
Index = 1
Left = 1680
TabIndex = 4
Top = 330
Width = 1215
End
Begin VB.OptionButton optInputMode
Caption = "手工输入"
Height = 495
Index = 0
Left = 255
TabIndex = 3
Top = 330
Value = -1 'True
Width = 1215
End
End
Begin VB.Frame Frame1
Caption = "时间"
Height = 1140
Left = 150
TabIndex = 7
Top = 135
Width = 5310
Begin MSMask.MaskEdBox txtYear
Height = 300
Left = 1605
TabIndex = 0
Top = 255
Width = 1095
_ExtentX = 1931
_ExtentY = 529
_Version = 393216
MaxLength = 4
Mask = "9999"
PromptChar = " "
End
Begin MSComCtl2.DTPicker dtpODate
Height = 300
Left = 1605
TabIndex = 2
Top = 675
Width = 1530
_ExtentX = 2699
_ExtentY = 529
_Version = 393216
Format = 60948481
CurrentDate = 37040
End
Begin VB.ComboBox cmbMonth
Height = 300
ItemData = "frmWaterMeterInput_DateInput.frx":0442
Left = 3135
List = "frmWaterMeterInput_DateInput.frx":0444
Style = 2 'Dropdown List
TabIndex = 1
Top = 255
Width = 990
End
Begin VB.Label Label1
Caption = "用户用水时段："
Height = 240
Index = 0
Left = 345
TabIndex = 11
Top = 315
Width = 1365
End
Begin VB.Label Label1
Caption = "抄表日期："
Height = 240
Index = 1
Left = 345
TabIndex = 10
Top = 765
Width = 945
End
Begin VB.Label Label1
Caption = "年"
Height = 210
Index = 2
Left = 2820
TabIndex = 9
Top = 315
Width = 210
End
Begin VB.Label Label1
Caption = "月份"
Height = 210
Index = 3
Left = 4170
TabIndex = 8
Top = 315
Width = 435
End
End
Begin VB.CommandButton cmdCancle
Caption = "放弃"
Height = 405
Left = 4215
TabIndex = 6
Top = 2685
Width = 1215
End
Begin VB.CommandButton cmdOK
Caption = "确定"
Height = 405
Left = 2775
TabIndex = 5
Top = 2685
Width = 1215
End
Begin VB.Line Line1
BorderColor = &H80000005&
Index = 1
X1 = 105
X2 = 5520
Y1 = 2565
Y2 = 2565
End
Begin VB.Line Line1
BorderColor = &H80000003&
Index = 0
X1 = 105
X2 = 5520
Y1 = 2550
Y2 = 2550
End
End
Attribute VB_Name = "frmWaterMeterInput_DateInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public strReturmYear As String '返回值-用水时段年
Public strReturmMonth As String '返回值-用水时段月
Public dteReturnODate As Date '返回值-抄表日期
Private Sub cmdCancle_Click()
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim blnSelectFlag As Boolean '记录该窗体optInputMode控件的选择状态
Dim strYm As String
Dim bytReturnFlag As Byte
Dim strSQL As String
Dim lngRecordNum As Long '记录数
Dim strPYm As String '上月年月字符串
Dim btyReturnFlag As Byte
Dim bytCountFlag As Byte '计费状态标志
'不能输入本年大于本月份的水表数据
If Val(Me.txtYear.Text) = Year(Date) And Me.cmbMonth.ListIndex + 1 > Month(Date) Then
Warning "月份不能大于本月!!!"
Exit Sub
End If
strYm = Trim(Me.txtYear.Text) & Me.cmbMonth.Text
bytCountFlag = Detect(strYm)
If bytCountFlag = 2 Then '该月已经计过费了
Warning "该月份已经计过费了，不允许再次进行抄表操作！！！"
Exit Sub
ElseIf bytCountFlag = 1 Then '该月已经计过费了,但 是最近一个月的月份
btyReturnFlag = MsgBox("该月份已经计过费了，是否确定还要输入用户水表指数？" & Chr(13) & Chr(13) & "如果确需输入，则输入完后必须从新计费！", vbYesNo + vbDefaultButton2 + vbExclamation, "警告")
If btyReturnFlag = vbNo Then Exit Sub
End If
bytReturnFlag = MsgBox("请仔细核对你所选择的用水时段及抄表时间" & Chr(13) & Chr(13) & "确定要进行抄表操作吗?", vbYesNo + vbInformation + vbDefaultButton2, "提示信息")
If bytReturnFlag = vbNo Then
Exit Sub
End If
blnSelectFlag = optInputMode(0).value
strReturmYear = Trim(Me.txtYear.Text)
strReturmMonth = Me.cmbMonth.Text
dteReturnODate = Me.dtpODate.value
'一次性生成水表读数表(UserWaterRead)该月的"空"抄表记录
'注意：生成空表时 PmWaterRead 的值为-1,WaterRead 的值为-1,前者目的是标志出新开户用户，后者目的是标志出未抄表用户
strYm = strReturmYear & strReturmMonth
strSQL = "select count(*) from UserWaterRead where YM='" & strYm & "'" '取得该月的水表读数记录数
lngRecordNum = 0
lngRecordNum = gConnect.Execute(strSQL).Fields(0).value
If lngRecordNum = 0 Then '记录数为空,表示该月尚未抄表则生成空表记录(并填入上月指数)
Call PlanBeging
gConnect.BeginTrans
On Error GoTo ErrHandleExe
'1---生成"空"记录
Call PlanStep("生成该月抄表空记录...", 1)
strSQL = "INSERT UserWaterRead(PID, QID, UID, YM, WmID, PmWaterRead,WaterRead, WaterRevise) " & _
"SELECT PID, QID, UID, YM = '" & strYm & "', WmID,PmWaterRead=-1, WaterRead = -1, WaterRevise = 0 " & _
"From UserRecord WHERE Status = '1' ORDER BY UID"
gConnect.Execute strSQL
'2---填入上月水表读数
Call PlanStep("填入上月水表读数...", 10)
strPYm = PreYm(strYm)
strSQL = "update UserWaterRead " & _
"set UserWaterRead.PmWaterRead=ISNULL((select WaterRead from UserWaterRead as PmUserWaterRead where PmUserWaterRead.Ym=" & strPYm & " and PmUserWaterRead.UID=UserWaterRead.UID),-1) WHERE UserWaterRead.Ym='" & strYm & "'"
gConnect.Execute strSQL
'3---对于新开户用户（也就是上月没有抄表记录的用户），"上月水表读数"字段直接填入对应用户水表档案中的水表初始读数
Call PlanStep("新开户用户上月读数处理...", 20)
strSQL = "update UserWaterRead set PmWaterRead=(select WmStartReadNumber from WaterMeter where WaterMeter.UID=UserWaterRead.UID) where UserWaterRead.PmWaterRead =-1"
gConnect.Execute strSQL
'4--- 从维修表中得到水表的维修差额(注：子select语句可能返回NULL)
Call PlanStep("导入水表维修调整吨数...", 30)
strSQL = "update UserWaterRead set WaterRevise =ISNULL((select sum(PWmRead-LWmRead) from UWaterMeterFix where UWaterMeterFix.Ym='" & strYm & "' and UWaterMeterFix.UID=UserWaterRead.UID),0)"
gConnect.Execute strSQL
'5--- 从更换表中得到水表的更换差额(注：子select语句可能返回NULL)
Call PlanStep("导入水表更换调整吨数...", 40)
strSQL = "update UserWaterRead set WaterRevise =WaterRevise+ISNULL((select sum(OldWmRead-NewWmRead) from UWaterMeterInstead where UWaterMeterInstead.Ym='" & strYm & "' and UWaterMeterInstead.UID=UserWaterRead.UID),0)"
gConnect.Execute strSQL
On Error GoTo 0
gConnect.CommitTrans
Call PlanStep("导入水表更换调整吨数...", 50)
Call PlanEnd
End If
Unload Me
If blnSelectFlag = True Then
frmWaterMeterInput.Show
Else
frmWaterMeterInputMachine.Show
End If
Exit Sub
'-------错误处理---------
ErrHandleExe:
On Error GoTo 0
gConnect.RollbackTrans
Call PlanEnd
Warning "生成当月空抄表记录失败！" & Chr(13) & Err.Description
'初始化返回数值
strReturmYear = ""
strReturmMonth = ""
dteReturnODate = Date
Me.cmdOK.Enabled = False
End Sub
Private Sub Form_Load()
MoveToCenter gMainFormRefer, Me
txtYear.Text = Trim(Str(Year(Date)))
cmbMonth.AddItem ("01")
cmbMonth.AddItem ("02")
cmbMonth.AddItem ("03")
cmbMonth.AddItem ("04")
cmbMonth.AddItem ("05")
cmbMonth.AddItem ("06")
cmbMonth.AddItem ("07")
cmbMonth.AddItem ("08")
cmbMonth.AddItem ("09")
cmbMonth.AddItem ("10")
cmbMonth.AddItem ("11")
cmbMonth.AddItem ("12")
cmbMonth.ListIndex = Month(Date) - 1
Me.dtpODate.value = Date
strReturmYear = ""
strReturmMonth = ""
dteReturnODate = Date
End Sub
Private Function Detect(ByVal strYm As String) As Byte
'-------------------------
'功能： 在计费表(WaterRate)中查询是否已经存在指定月份的计费数据，如果已经有了且是以往月份的则不允许再输入水表读数了，否则如果有但是最近一月的则还可以再输入
'参数： strYm 指定的年月 格式：YYYYMM
'返回值: 0 不存在，尚未计费
' 1 已经存在，但 是最近一个月的月份
' 2 已经存在，且 是以往月的月份
'用法:
'建立: 2001/5/29 by pc
'修改:
'修改内容:
'-------------------------
Dim strSQL As String
Dim lngNumberOfRecord As Long
Dim strTmp As String
strSQL = "select Count(*) from WaterRate where Ym='" & strYm & "'"
lngNumberOfRecord = gConnect.Execute(strSQL).Fields(0).value
If lngNumberOfRecord = 0 Then
Detect = 0
Else
strSQL = "select Max(Ym) from WaterRate"
strTmp = gConnect.Execute(strSQL).Fields(0).value
If strTmp = strYm Then
Detect = 1
Else
Detect = 2
End If
End If
End Function
Private Sub PlanBeging()
Me.Enabled = False
frmWaterrateCountWait.pgbPlan.Max = 50
frmWaterrateCountWait.pgbPlan.Min = 0
frmWaterrateCountWait.Show
End Sub
Private Sub PlanStep(ByVal strInfo As String, ByVal intValue As Integer)
frmWaterrateCountWait.lblInfo.Caption = strInfo
frmWaterrateCountWait.pgbPlan.value = intValue
frmWaterrateCountWait.Refresh
End Sub
Private Sub PlanEnd()
Unload frmWaterrateCountWait
Me.Enabled = True
End Sub
Private Sub txtYear_GotFocus()
Call AutoSelectText(txtYear)
End Sub
Private Sub txtYear_KeyPress(KeyAscii As Integer)
Call IfEnterKeyMoveNext(KeyAscii)
End Sub
Private Sub txtYear_LostFocus()
If Trim(Me.txtYear.Text) = "" Then
Warning "日期格式输入错误!!!"
Me.txtYear.SetFocus
Exit Sub
End If
If Val(Me.txtYear.Text) < 1900 Or Val(Me.txtYear.Text) > 9999 Then
Warning "日期格式输入错误!!!"
Me.txtYear.SetFocus
Exit Sub
End If
End Sub
Private Sub cmbMonth_KeyPress(KeyAscii As Integer)
Call IfEnterKeyMoveNext(KeyAscii)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -