📄 frmbuildset.frm
字号:
VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form frmBuildSet
BorderStyle = 1 'Fixed Single
Caption = "公寓楼设置"
ClientHeight = 3435
ClientLeft = 45
ClientTop = 330
ClientWidth = 6240
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3435
ScaleWidth = 6240
Begin VB.Data datBuild
Connect = "Access"
DatabaseName = "data\cbb.mdb"
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 120
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "BuildMap"
Top = 3000
Width = 4455
End
Begin VB.CommandButton cmdOK
Caption = "确定 "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 372
Left = 4800
TabIndex = 1
Top = 240
Width = 1215
End
Begin VB.CommandButton cmdCancel
Caption = "取消 "
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4800
TabIndex = 0
Top = 720
Width = 1215
End
Begin MSDBGrid.DBGrid grdBuild
Bindings = "frmBuildSet.frx":0000
Height = 2895
Left = 120
OleObjectBlob = "frmBuildSet.frx":0017
TabIndex = 2
Top = 120
Width = 4455
End
Begin VB.Label Label4
Alignment = 2 'Center
Caption = "用户数:"
Height = 255
Left = 4680
TabIndex = 8
Top = 2520
Width = 735
End
Begin VB.Label Label3
Alignment = 2 'Center
Caption = "状态:"
Height = 255
Left = 4680
TabIndex = 7
Top = 2880
Width = 615
End
Begin VB.Label lblUserSum
BorderStyle = 1 'Fixed Single
Height = 255
Left = 5400
TabIndex = 6
Top = 2520
Width = 735
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fixed Single
Caption = "正常"
Height = 255
Left = 5400
TabIndex = 5
Top = 2880
Width = 735
End
Begin VB.Label Label1
Caption = "地址范围:"
Height = 255
Left = 4800
TabIndex = 4
Top = 1920
Width = 1335
End
Begin VB.Label lblAddr
BorderStyle = 1 'Fixed Single
Height = 255
Left = 4800
TabIndex = 3
Top = 2160
Width = 1335
End
End
Attribute VB_Name = "frmBuildSet"
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 rcGateMap As Recordset
Dim errMsg As String
Function chkValid() As Boolean
datBuild.Refresh
chkValid = True
errMsg = ""
datBuild.Recordset.FindFirst "isnull(BuildID)"
If Not datBuild.Recordset.NoMatch Then
errMsg = errMsg + "存在还未设置的空楼号" + Chr(10)
chkValid = False
End If
datBuild.Recordset.FindFirst "isnull(FrameID)"
If Not datBuild.Recordset.NoMatch Then
errMsg = errMsg + "存在还未设置的空网段号" + Chr(10)
chkValid = False
End If
datBuild.Recordset.FindFirst "ISNULL(Address)"
Do While Not datBuild.Recordset.NoMatch
datBuild.Recordset.Edit
datBuild.Recordset!Address = 0
datBuild.Recordset.Update
datBuild.Recordset.FindNext "ISNULL(Address)"
Loop
datBuild.Recordset.FindFirst "isnull(Ender)"
Do While Not datBuild.Recordset.NoMatch
datBuild.Recordset.Edit
datBuild.Recordset!Ender = 0
datBuild.Recordset.Update
datBuild.Recordset.FindNext "ISNULL(Ender)"
Loop
End Function
Function DupBuild(curChkAdd) As Boolean
Dim rcChkBuild As Recordset
Set rcChkBuild = dbCbb.OpenRecordset("BuildMap", dbOpenSnapshot)
rcChkBuild.FindFirst "Address=" + Format(curChkAdd)
If Not rcChkBuild.NoMatch Then
DupBuild = True
End If
End Function
Private Sub cmdCancel_Click()
dbCbb.Rollback
Unload frmBuildSet
End Sub
Private Sub cmdOK_Click()
errMsg = ""
If (Not chkValid) And errMsg <> "" Then
MsgBox errMsg, 48, "安全器设置错误"
Exit Sub
End If
datBuild.Recordset.FindFirst "isnull(BuildID) or isnull(FrameID) or isnull(Address)"
Do While Not datBuild.Recordset.NoMatch
datBuild.Recordset.Delete
If datBuild.Recordset.EOF Or datBuild.Recordset.AbsolutePosition = -1 Then
If datBuild.Recordset.RecordCount > 0 Then
datBuild.Recordset.MoveFirst
Else
Exit Do
End If
End If
datBuild.Recordset.FindNext "isnull(BuildID) or isnull(FrameID) or isnull(Address)"
Loop
dbCbb.CommitTrans
If datBuild.Recordset.RecordCount > 0 Then
SQL = "select FrameID,count(FrameID) from BuildMap group by FrameID"
Dim rcBuildSum As Recordset
Dim rcFrame As Recordset
Set rcFrame = dbCbb.OpenRecordset("GateMap", dbOpenDynaset)
Set rcBuildSum = dbCbb.OpenRecordset(SQL)
If rcBuildSum.RecordCount > 0 Then
rcBuildSum.MoveFirst
Do While Not rcBuildSum.EOF
rcFrame.FindFirst "FrameID=" + Format(rcBuildSum.Fields(0))
If Not rcFrame.NoMatch Then
rcFrame.Edit
rcFrame!BuildSum = rcBuildSum.Fields(1)
rcFrame.Update
End If
rcBuildSum.MoveNext
Loop
End If
End If
'status
AppendStatusInfo "修改公寓楼设置", icoBLUE
SaveLog "修改公寓楼设置", 0
Unload frmBuildSet
End Sub
Private Sub datBuild_Reposition()
If Not datBuild.Recordset.EOF Then
If IsNull(datBuild.Recordset!BuildID) Then
datBuild.Caption = ""
Else
datBuild.Caption = "网关:" + Trim(datBuild.Recordset!BuildID)
End If
'注:这里不能用IIF()函数,当datBuild.recordset!***为NULL时会出错
If IsNull(datBuild.Recordset!Status) Then
lblStatus.Caption = ""
Else
lblStatus.Caption = getStatusStr(datBuild.Recordset!Status)
End If
If IsNull(datBuild.Recordset!UserSum) Then
lblUserSum.Caption = ""
Else
lblUserSum.Caption = datBuild.Recordset!UserSum
End If
End If
End Sub
Private Sub Form_Load()
On Error GoTo ProcError
If UBound(curForm) > 0 Then
curForm(UBound(curForm)).Enabled = False
End If
ReDim Preserve curForm(UBound(curForm) + 1)
Set curForm(UBound(curForm)) = Me
datBuild.DatabaseName = App.Path & "\data\cbb.mdb"
lblAddr = Format(LBuild) + "---" + Format(UBuild)
dbCbb.BeginTrans
'status
AppendStatusInfo "查看公寓楼设置", icoBLUE
SaveLog "查看公寓楼设置", 0
DoEvents
Exit Sub
ProcError:
ProcErr
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 grdBuild_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
On Error GoTo ProcError
Dim rcChkBuild As Recordset
Select Case ColIndex
Case 0 '检查楼号
Dim curBuildID As String
If Len(grdBuild.Columns(0).Value) > 20 Then
MsgBox "楼号不能超过20个字符", 48, "安全器设置"
Cancel = True
Exit Sub
End If
curBuildID = Trim(grdBuild.Columns(0).Value)
Set rcChkBuild = dbCbb.OpenRecordset("BuildMap", dbOpenSnapshot)
rcChkBuild.FindFirst "trim(BuildID)=""" + curBuildID + """"
If Not rcChkBuild.NoMatch Then
MsgBox "该楼号已经被占用" + Chr(10) + "请重新选择楼号", 48, "楼号设置"
Cancel = True
End If
Case 1 '检查网段号设置有效性
Dim curFrameID As Integer
Dim rcChkGate As Recordset
If Not IsNumeric(grdBuild.Columns(1).Value) Then
MsgBox "网关号必须为整数", 48, "安全器设置"
Cancel = True
Exit Sub
End If
curFrameID = grdBuild.Columns(1).Value
Set rcChkGate = dbCbb.OpenRecordset("GateMap", dbOpenSnapshot)
rcChkGate.FindFirst "FrameID=" + Format(curFrameID)
If rcChkGate.NoMatch Then
MsgBox "无效的网段号", 48, "安全器设置"
Cancel = True
End If
Case 3 '检查网络地址有效性
Dim curAdd As Integer
If Not IsNumeric(grdBuild.Columns(3).Value) Then
MsgBox "安全器地址必须为整数", 48, "安全器设置"
Cancel = True
Exit Sub
End If
curAdd = grdBuild.Columns(3).Value
If (curAdd < LBuild Or curAdd > UBuild) And curAdd <> 0 Then
MsgBox "无效的安全器地址", 48, "安全器设置"
Cancel = True
GoTo End_Select
End If
If DupBuild(curAdd) And curAdd <> 0 Then
MsgBox "该安全器地址已经被占用" + Chr(10) + "请重新选择地址", 48, "安全器设置"
Cancel = True
End If
Case 6 '终端器地址有效性检验
If Not IsNumeric(grdBuild.Columns(6).Value) Then
MsgBox "终端器地址必须为整数", 48, "安全器设置"
Cancel = True
Exit Sub
End If
End Select
Exit Sub
ProcError:
ProcErr
End_Select:
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -