📄 frmgateset.frm
字号:
VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form frmGateSet
BorderStyle = 1 'Fixed Single
Caption = "网关设置"
ClientHeight = 2670
ClientLeft = 45
ClientTop = 330
ClientWidth = 5520
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 2670
ScaleWidth = 5520
Begin VB.Data datGate
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 135
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "GateMap"
Top = 1800
Width = 3735
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 = 4080
TabIndex = 1
Top = 720
Width = 1215
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 = 375
Left = 4080
TabIndex = 0
Top = 240
Width = 1215
End
Begin MSDBGrid.DBGrid grdGate
Bindings = "frmGateSet.frx":0000
Height = 1695
Left = 120
OleObjectBlob = "frmGateSet.frx":0016
TabIndex = 2
Top = 120
Width = 3735
End
Begin VB.Label lblStatus
BorderStyle = 1 'Fixed Single
Caption = "正常"
Height = 255
Left = 960
TabIndex = 8
Top = 2280
Width = 615
End
Begin VB.Label Label3
Caption = "当前状态:"
Height = 255
Left = 120
TabIndex = 7
Top = 2280
Width = 855
End
Begin VB.Label Label1
Caption = "地址范围:"
Height = 255
Left = 3600
TabIndex = 6
Top = 2280
Width = 855
End
Begin VB.Label lblAddr
BorderStyle = 1 'Fixed Single
Height = 255
Left = 4440
TabIndex = 5
Top = 2280
Width = 975
End
Begin VB.Label Label2
Caption = "包含公寓数:"
Height = 255
Left = 1620
TabIndex = 4
Top = 2280
Width = 1035
End
Begin VB.Label lblBuildSum
BorderStyle = 1 'Fixed Single
Height = 255
Left = 2640
TabIndex = 3
Top = 2280
Width = 855
End
End
Attribute VB_Name = "frmGateSet"
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 errMsg As String
Function chkValid() As Boolean
errMsg = ""
chkValid = True
datGate.Recordset.FindFirst "isnull(FrameID)"
If Not datGate.Recordset.NoMatch Then
chkValid = False
errMsg = errMsg + "存在还未设置的空网段号" + Chr(10)
End If
datGate.Recordset.FindFirst "isnull(StartGate)"
Do While Not datGate.Recordset.NoMatch
datGate.Recordset.Edit
datGate.Recordset!StartGate = 0
datGate.Recordset.Update
datGate.Recordset.FindNext "isnull(StartGate)"
Loop
datGate.Recordset.FindFirst "isnull(EndGate)"
Do While Not datGate.Recordset.NoMatch
datGate.Recordset.Edit
datGate.Recordset!endGate = 0
datGate.Recordset.Update
datGate.Recordset.FindNext "isnull(EndGate)"
Loop
End Function
Function DupEndGate(curChkAdd) As Boolean
Dim rcChkGate As Recordset
Set rcChkGate = dbCbb.OpenRecordset("GateMap", dbOpenSnapshot)
rcChkGate.FindFirst "EndGate=" + Format(curChkAdd)
If Not rcChkGate.NoMatch Then
DupGate = True
End If
If IsNumeric(grdGate.Columns(1).Value) And IsNumeric(grdGate.Columns(2).Value) Then
If grdGate.Columns(1).Value = grdGate.Columns(2).Value Then
DupGate = True
End If
End If
End Function
Function DupStartGate(curChkAdd) As Boolean
Dim rcChkGate As Recordset
Set rcChkGate = dbCbb.OpenRecordset("GateMap", dbOpenSnapshot)
rcChkGate.FindFirst "StartGate=" + Format(curChkAdd)
If Not rcChkGate.NoMatch Then
DupGate = True
End If
If IsNumeric(grdGate.Columns(1).Value) And IsNumeric(grdGate.Columns(2).Value) Then
If grdGate.Columns(1).Value = grdGate.Columns(2).Value Then
DupGate = True
End If
End If
End Function
Private Sub cmdCancel_Click()
dbCbb.Rollback
Unload frmGateSet
End Sub
Private Sub cmdOK_Click()
errMsg = ""
If (Not chkValid) And errMsg <> "" Then
MsgBox errMsg, 48, "网关设置错误"
Exit Sub
End If
datGate.Recordset.FindFirst "isnull(FrameID) or isnull(StartGate) or isnull(EndGate)"
Do While Not datGate.Recordset.NoMatch
datGate.Recordset.Delete
If datGate.Recordset.EOF Or datGate.Recordset.AbsolutePosition = -1 Then
If datGate.Recordset.RecordCount > 0 Then
datGate.Recordset.MoveFirst
Else
Exit Do
End If
End If
datGate.Recordset.FindNext "isnull(FrameID) or isnull(StartGate) or isnull(EndGate)"
Loop
dbCbb.CommitTrans
'status
AppendStatusInfo "修改网关设置", icoBLUE
SaveLog "修改网关设置", 0
Unload frmGateSet
End Sub
Private Sub datGate_Reposition()
If Not datGate.Recordset.EOF Then
If IsNull(datGate.Recordset!FrameID) Then
datGate.Caption = ""
Else
datGate.Caption = "网关:" + Trim(datGate.Recordset!FrameID)
End If
'注:这里不能用IIF()函数,当datGate.recordset!***为NULL时会出错
If IsNull(datGate.Recordset!Status) Then
lblStatus.Caption = ""
Else
lblStatus.Caption = getStatusStr(datGate.Recordset!Status)
End If
If IsNull(datGate.Recordset!BuildSum) Then
lblBuildSum.Caption = ""
Else
lblBuildSum.Caption = datGate.Recordset!BuildSum
End If
End If
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
datGate.DatabaseName = App.Path & "\data\cbb.mdb"
lblAddr = Format(LGate) + "---" + Format(UGate)
dbCbb.BeginTrans
'status
AppendStatusInfo "查看网关设置", icoBLUE
SaveLog "查看网关设置", 0
DoEvents
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 grdGate_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
Dim curAdd As Integer
Dim curFrame As Integer
Dim rcChkGate As Recordset
Select Case ColIndex
Case 0 '检查网段号
If Not IsNumeric(grdGate.Columns(0).Value) Then
MsgBox "网段号必须为整数", 48, "网段设置"
Cancel = True
Exit Sub
End If
curFrame = grdGate.Columns(0).Value
Set rcChkGate = dbCbb.OpenRecordset("GateMap", dbOpenSnapshot)
rcChkGate.FindFirst "FrameID=" + Format(curFrame)
If Not rcChkGate.NoMatch Then
MsgBox "该网段号已经被占用" + Chr(10) + "请重新选择网段号", 48, "网关设置"
Cancel = True
Else
Cancel = False
End If
Case 1 '检查网络地址有效性
If IsNumeric(grdGate.Columns(1).Value) Then
curAdd = grdGate.Columns(1).Value
Else
MsgBox "网关地址必须为整数", 48, "网段设置"
Cancel = True
Exit Sub
End If
If (curAdd < LGate Or curAdd > UGate) And curAdd <> 0 Then
MsgBox "无效的网关地址", 48, "网关设置"
Cancel = True
Exit Sub
End If
If DupStartGate(curAdd) Then
MsgBox "该网关地址已经被占用" + Chr(10) + "请重新选择地址", 48, "网关设置"
Cancel = True
End If
Case 2
If IsNumeric(grdGate.Columns(2).Value) Then
curAdd = grdGate.Columns(2).Value
Else
MsgBox "网关地址必须为整数", 48, "网段设置"
Cancel = True
Exit Sub
End If
If (curAdd < LGate Or curAdd > UGate) And curAdd <> 0 Then
MsgBox "无效的网关地址", 48, "网关设置"
Cancel = True
Exit Sub
End If
If DupEndGate(curAdd) Then
MsgBox "该网关地址已经被占用" + Chr(10) + "请重新选择地址", 48, "网关设置"
Cancel = True
Exit Sub
End If
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -