📄 frmmainwatermeterinput_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 frmMainWaterMeterInput_DateInput
BorderStyle = 1 'Fixed Single
Caption = "日期/输入方式选择"
ClientHeight = 3210
ClientLeft = 45
ClientTop = 330
ClientWidth = 5610
Icon = "frmMainWaterMeterInput_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 = 60751873
CurrentDate = 37040
End
Begin VB.ComboBox cmbMonth
Height = 300
ItemData = "frmMainWaterMeterInput_DateInput.frx":0442
Left = 3135
List = "frmMainWaterMeterInput_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 = 1320
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 = "frmMainWaterMeterInput_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 strPYm As String
Dim bytReturnFlag As Byte
Dim strSQL As String
Dim bytCountFlag As Byte '计费状态标志
Dim lngRecordNum As Long '记录数
'不能输入本年大于本月份的水表数据
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 '该月已经计过费了,但 是最近一个月的月份
bytReturnFlag = MsgBox("该月份已经计过费了，是否确定还要重新输入总表指数？", vbYesNo + vbDefaultButton2 + vbExclamation, "警告")
If bytReturnFlag = 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
'一次性生成总水表读数表(MainWaterRead)该月的"空"抄表记录
strYm = strReturmYear & strReturmMonth
strSQL = "select count(*) from MainWaterRead where YM='" & strYm & "'"
lngRecordNum = gConnect.Execute(strSQL).Fields(0).value
If lngRecordNum < 1 Then
Call PlanBeging
gConnect.BeginTrans
On Error GoTo ErrHandleExe
'1---形成"空"记录
Call PlanStep("形成该月总表抄表空记录...", 1)
strSQL = "INSERT MainWaterRead(MWmID,YM,PmWaterRead,WaterRead, WaterRevise) " & _
"SELECT MWmID,YM = '" & strYm & "',PmWaterRead=-1,WaterRead = 0, WaterRevise = 0 " & _
"From MWaterMeter ORDER BY MWmID"
gConnect.Execute strSQL
'2---填入上月水表读数
Call PlanStep("填入上月总水表读数...", 10)
strPYm = PreYm(strYm)
strSQL = "update MainWaterRead " & _
"set MainWaterRead.PmWaterRead=ISNULL((select WaterRead from MainWaterRead as PmMainWaterRead where PmMainWaterRead.Ym=" & strPYm & " and PmMainWaterRead.MWmID=MainWaterRead.MWmID),-1) WHERE MainWaterRead.Ym='" & strYm & "'"
gConnect.Execute strSQL
'3---对于新总表（也就是上月没有抄表记录的总表），"上月水表读数"字段直接填入对应总水表档案中的水表初始读数
Call PlanStep("新总表上月读数处理...", 20)
strSQL = "update MainWaterRead set PmWaterRead=(select MWmStartReadNumber from MWatermeter where MWatermeter.MWmID=MainWaterRead.MWmID) where MainWaterRead.PmWaterRead =-1"
gConnect.Execute strSQL
'4--- 从维修表中得到水表的维修差额(注：子select语句可能返回NULL)
Call PlanStep("导入总水表维修调整吨数...", 30)
strSQL = "update MainWaterRead set WaterRevise =ISNULL((select sum(PMWmRead-LMWmRead) from MWaterMeterFix where MWaterMeterFix.Ym='" & strYm & "' and MWaterMeterFix.MWmID=MainWaterRead.MWmID),0)"
gConnect.Execute strSQL
'5--- 从更换表中得到水表的更换差额(注：子select语句可能返回NULL)
Call PlanStep("导入总水表更换调整吨数...", 40)
strSQL = "update MainWaterRead set WaterRevise =WaterRevise+ISNULL((select sum(OldMWmRead-NewMWmRead) from MWaterMeterInstead where MWaterMeterInstead.Ym='" & strYm & "' and MWaterMeterInstead.OldMWmID=MainWaterRead.MWmID),0)"
gConnect.Execute strSQL
On Error GoTo 0
gConnect.CommitTrans
Call PlanStep("导入水表更换调整吨数...", 50)
Call PlanEnd
End If
Unload Me
If blnSelectFlag = True Then
frmMainWaterMeterInput.Show
Else
frmMainWaterMeterInputMachine.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 + -