📄 frmzmanage.frm
字号:
VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form frmZManage
BorderStyle = 1 'Fixed Single
Caption = "组管理"
ClientHeight = 5595
ClientLeft = 45
ClientTop = 330
ClientWidth = 7260
Icon = "frmZManage.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5595
ScaleWidth = 7260
Begin VB.Frame Frame1
Caption = "权限"
Height = 1935
Left = 0
TabIndex = 1
Top = 3600
Width = 7215
Begin VB.TextBox txtName
Height = 375
Left = 960
TabIndex = 3
Top = 240
Width = 2415
End
Begin MSFlexGridLib.MSFlexGrid Grid2
Height = 855
Left = 240
TabIndex = 2
Top = 960
Width = 6855
_ExtentX = 12091
_ExtentY = 1508
_Version = 393216
FixedCols = 0
End
Begin MSForms.CommandButton cmdReturn
Height = 375
Left = 5880
TabIndex = 7
Top = 240
Width = 1095
Caption = "返回"
PicturePosition = 327683
Size = "1931;661"
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton cmdDel
Height = 375
Left = 4680
TabIndex = 6
Top = 240
Width = 1095
Caption = "删除组"
PicturePosition = 327683
Size = "1931;661"
Picture = "frmZManage.frx":0442
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin MSForms.CommandButton cmdAdd
Height = 375
Left = 3480
TabIndex = 5
Top = 240
Width = 1095
Caption = "添加组"
PicturePosition = 327683
Size = "1931;661"
Picture = "frmZManage.frx":257C
FontName = "宋体"
FontHeight = 180
FontCharSet = 134
FontPitchAndFamily= 34
ParagraphAlign = 3
End
Begin VB.Label Label1
Caption = "组名："
Height = 375
Left = 240
TabIndex = 4
Top = 360
Width = 615
End
End
Begin MSFlexGridLib.MSFlexGrid Grid1
Height = 3495
Left = 0
TabIndex = 0
Top = 0
Width = 7215
_ExtentX = 12726
_ExtentY = 6165
_Version = 393216
SelectionMode = 1
AllowUserResizing= 1
End
End
Attribute VB_Name = "frmZManage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Type UserZu
ZuName As String
Cjz As String
End Type
Private Sub cmdAdd_Click()
Dim strSql As String
Dim strMsg As String
Dim rs As New ADODB.Recordset
Dim zname As String
zname = Trim(txtName)
If zname = "" Then
txtName = ""
MsgBox "组名不能为空"
TextFocus txtName
Exit Sub
End If
strSql = "select * from t_zqx where 组名='" & zname & "'"
Set rs = ExecuteSQL(strSql, strMsg)
If Not rs.EOF Then
rs.Close
Set rs = Nothing
txtName = ""
MsgBox "对不起已有相同的组名，请输入其它组名。"
TextFocus txtName
Exit Sub
End If
rs.Close
strSql = "select * from t_zqx"
Set rs = ExecuteSQL(strSql, strMsg)
rs.AddNew
rs.Fields("组名") = zname
rs.Fields("创建时间") = Now
For i = 1 To Grid2.Cols - 1
If Grid2.TextMatrix(1, i) = "是" Then
rs.Fields(Grid2.TextMatrix(0, i)) = True
Else
rs.Fields(Grid2.TextMatrix(0, i)) = False
End If
Next
rs.Fields("创建者") = m_UZ
rs.Update
rs.Close
Set rs = Nothing
Call Form_Load
MsgBox "一个组已被创建"
End Sub
Private Sub cmdDel_Click()
'没有数据退出
If Grid1.Rows <= 1 Then Exit Sub
'如果选中
If Grid1.Row > 0 Then
If MsgBox("你要删除吗？", vbQuestion + vbYesNo) = vbYes Then
Dim strSql As String
Dim strMsg As String
Dim rs As ADODB.Recordset
strSql = "delete * from t_zqx where 组名='" & Grid1.TextMatrix(Grid1.Row, 1) & "'"
Set rs = ExecuteSQL(strSql, strMsg)
Call Form_Load
End If
End If
End Sub
Private Sub cmdReturn_Click()
Unload Me
End Sub
Private Sub Form_Load()
Me.Left = ReadIni("组管理", "left")
Me.Top = ReadIni("组管理", "top")
Dim myzu() As UserZu
Dim strSql As String
Dim strMsg As String
Dim rs As New ADODB.Recordset
strSql = "select * from t_zqx where 组名='" & m_UZ & "'"
Set rs = ExecuteSQL(strSql, strMsg)
Grid2.Rows = 2
Grid2.Cols = 1
Grid2.TextMatrix(1, 0) = "全选"
n = 1
For i = 2 To rs.Fields.Count - 1
If rs.Fields(i).Value = True Then
Grid2.Cols = Grid2.Cols + 1
Grid2.TextMatrix(0, n) = rs.Fields(i).Name
Grid2.TextMatrix(1, n) = ""
n = n + 1
End If
Next
rs.Close
strSql = "select * from t_zqx"
Set rs = ExecuteSQL(strSql, strMsg)
ReDim myzu(rs.RecordCount)
For i = 1 To rs.RecordCount
myzu(i).ZuName = rs.Fields("组名")
myzu(i).Cjz = rs.Fields("创建者")
rs.MoveNext
Next
Grid1.ColWidth(0) = 250
Grid1.Rows = 1
Grid1.Cols = rs.Fields.Count + 1
For i = 1 To Grid1.Cols - 1
Grid1.TextMatrix(0, i) = rs.Fields(i - 1).Name
Next
rs.Close
Set rs = Nothing
Call getNextZu(myzu, m_UZ)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call WriteIni("组管理", "left", Me.Left)
Call WriteIni("组管理", "top", Me.Top)
End Sub
Private Sub Grid1_Click()
End Sub
Private Sub Grid2_Click()
If Grid2.Col = 0 Then
If Grid2.TextMatrix(1, 0) = "全选" Then
For i = 1 To Grid2.Cols - 1
Grid2.TextMatrix(1, i) = "是"
Next
Grid2.TextMatrix(1, 0) = "取消"
Else
For i = 1 To Grid2.Cols - 1
Grid2.TextMatrix(1, i) = ""
Next
Grid2.TextMatrix(1, 0) = "全选"
End If
Else
If Grid2.TextMatrix(1, Grid2.Col) = "是" Then
Grid2.TextMatrix(1, Grid2.Col) = ""
Else
Grid2.TextMatrix(1, Grid2.Col) = "是"
End If
End If
End Sub
Private Function getNextZu(myzu() As UserZu, zname As String)
i = 1
Do While i <= UBound(myzu)
If myzu(i).Cjz = zname Then
Grid1.Rows = Grid1.Rows + 1
Dim strSql As String
Dim strMsg As String
Dim rs As New ADODB.Recordset
strSql = "select * from t_zqx where 组名='" & myzu(i).ZuName & "'"
Set rs = ExecuteSQL(strSql, strMsg)
For n = 0 To rs.Fields.Count - 1
Grid1.TextMatrix(Grid1.Rows - 1, n + 1) = rs.Fields(n).Value
Next
rs.Close
Set rs = Nothing
'Grid1.TextMatrix(Grid1.Rows - 1, 1) = myzu(i).ZuName
Call getNextZu(myzu, myzu(i).ZuName)
End If
i = i + 1
Loop
If i > UBound(myzu) Then
Exit Function
End If
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -