📄 lfrom.frm
字号:
VERSION 5.00
Object = "{74848F95-A02A-4286-AF0C-A3C755E4A5B3}#1.0#0"; "actskn43.ocx"
Object = "{4F29B06F-16D9-4A0C-9C8A-2F0C02F625FE}#1.7#0"; "FlexCell.ocx"
Begin VB.Form Lfrom
BorderStyle = 1 'Fixed Single
Caption = "操作员管理"
ClientHeight = 5790
ClientLeft = 45
ClientTop = 435
ClientWidth = 9720
Icon = "Lfrom.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5790
ScaleWidth = 9720
StartUpPosition = 2 '屏幕中心
Begin ACTIVESKINLibCtl.Skin PKSkn
Left = 9120
OleObjectBlob = "Lfrom.frx":000C
Top = 4920
End
Begin VB.CheckBox XPCheckBox1
Caption = "全选"
ForeColor = &H00FF0000&
Height = 375
Left = 8760
TabIndex = 7
Top = 4440
Width = 735
End
Begin VB.CommandButton XPButton6
Caption = "刷 新"
Height = 375
Left = 7440
TabIndex = 6
Top = 5160
Width = 1095
End
Begin VB.CommandButton XPButton5
Caption = "删 除"
Height = 375
Left = 5880
TabIndex = 5
Top = 5160
Width = 1095
End
Begin VB.CommandButton XPButton3
Caption = "新 增"
Height = 375
Left = 5880
TabIndex = 4
Top = 4560
Width = 1095
End
Begin VB.CommandButton XPButton1
Caption = "修 改"
Height = 375
Left = 7440
TabIndex = 3
Top = 4560
Width = 1095
End
Begin FlexCell.Grid Grid2
Height = 3975
Left = 5520
TabIndex = 1
Top = 360
Width = 3975
_ExtentX = 7011
_ExtentY = 7011
Cols = 3
DisplayRowIndex = -1 'True
ExtendLastCol = -1 'True
Rows = 1
End
Begin FlexCell.Grid Grid1
Height = 5535
Left = 240
TabIndex = 0
Top = 120
Width = 5055
_ExtentX = 8916
_ExtentY = 9763
DisplayRowIndex = -1 'True
ExtendLastCol = -1 'True
Rows = 1
End
Begin VB.Label Label1
Caption = "管理权限明细分配表:"
ForeColor = &H000000FF&
Height = 255
Left = 5520
TabIndex = 2
Top = 120
Width = 1935
End
End
Attribute VB_Name = "Lfrom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我,我为人人
'枕善居收藏整理
'发布日期:2008/05/10
'描 述:商品综合管理系统 Sql2000版
'网 站: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 Grid_ADD As Boolean
Dim hang As Integer
Private Declare Function GetKeyState Lib "user32" _
(ByVal nVirtKey As Long) As Integer
Private Sub Form_Load()
PKSkn.LoadSkin App.Path & sknPname
PKSkn.ApplySkinByName hWnd, "窗体"
PKSkn.ApplySkin hWnd
With Grid1
.OpenFile ("uadmin1.cel")
End With
GridIni
With Grid2
Set Qy1 = cnn.Execute("select * from userM")
.OpenFile ("uadmin2.cel")
End With
End Sub
Private Sub GridIni() '显示表格1
On Error GoTo ErrHandlor
Grid1.AutoRedraw = False '关闭刷新功能,实现快速读取数据
Grid1.Rows = 1
Sql = "select * from userM"
Set Qy1 = cnn.Execute(Sql)
For i = 1 To Grid1.Cols - 1
Grid1.Cell(0, i).Text = Qy1.Fields(i - 1).Name
Next
With Grid1
.Cell(0, 1).Text = "用户名"
.Cell(0, 2).Text = "姓名"
.Cell(0, 3).Text = "密码"
End With
Do While Not Qy1.EOF
Grid1.Rows = Grid1.Rows + 1
For i = 1 To Grid1.Cols - 1
Grid1.Cell(Grid1.Rows - 1, i).Text = Qy1.Fields(i - 1)
Next
Qy1.MoveNext
Loop
Grid1.AutoRedraw = True
Grid1.Refresh
Grid1.Column(1).Locked = True
Exit Sub
ErrHandlor:
MsgBox "错误" & Err.Description, vbOKOnly, "提示"
Grid1.AutoRedraw = True
Grid1.Refresh
End Sub
Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
If Grid_ADD = False Then
Set Qy1 = cnn.Execute("select * from userM where un='" & Grid1.Cell(Row, 1).Text & "'")
If Qy1.EOF = False Then
For i = 1 To Grid2.Rows - 1
Grid2.Cell(i, 2).Text = Qy1.Fields(i + 2)
Next
End If
End If
hang = Row
End Sub
Private Sub XPButton1_Click()
If Grid1.Column(1).Locked = True And hang > 0 Then '当表格1第一列锁定时
Set Qy1 = cnn.Execute("delete * from userM where un='" & Grid1.Cell(hang, 1).Text & "'")
'先删除后插入新数据
Sql = "insert into userM values('" & Grid1.Cell(hang, 1).Text & "','" & Grid1.Cell(hang, 2).Text & "','" & Grid1.Cell(hang, 3).Text & "','"
For j = 1 To Grid2.Rows - 2
Sql = Sql & Grid2.Cell(j, 2).LongValue & "','"
Next
Sql = Sql & Grid2.Cell(Grid2.Rows - 1, 2).LongValue & "')"
Set Qy1 = cnn.Execute(Sql)
MsgBox "修改成功", vbInformation, "操作成功"
End If
End Sub
Private Sub XPButton3_Click()
If Grid_ADD = False Then
'执行增加的前期工作
Grid1.Rows = 1
Grid1.Rows = Grid1.Rows + 1
XPButton3.Caption = "保 存"
Grid1.Cell(Grid1.Rows - 1, 1).SetFocus
Grid_ADD = True
XPButton3.Default = True
Grid1.Column(1).Locked = False
Else
'执行保存操作
On Error GoTo finish:
For i = 1 To Grid1.Rows - 1
If Grid1.Cell(i, 1).Text <> "" And Grid1.Cell(i, 2).Text <> "" Then
Sql = "select * from userM where un='" & Grid1.Cell(i, 1).Text & "'"
Set Qy1 = cnn.Execute(Sql)
If Qy1.EOF = True Then
Sql = "insert into userM values('" & Grid1.Cell(i, 1).Text & "','" & Grid1.Cell(i, 2).Text & "','" & Grid1.Cell(i, 3).Text & "','"
For j = 1 To Grid2.Rows - 2
Sql = Sql & Grid2.Cell(j, 2).LongValue & "','"
Next
Sql = Sql & Grid2.Cell(Grid2.Rows - 1, 2).LongValue & "')"
Set Qy1 = cnn.Execute(Sql)
End If
End If
Next
MsgBox "新数据已成功添加!", vbInformation, "操作成功"
XPButton3.Caption = "新 增"
Grid_ADD = False
GridIni
End If
Exit Sub
finish:
MsgBox "添加到第" & i & "行时出现错误!" & vbCrLf & "错误内容:" & Err.Description
End Sub
Private Sub Grid1_Validate(Cancel As Boolean)
Dim nActiveRow As Long, nActiveCol As Long
Const VK_TAB = 9
If GetKeyState(VK_TAB) < 0 Then
nActiveRow = Grid1.ActiveCell.Row
nActiveCol = Grid1.ActiveCell.Col
If nActiveCol < Grid1.Cols - 1 Then
Grid1.Range(nActiveRow, nActiveCol + 1, _
nActiveRow, nActiveCol + 1).Selected
End If
Cancel = True
End If
End Sub
Private Sub XPButton5_Click()
If Grid1.Column(1).Locked = True And hang > 0 Then '当表格1第一列锁定时
If Grid1.Cell(hang, 1).Text = LoginAdmin Then
MsgBox "当前用户在线,不可删除!", vbInformation, "提示"
Exit Sub
End If
Set Qy1 = cnn.Execute("delete from userm where un='" & Grid1.Cell(hang, 1).Text & "'")
GridIni
MsgBox "删除成功!", vbInformation, "操作成功"
End If
End Sub
Private Sub XPButton6_Click()
GridIni
End Sub
Private Sub XPCheckBox1_Click()
If XPCheckBox1.Value = xcksChecked Then
For i = 1 To Grid2.Rows - 1
Grid2.Cell(i, 2).Text = "1"
Next
Else
For i = 1 To Grid2.Rows - 1
Grid2.Cell(i, 2).Text = "0"
Next
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -