📄 frmuserdev1.frm
字号:
VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form frmUserDev1
BorderStyle = 1 'Fixed Single
Caption = "用户设备设置"
ClientHeight = 4125
ClientLeft = 45
ClientTop = 330
ClientWidth = 7470
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4125
ScaleWidth = 7470
Begin VB.Data datUserDev
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 2880
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "temUserDev"
Top = 2880
Width = 4575
End
Begin VB.Data datNetDev
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 0
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "DevsMap"
Top = 2880
Width = 2895
End
Begin VB.CommandButton cmdSetDef
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 = 1695
TabIndex = 4
Top = 3675
Width = 1335
End
Begin VB.CommandButton cmdSaveDef
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 = 3135
TabIndex = 3
Top = 3675
Width = 1335
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 = 6015
TabIndex = 2
Top = 3675
Width = 1335
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 = 4575
TabIndex = 1
Top = 3675
Width = 1335
End
Begin MSDBGrid.DBGrid DBGrid1
Bindings = "frmUserDev1.frx":0000
Height = 2775
Left = 0
OleObjectBlob = "frmUserDev1.frx":0018
TabIndex = 0
Top = 0
Width = 2895
End
Begin MSDBGrid.DBGrid grdDevs
Bindings = "frmUserDev1.frx":0BB7
Height = 2775
Left = 2880
OleObjectBlob = "frmUserDev1.frx":0BD0
TabIndex = 5
Top = 0
Width = 4575
End
Begin VB.Label Label1
BorderStyle = 1 'Fixed Single
Caption = "注意:""设备序号""应为从1至n的连续整数"
Height = 345
Left = 45
TabIndex = 6
Top = 3240
Width = 7365
End
End
Attribute VB_Name = "frmUserDev1"
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
datUserDev.Refresh
errMsg = ""
chkValid = True
If Not datUserDev.Recordset.EOF And datUserDev.Recordset.RecordCount > 0 Then
datUserDev.Recordset.MoveLast
For i = 1 To datUserDev.Recordset.RecordCount
datUserDev.Recordset.FindFirst "DevID=" + Format(i)
If datUserDev.Recordset.NoMatch Then
errMsg = errMsg + "'设备序号'必须为从1至n的连续整数" + Chr(10)
chkValid = False
Exit For
End If
Next i
End If
datUserDev.Recordset.FindFirst "isnull(devID)"
If Not datUserDev.Recordset.NoMatch Then
errMsg = errMsg + "存在还未设置的空设备序号" + Chr(10)
chkValid = False
End If
datUserDev.Recordset.FindFirst "isnull(devType)"
If Not datUserDev.Recordset.NoMatch Then
errMsg = errMsg + "存在还未设置的空设备类型号" + Chr(10)
chkValid = False
End If
End Function
Private Sub cmdCancel_Click()
Unload frmUserDev1
End Sub
Private Sub cmdOK_Click()
Dim i As Integer
Dim rcUserDev As Recordset
Dim rcTemUserDev As Recordset
Dim rcUserMap As Recordset
'检查有效性
If (Not chkValid) And errMsg <> "" Then
MsgBox errMsg, 48, "用户设备设置错误"
Exit Sub
End If
Set rcUserMap = dbCbb.OpenRecordset("UserMap", dbOpenDynaset)
For i = 0 To UBound(selIDs)
SQL = "delete * from userDev "
SQL = SQL + "where userdev.userID=" + Trim(selIDs(i))
dbCbb.Execute (SQL)
Set rcUserDev = dbCbb.OpenRecordset("userDev", dbOpenDynaset)
Set rcTemUserDev = dbCbb.OpenRecordset("temuserdev", dbOpenSnapshot)
If Not rcTemUserDev.EOF Then
rcTemUserDev.MoveFirst
Do While Not rcTemUserDev.EOF
rcUserDev.AddNew
rcUserDev!UserID = Val(selIDs(i))
rcUserDev!devID = rcTemUserDev!devID
rcUserDev!DevType = rcTemUserDev!DevType
rcUserDev!CardTermID = rcTemUserDev!CardTermID
rcUserDev!CardUserID = rcTemUserDev!CardUserID
rcUserDev!CurVal = rcTemUserDev!CurVal
rcUserDev!Sumfee = rcTemUserDev!Sumfee
rcUserDev!CtrlStatus = rcTemUserDev!CtrlStatus
rcUserDev!ValDate = rcTemUserDev!ValDate
rcUserDev.Update
rcTemUserDev.MoveNext
Loop
End If
rcUserMap.FindFirst "UserID=" + Trim(selIDs(i))
If Not rcUserMap.NoMatch Then
rcUserMap.Edit
rcUserMap!Devs = rcTemUserDev.RecordCount
rcUserMap.Update
End If
Next i
'status
AppendStatusInfo "修改用户设备设置", icoBLUE
SaveLog "修改用户设备设置", 0
Unload frmUserDev1
End Sub
Private Sub cmdSaveDef_Click()
TemplateType = 1
frmTemplate.Show
End Sub
Private Sub cmdSetDef_Click()
TemplateType = 2
frmTemplate.Show
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
datNetDev.DatabaseName = App.Path & "\data\cbb.mdb"
datUserDev.DatabaseName = App.Path & "\data\cbb.mdb"
SQL = "delete * from temUserDev"
'使用本方法来运行某个SQL语法，用于更新，删除或指定Database对象中的记录。
dbCbb.Execute SQL
If UBound(selIDs) = 0 Then
SQL = "insert into temUserdev "
SQL = SQL + "select * "
SQL = SQL + "from userdev "
SQL = SQL + "where userdev.userID=" + Trim(selIDs(0)) + " "
SQL = SQL + "order by devID "
dbCbb.Execute SQL
End If
end_userdev_load:
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 grdDevs_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
Select Case ColIndex
Case 0
If Not IsNumeric(grdDevs.Columns(0).Value) Then
MsgBox "设备序号必须为整数", 48, "用户设备设置"
Cancel = True
Exit Sub
End If
Case 1
If Not IsNumeric(grdDevs.Columns(1).Value) Then
MsgBox "设备类型号必须为的整数" + Chr(10) + "请从左边网络设备列表中选择", 48, "拥护设备设置"
Cancel = True
Exit Sub
End If
Case 1
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -