📄 frmwatermeterfixinput.frm
字号:
Begin VB.CommandButton cmdCommandArray3
Caption = ">>"
Height = 345
Index = 3
Left = 7170
TabIndex = 29
Top = 90
Width = 885
End
Begin VB.CommandButton cmdCommandArray3
Caption = ">"
Height = 345
Index = 2
Left = 6300
TabIndex = 28
Top = 90
Width = 885
End
Begin VB.CommandButton cmdCommandArray3
Caption = "<"
Height = 345
Index = 1
Left = 5430
TabIndex = 27
Top = 90
Width = 885
End
Begin VB.CommandButton cmdCommandArray3
Caption = "<<"
Height = 345
Index = 0
Left = 4560
TabIndex = 26
Top = 90
Width = 885
End
Begin VB.CommandButton cmdCommandArray2
Caption = "放弃"
Height = 345
Index = 1
Left = 3585
TabIndex = 24
Top = 90
Width = 885
End
Begin VB.CommandButton cmdCommandArray2
Caption = "保存"
Height = 345
Index = 0
Left = 2715
TabIndex = 23
Top = 90
Width = 885
End
Begin VB.CommandButton cmdCommandArray1
Caption = "删除"
Height = 345
Index = 2
Left = 1755
TabIndex = 22
Top = 90
Width = 885
End
Begin VB.CommandButton cmdCommandArray1
Caption = "编辑"
Height = 345
Index = 1
Left = 885
TabIndex = 21
Top = 90
Width = 885
End
Begin VB.CommandButton cmdCommandArray1
Caption = "输入"
Height = 345
Index = 0
Left = 15
TabIndex = 20
Top = 90
Width = 885
End
End
Begin VB.Label Label22
Caption = "维修单编号："
Height = 255
Left = 7185
TabIndex = 55
Top = 285
Width = 1080
End
Begin VB.Line Line1
BorderColor = &H80000005&
Index = 0
X1 = 60
X2 = 9885
Y1 = 5310
Y2 = 5310
End
Begin VB.Line Line1
BorderColor = &H80000003&
Index = 1
X1 = 60
X2 = 9900
Y1 = 5295
Y2 = 5295
End
End
Attribute VB_Name = "frmWaterMeterFixInput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim adoUWmFixRS As ADODB.Recordset
Dim bytCommandFlag As Byte '用于记录第一组按钮的状态,这样,在第二组的保存,放弃按钮中
'就可知道是原来是按的新增还是编辑,从而采取不同的处理方法
Dim strCurJFYm As String '当前所处的计费年月（由计费记录表来判断）
'---------------------------------------------------
'按钮事件
'---------------------------------------------------
Private Sub cmdCommandArray1_Click(Index As Integer)
Dim strFixID As String
bytCommandFlag = Index
Select Case Index
Case 0 '输入
strFixID = Trim(GetMaxFixID())
If strFixID = "" Then
Warning "得到维修单编号出错!!!"
Exit Sub
End If
Call DisableCMD1
Call EnableCMD2
Call DisableCMD3
Call InitInterface
Call EnableInterface
Me.txtFixID.Text = strFixID
Me.dtpReportDate.SetFocus
Case 1 '编辑
If Trim(Me.txtFixID.Text) = "" Then Exit Sub
Call DisableCMD1
Call EnableCMD2
Call DisableCMD3
Call EnableInterface
Me.txtFixID.Enabled = False '注意：编辑时只能对该编号用户的维修内容进行编辑
Me.dtpReportDate.SetFocus
Case 2 '删除
Dim bytReturnFlag As Byte '用于接收msgbox
If Trim(Me.txtFixID.Text) = "" Then Exit Sub
If adoUWmFixRS.EOF Or adoUWmFixRS.BOF Then Exit Sub
bytReturnFlag = MsgBox("确定要删除该用户的水表维修记录吗？", vbYesNo + vbInformation + vbDefaultButton2, "提示信息")
If bytReturnFlag = vbNo Then Exit Sub
'删除该记录,清屏
adoUWmFixRS.Delete
On Error Resume Next
adoUWmFixRS.MoveNext
If adoUWmFixRS.EOF Then adoUWmFixRS.MovePrevious
On Error GoTo 0
Call DisplayCurrentData
Call InitCommandBox
Case Else
MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
End Select
End Sub
Private Sub cmdCommandArray2_Click(Index As Integer)
Dim bytReturnFlag As Byte '用于接收msgbox
Select Case Index
Case 0 '保存
'检测关键数据是否填写
If Trim(Me.txtUID.Text) = "" Then
Warning "用户编号没有输入!!!"
Me.txtUID.SetFocus
Exit Sub
End If
'保存提示
bytReturnFlag = MsgBox("请仔细核对维修前、维修后的水表读数以及所属计费时段" & Chr(13) & Chr(13) & "这些数据将直接影响水费的计费操作!!!", vbYesNoCancel + vbInformation + vbDefaultButton1, "提示信息")
If bytReturnFlag = vbNo Then '不保存
Call DisplayCurrentData
ElseIf bytReturnFlag = vbCancel Then '从试
Exit Sub
ElseIf bytReturnFlag = vbYes Then '保存数据
Call SaveCurrenData
End If
Call DisableInterface
Call InitCommandBox
Case 1 '放弃
Call DisplayCurrentData
Call DisableInterface
Call InitCommandBox
Case Else
MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
End Select
End Sub
Private Sub cmdCommandArray3_Click(Index As Integer)
Select Case Index
Case 0 '<<
If adoUWmFixRS.BOF Then '记录集为空的情况
'Warning "已经处于首记录！"
Beep
Exit Sub
End If
adoUWmFixRS.MovePrevious '如果已经是首条的情况,Beep
If adoUWmFixRS.BOF Then
adoUWmFixRS.MoveNext
Beep
Exit Sub
End If
adoUWmFixRS.MoveFirst '正常情况
Call DisplayCurrentData
Case 1 '<
If adoUWmFixRS.BOF Then
'Warning "已经处于首记录！"
Beep
Exit Sub
End If
adoUWmFixRS.MovePrevious
If adoUWmFixRS.BOF Then
adoUWmFixRS.MoveNext
Beep
Else
Call DisplayCurrentData
End If
Case 2 '>
If adoUWmFixRS.EOF Then
'Warning "已经处于尾记录！"
Beep
Exit Sub
End If
adoUWmFixRS.MoveNext
If adoUWmFixRS.EOF Then
adoUWmFixRS.MovePrevious
Beep
Else
Call DisplayCurrentData
End If
Case 3 '>>
If adoUWmFixRS.EOF Then '记录集为空的情况
'Warning "已经处于尾记录！"
Beep
Exit Sub
End If
adoUWmFixRS.MoveNext '如果已经是尾条的情况,Beep
If adoUWmFixRS.EOF Then
adoUWmFixRS.MovePrevious
Beep
Exit Sub
End If
adoUWmFixRS.MoveLast '正常情况
Call DisplayCurrentData
Case Else
MsgBox "按扭功能未定义", vbOKOnly + vbExclamation, "警告"
End Select
End Sub
'---------------------------------------------------
'窗体事件
'---------------------------------------------------
Private Sub Form_Load()
Dim strSQL As String
MoveToCenter gMainFormRefer, Me
'设置关键控件的属性
Me.txtFixID.MaxLength = gFixIDLen
Me.txtFixID.Mask = String(gFixIDLen, "9")
Me.txtUID.MaxLength = gUIDLen
Me.txtUID.Mask = String(gUIDLen, "9")
Me.debPWmRead.MaxLen = 12
Me.debLWmRead.MaxLen = 12
Me.debFixFee.MaxLen = 8
Call FillMonth
Call ClearUWmInfo
'设置当前的水费计费月份
strCurJFYm = Trim(GetCurJFYm())
If strCurJFYm = "" Then
Warning "得到当前计费月份出错!!!"
Call DisableCMD1
Call DisableCMD2
Call DisableCMD3
Exit Sub
End If
'初始化界面
Call InitInterface
Call DisableInterface
'初始化记录集
strSQL = "select * from UWaterMeterFix order by FixID"
On Error GoTo errHandleInit
Set adoUWmFixRS = New ADODB.Recordset
Set adoUWmFixRS.ActiveConnection = gConnect
adoUWmFixRS.CursorLocation = adUseClient
adoUWmFixRS.CursorType = adOpenKeyset
adoUWmFixRS.LockType = adLockOptimistic
adoUWmFixRS.Open strSQL
On Error GoTo 0
If Not (adoUWmFixRS.EOF And adoUWmFixRS.BOF) Then
adoUWmFixRS.MoveLast
End If
Call DisplayCurrentData
Call InitCommandBox
Exit Sub
'-------错误处理---------
errHandleInit:
Warning "记录集初始化失败！" & Chr(13) & Err.Description
On Error GoTo 0
Call DisableCMD1
Call DisableCMD2
Call DisableCMD3
End Sub
'---------------------------------------------------
'自定义函数/过程
'---------------------------------------------------
Private Sub InitInterface()
Me.txtFixID.Text = String(gFixIDLen, " ")
Me.dtpReportDate.value = Date
Me.txtReportMan.Text = ""
Me.txtUID.Text = String(gUIDLen, " ")
Call ClearUserInfo
Me.txtReportStatus.Text = ""
Me.debPWmRead.Text = 0
Me.debLWmRead.Text = 0
Me.txtYear.Text = Mid(strCurJFYm, 1, 4)
Me.cboMonth.ListIndex = Val(Mid(strCurJFYm, 5, 2)) - 1
Me.txtFixStatus.Text = ""
Me.txtVerifyStatus.Text = ""
Me.debFixFee.Text = 0
Me.txtFixMan.Text = ""
Me.dtpFixDate.value = Date
End Sub
Private Sub InitCommandBox()
Call EnableCMD1
'根据"维修单编号"是否为空来决定是否打开"编辑"和"删除"按扭
If Trim(Me.txtFixID.Text) = "" Then
cmdCommandArray1(1).Enabled = False '编辑
cmdCommandArray1(2).Enabled = False '删除
End If
Call DisableCMD2
Call EnableCMD3
End Sub
Private Sub EnableInterface()
Me.txtFixID.Enabled = True
Me.dtpReportDate.Enabled = True
Me.txtReportMan.Enabled = True
Me.txtUID.Enabled = True
Me.txtReportStatus.Enabled = True
Me.debPWmRead.Enabled = True
Me.debLWmRead.Enabled = True
Me.txtYear.Enabled = True
Me.cboMonth.Enabled = True
Me.txtFixStatus.Enabled = True
Me.txtVerifyStatus.Enabled = True
Me.debFixFee.Enabled = True
Me.txtFixMan.Enabled = True
Me.dtpFixDate.Enabled = True
End Sub
Private Sub DisableInterface()
Me.txtFixID.Enabled = False
Me.dtpReportDate.Enabled = False
Me.txtReportMan.Enabled = False
Me.txtUID.Enabled = False
Me.txtReportStatus.Enabled = False
Me.debPWmRead.Enabled = False
Me.debLWmRead.Enabled = False
Me.txtYear.Enabled = False
Me.cboMonth.Enabled = False
Me.txtFixStatus.Enabled = False
Me.txtVerifyStatus.Enabled = False
Me.debFixFee.Enabled = False
Me.txtFixMan.Enabled = False
Me.dtpFixDate.Enabled = False
End Sub
Private Sub FillMonth()
Me.cboMonth.Clear
Me.cboMonth.AddItem "01"
Me.cboMonth.AddItem "02"
Me.cboMonth.AddItem "03"
Me.cboMonth.AddItem "04"
Me.cboMonth.AddItem "05"
Me.cboMonth.AddItem "06"
Me.cboMonth.AddItem "07"
Me.cboMonth.AddItem "08"
Me.cboMonth.AddItem "09"
Me.cboMonth.AddItem "10"
Me.cboMonth.AddItem "11"
Me.cboMonth.AddItem "12"
End Sub
Private Function GetMaxFixID() As String
'得到可用的维修单号
Dim strFixID As String
Dim strSQL As String
If adoUWmFixRS.EOF And adoUWmFixRS.BOF Then
GetMaxFixID = String(gFixIDLen - 1, "0") & "1"
Exit Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -