📄 frmimforclass.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmInforClass
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "班信息设置"
ClientHeight = 2460
ClientLeft = 1260
ClientTop = 2790
ClientWidth = 8130
Icon = "frmImforClass.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2460
ScaleWidth = 8130
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdClose
Caption = "关闭"
Height = 372
Left = 7080
TabIndex = 10
Top = 2040
Width = 975
End
Begin VB.CommandButton cmdAdd
Caption = "增加"
Height = 372
Left = 7080
TabIndex = 9
Top = 120
Width = 975
End
Begin VB.CommandButton cmdDelete
Caption = "删除"
Height = 372
Left = 7080
TabIndex = 8
Top = 1080
Width = 975
End
Begin VB.CommandButton cmdEdit
Cancel = -1 'True
Caption = "修改"
Height = 372
Left = 7080
TabIndex = 7
Top = 600
Width = 975
End
Begin VB.TextBox txtClass
Height = 375
Index = 1
Left = 5640
TabIndex = 6
Top = 960
Width = 1335
End
Begin VB.TextBox txtClass
Height = 375
Index = 2
Left = 5640
TabIndex = 5
Top = 1320
Width = 1335
End
Begin VB.TextBox txtClass
Height = 375
Index = 3
Left = 5640
TabIndex = 4
Top = 1680
Width = 1335
End
Begin VB.TextBox txtClass
Height = 375
IMEMode = 3 'DISABLE
Index = 4
Left = 5625
PasswordChar = "*"
TabIndex = 3
Top = 2040
Width = 1335
End
Begin VB.TextBox txtClass
Enabled = 0 'False
Height = 375
Index = 0
Left = 5640
TabIndex = 2
Top = 600
Width = 1335
End
Begin VB.TextBox ComboClass
Height = 375
Left = 5640
Locked = -1 'True
TabIndex = 1
Top = 120
Width = 1335
End
Begin MSComctlLib.ListView ListV
Height = 2415
Left = 0
TabIndex = 0
Top = 0
Width = 4695
_ExtentX = 8281
_ExtentY = 4260
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
AllowReorder = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
HotTracking = -1 'True
_Version = 393217
ForeColor = 32768
BackColor = 16777215
BorderStyle = 1
Appearance = 1
NumItems = 1
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Object.Width = 2540
EndProperty
End
Begin VB.Label Labxlh
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "值班工号:"
ForeColor = &H00000000&
Height = 180
Index = 0
Left = 4800
TabIndex = 16
Top = 240
Width = 810
End
Begin VB.Label Labxlh
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "主操A:"
ForeColor = &H00000000&
Height = 180
Index = 1
Left = 5070
TabIndex = 15
Top = 1440
Width = 540
End
Begin VB.Label Labxlh
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "操作权限:"
ForeColor = &H00000000&
Height = 180
Index = 5
Left = 4800
TabIndex = 14
Top = 2160
Width = 810
End
Begin VB.Label Labxlh
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "班长:"
ForeColor = &H00000000&
Height = 180
Index = 10
Left = 5160
TabIndex = 13
Top = 1080
Width = 450
End
Begin VB.Label Labxlh
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "主操B:"
ForeColor = &H00000000&
Height = 180
Index = 2
Left = 5070
TabIndex = 12
Top = 1800
Width = 540
End
Begin VB.Label Labxlh
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "ID:"
ForeColor = &H00000000&
Height = 180
Index = 3
Left = 5340
TabIndex = 11
Top = 720
Width = 270
End
End
Attribute VB_Name = "frmInforClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As New ADODB.Recordset
Dim IDNum As Long
Private Sub cmdAdd_Click()
On Error Resume Next
' Dim i%, ID%
' Dim strSend As String
' If rs.State = 1 Then
' rs.Close
' End If
' Cmd.CommandText = "Select*from UserInfo"
' rs.OPEN Cmd, , adOpenDynamic, adLockOptimistic
' rs.MoveFirst
' While Not rs.EOF
' If rs("ID") = txtClass(i) Or Trim(txtClass(i)) = "" Then
' Unload frmMessage
' frmMessage.lblMsg = "信息已经存在或为空！"
' frmMessage.Show 1
' rs.Close
' Set rs = Nothing
' Exit Sub
' End If
' rs.MoveNext
' Wend
' rs.MoveLast
' rs.AddNew
' rs("ID") = Val(txtClass(0))
' For i = 0 To 4
' If i = 0 Then
' rs(i + 1) = Trim(ComboClass.Text)
' strSend = strSend & "*" & ComboClass.Text
' Else
' rs(i + 1) = Trim(txtClass(i))
' strSend = strSend & "*" & txtClass(i).Text
' End If
' Next
' rs("Popedom") = 0
' rs.UpDate
' rs.Close
' Set rs = Nothing
' ComboClass.Locked = False
' cmdEdit.Enabled = False
' cmdDelete.Enabled = False
' strSend = "*" & "ADD" & strSend
' SynchroMsg strSend
' DataRefresh True
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
'
Private Sub cmdDelete_Click()
Dim i%
Dim strSend As String
On Error Resume Next
If Val(txtClass(0)) > 0 Then
Cmd.CommandText = "Select * from userinfo Where ID='" & Val(txtClass(0)) & "'"
rs.OPEN Cmd, , adOpenDynamic, adLockOptimistic
For i = 1 To 5
rs(i) = ""
strSend = strSend & "*" & ""
Next
rs.UpDate
rs.Close
Set rs = Nothing
strSend = "*" & "EDT" & "*" & Val(txtClass(0)) & strSend
SynchroMsg strSend
ComboClass.Locked = False
cmdEdit.Enabled = True
cmdDelete.Enabled = False
DataRefresh True
End If
End Sub
Private Sub cmdEdit_Click()
Dim i%
Dim strSend As String
On Error Resume Next
If rs.State = 1 Then
rs.Close
End If
If Val(txtClass(0)) > 0 Then
Cmd.CommandText = "Select * from UserInfo where ID=" & Val(txtClass(0))
rs.OPEN Cmd, , adOpenDynamic, adLockOptimistic
strSend = "*" & Trim(ComboClass.Text)
rs("Name") = Trim(ComboClass.Text)
For i = 1 To 4
rs(i + 1) = txtClass(i).Text
strSend = strSend & "*" & Trim(txtClass(i).Text)
Next
rs.UpDate
rs.Close
Set rs = Nothing
ComboClass.Locked = True
cmdEdit.Enabled = True
cmdDelete.Enabled = True
strSend = "*" & "EDT" & "*" & Val(txtClass(0)) & strSend
SynchroMsg strSend
If UserID = Val(txtClass(0)) Then
frmMain.lblClassData(0).Caption = ComboClass.Text
frmMain.lblClassData(1).Caption = txtClass(1).Text
frmMain.lblClassData(2).Caption = txtClass(2).Text
frmMain.lblClassData(3).Caption = txtClass(3).Text
End If
DataRefresh True
End If
End Sub
Private Sub Form_Load()
On Error GoTo ErrHandle
cmdAdd.Enabled = False
cmdEdit.Enabled = False
cmdDelete.Enabled = False
ListV.ColumnHeaders.Clear
ListV.ColumnHeaders.Add , , "ID", 400
ListV.ColumnHeaders.Add , , "班号", 700
ListV.ColumnHeaders.Add , , "班长", 1170
ListV.ColumnHeaders.Add , , "主操A", 1170
ListV.ColumnHeaders.Add , , "主操B", 1170
ListV.ColumnHeaders.Add , , "权限", 10
DataRefresh False
Exit Sub
ErrHandle:
frmMain.Statur.Caption = Format(Time, "hh:mm:ss") & " frmInforClass.Load.Err-" & Err.Description & " " & Err.Number & " " & Err.Source
AddAlarm Statur.Caption
Err.Clear
End Sub
Private Sub Form_Resize()
Dim hwndSigfrm As Long
hwndSigfrm = SetParent(Me.hWnd, frmMain.hWnd)
End Sub
Private Sub ListV_ItemClick(ByVal Item As MSComctlLib.ListItem)
txtClass(0).Text = Item.Text
IDNum = Val(Item.Text)
ComboClass.Text = Item.SubItems(1)
txtClass(1).Text = Item.SubItems(2)
txtClass(2).Text = Item.SubItems(3)
txtClass(3).Text = Item.SubItems(4)
txtClass(4).Text = Item.SubItems(5)
cmdEdit.Enabled = True
ComboClass.Locked = False
cmdDelete.Enabled = True
End Sub
Private Function DataRefresh(UpIndex As Boolean) As Long
Dim i%, j%
Dim xItem As ListItem
On Error GoTo ErrHandle
If rs.State = 1 Then
rs.Close
End If
Cmd.CommandText = "select * from UserInfo order by ID"
rs.OPEN Cmd, , adOpenDynamic, adLockOptimistic
ListV.ListItems.Clear
i = 1
While Not rs.EOF
Set xItem = ListV.ListItems.Add(, , rs("ID"))
For j = 1 To 5
If IsNull(rs(j)) Then
xItem.SubItems(j) = ""
Else
xItem.SubItems(j) = rs(j)
End If
Next
If UpIndex Then
ReDim Preserve Users(i)
With Users(i)
If IsNull(rs("ID")) Then
.ID = i
Else
.ID = rs("ID")
End If
If Not IsNull(rs("Name")) Then
.Name = rs("Name")
End If
If Not IsNull(rs("Monitor")) Then
.Monitor = Trim(rs("Monitor"))
End If
If Not IsNull(rs("priOperator")) Then
.priOperator = Trim(rs("priOperator"))
End If
If Not IsNull(rs("subOperator")) Then
.subOperator = Trim(rs("subOperator"))
End If
If Not IsNull(rs("password")) Then
.password = Trim(rs("password"))
End If
If Not IsNull(rs("Popedom")) Then
.Popedom = rs("Popedom")
End If
End With
i = i + 1
End If
rs.MoveNext
Wend
If ListV.ListItems.Count < 4 Then
' cmdAdd.Enabled = True
Else
cmdAdd.Enabled = False
End If
Cmd.CommandText = ""
rs.Close
Set rs = Nothing
For i = 0 To 4
txtClass(i) = ""
Next
DataRefresh = 1
Exit Function
ErrHandle:
Unload frmMessage
frmMessage.lblMsg = Err.Description
frmMessage.Show 1
DataRefresh = 0
Err.Clear
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -