frmapplimit.frm
来自「OA编程 源代码」· FRM 代码 · 共 903 行 · 第 1/2 页
FRM
903 行
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form FrmApplimit
BorderStyle = 3 'Fixed Dialog
Caption = "小应用查询与修改权限设置..."
ClientHeight = 7395
ClientLeft = 45
ClientTop = 330
ClientWidth = 10620
Icon = "FrmApplimit.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7395
ScaleWidth = 10620
ShowInTaskbar = 0 'False
Begin ComctlLib.TreeView TVTable
Height = 4950
Left = 45
TabIndex = 8
Top = 2040
Width = 2235
_ExtentX = 3942
_ExtentY = 8731
_Version = 327682
Style = 7
BorderStyle = 1
Appearance = 0
End
Begin VB.TextBox TxtApp
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00C0FFFF&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 375
Left = 60
TabIndex = 6
Text = "Text1"
Top = 1575
Width = 2235
End
Begin VB.ComboBox CmbDepartD
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 1980
TabIndex = 3
Text = "CmbDepartD"
Top = 3015
Width = 2115
End
Begin VB.ComboBox CmbDepart
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 1980
TabIndex = 2
Text = "CmbDepart"
Top = 3435
Width = 2115
End
Begin MSFlexGridLib.MSFlexGrid MSFGLimit
Height = 5115
Left = 2610
TabIndex = 1
Top = 1755
Width = 7635
_ExtentX = 13467
_ExtentY = 9022
_Version = 393216
FixedCols = 0
BackColorFixed = -2147483637
ForeColorFixed = 0
GridColor = 16776960
BorderStyle = 0
Appearance = 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin TabDlg.SSTab SSTabLimit
Height = 5730
Left = 2430
TabIndex = 0
Top = 1275
Width = 8010
_ExtentX = 14129
_ExtentY = 10107
_Version = 393216
Style = 1
Tabs = 2
TabsPerRow = 2
TabHeight = 520
ForeColor = 16711680
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TabCaption(0) = "个人设置"
TabPicture(0) = "FrmApplimit.frx":08CA
Tab(0).ControlEnabled= -1 'True
Tab(0).ControlCount= 0
TabCaption(1) = "部门、组设置"
TabPicture(1) = "FrmApplimit.frx":08E6
Tab(1).ControlEnabled= 0 'False
Tab(1).ControlCount= 0
End
Begin VB.Label LabApp
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "当前应用："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 210
Left = 90
TabIndex = 7
Top = 1245
Width = 1050
End
Begin VB.Line Line1
X1 = 225
X2 = 10200
Y1 = 420
Y2 = 420
End
Begin VB.Label LabDetail
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label2"
Height = 180
Left = 480
TabIndex = 5
Top = 540
Width = 540
End
Begin VB.Label LabExplain
BackStyle = 0 'Transparent
Caption = "操作说明："
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 315
Left = 240
TabIndex = 4
Top = 60
Width = 2445
End
Begin VB.Menu MenuSetup
Caption = "设置"
Visible = 0 'False
Begin VB.Menu MenuSetupAdd
Caption = "添加权限"
End
Begin VB.Menu MenuSetupDelete
Caption = "删除权限"
End
End
End
Attribute VB_Name = "FrmApplimit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim appConn As ADODB.Connection
Dim appRs As ADODB.Recordset
'Const strConn = "DSN=bkbtinfo;UID=sa;PWD=;"
Dim strSQL As String
Dim Tabindex As Integer
Dim strTableName As String
Dim MaxCode As Integer
Dim blnWriteFlag As Boolean
Dim blncmbDepartdAdd As Boolean
Dim blnLimitChange As Boolean '权限更改标记
Dim mNode As Node
Dim strNodeKey As String
Dim strNodeText As String
Private Sub CmbDepart_Click()
If MSFGLimit.RowSel < 1 Then Exit Sub
If MSFGLimit.ColSel = 0 Then
If CmbDepart.Visible Then
MSFGLimit.TextMatrix(MSFGLimit.RowSel, MSFGLimit.ColSel) = CmbDepart.Text
If Not blncmbDepartdAdd Then
CmbDepartD.AddItem CmbDepart.Text
blncmbDepartdAdd = True
Else
CmbDepartD.RemoveItem (CmbDepartD.ListCount - 1)
CmbDepartD.AddItem CmbDepart.Text
blncmbDepartdAdd = True
End If
Else
CmbDepart.Visible = False
End If
End If
blnLimitChange = True
End Sub
Private Sub CmbDepartD_Click()
If MSFGLimit.RowSel < 1 Then Exit Sub
Select Case MSFGLimit.Col
Case 0
MSFGLimit.TextMatrix(MSFGLimit.RowSel, 0) = CmbDepartD.Text
CmbDepartD.Visible = False
Case 4
MSFGLimit.TextMatrix(MSFGLimit.RowSel, 4) = CmbDepartD.Text
CmbDepartD.Visible = False
End Select
blnLimitChange = True
End Sub
Private Sub Form_Activate()
FormatMSFlexGrid SSTabLimit.Tab, strTableName
End Sub
Private Sub Form_Load()
Dim strDetail As String
FrmApplimit.ScaleHeight = FrmApplimit.Height
FrmApplimit.ScaleWidth = FrmApplimit.Width
FrmApplimit.Top = (Screen.Height - FrmApplimit.Height - TitleHeight) / 2
FrmApplimit.Left = (Screen.Width - FrmApplimit.Width) / 2
Set appConn = New ADODB.Connection
appConn.ConnectionString = Pubsaconnstring
appConn.Open
strDetail = Chr(13)
strDetail = strDetail & " 其中：“特殊设置”选项页是针对特殊人物设置权限的，例如：部门经理、总经理等。" & Chr(13) & Chr(10)
strDetail = strDetail & "“一般设置”选项页对普通员工进行设置。" & Chr(13) & Chr(10)
strDetail = strDetail & ""
LabDetail.Caption = strDetail
CmbDepart.Visible = False
CmbDepartD.Visible = False
strSQL = "select distinct * from tableinfo"
Set appRs = appConn.Execute(strSQL)
If Not appRs.EOF Then
While Not appRs.EOF
strNodeKey = Trim(appRs(0))
strNodeText = Trim(appRs(0))
'Set mNode = TVTable.Nodes.Add(, tvwChild, Trim(appRs(0)), Trim(appRs(0)))
Set mNode = TVTable.Nodes.Add(, , strNodeKey, strNodeText)
appRs.MoveNext
Wend
strTableName = mNode.Root.Text
TxtApp.Text = strTableName
blnWriteFlag = False
FormatCmbDepartD
FormatCmbDepart
End If
End Sub
Private Sub FormatTreeview()
Dim mNode As Node
strSQL = "select distinct * from tableinfo"
Set appRs = appConn.Execute(strSQL)
While Not appRs.EOF
Set mNode = TVTable.Nodes.Add(, tvwChild, Trim(appRs(0)), Trim(appRs(0)))
appRs.MoveNext
Wend
strTableName = TVTable.SelectedItem.Key
End Sub
Private Sub FormatMSFlexGrid(Tabindex As Integer, Tablename As String)
Dim list As ListBox
Dim i As Integer
Dim j As Integer
Dim Info_Title(4)
Dim Info_Person(4) As String
Dim Info_Cols As Integer
MSFGLimit.Clear
MSFGLimit.Redraw = False
If Tablename = "" Then
Exit Sub
Else
Select Case Tabindex
Case 0
'////////////////// 初始化网格数据MSFGLimit /////////////////
MSFGLimit.Cols = 5
With MSFGLimit
.ColWidth(0) = 2250
.ColWidth(1) = 1000
.ColWidth(2) = 1000
.ColWidth(3) = 1000
.ColWidth(4) = 2250
.FillStyle = flexFillRepeat
.AllowBigSelection = False
.FillStyle = flexFillSingle
End With
Info_Person(0) = "个 人"
Info_Person(1) = "输入"
Info_Person(2) = "查询"
Info_Person(3) = "修改"
Info_Person(4) = "权限范围"
For Info_Cols = 0 To UBound(Info_Person())
MSFGLimit.Row = 0
MSFGLimit.Col = Info_Cols
MSFGLimit.Text = Info_Person(Info_Cols)
MSFGLimit.CellAlignment = flexAlignCenterCenter
Next Info_Cols
'//////////// 读出权限 //////////////
strSQL = "select distinct A.LimitName,A.DealName,A.DealTable,A.Write,A.Query,A.Edit,"
strSQL = strSQL & " G.username "
strSQL = strSQL & " from AppLimittest A,groupuser G "
strSQL = strSQL & " where A.limitname=G.username "
strSQL = strSQL & " and A.dealtable='" & strTableName & "' "
Set appRs = appConn.Execute(strSQL)
i = 1
While Not appRs.EOF
MSFGLimit.Rows = i + 1
MSFGLimit.Row = i
MSFGLimit.TextMatrix(i, 0) = appRs("limitname")
MSFGLimit.Col = 1
If appRs(3) = "1" Then
Set MSFGLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
MSFGLimit.CellPictureAlignment = flexAlignCenterCenter
Else
Set MSFGLimit.CellPicture = Nothing
End If
MSFGLimit.Col = 2
If appRs(4) = "1" Then
Set MSFGLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
MSFGLimit.CellPictureAlignment = flexAlignCenterCenter
Else
Set MSFGLimit.CellPicture = Nothing
End If
MSFGLimit.Col = 3
If appRs(5) = "1" Then
Set MSFGLimit.CellPicture = LoadPicture(Trim(App.Path) & "\images\v2.bmp")
MSFGLimit.CellPictureAlignment = flexAlignCenterCenter
Else
Set MSFGLimit.CellPicture = Nothing
End If
MSFGLimit.TextMatrix(i, 4) = appRs("DealName")
appRs.MoveNext
i = i + 1
Wend
Case 1
'////////////////// 初始化网格数据MSFGLimit /////////////////
MSFGLimit.Cols = 5
With MSFGLimit
.ColWidth(0) = 2250
.ColWidth(1) = 1000
.ColWidth(2) = 1000
.ColWidth(3) = 1000
.ColWidth(4) = 2250
.FillStyle = flexFillRepeat
.AllowBigSelection = False
.FillStyle = flexFillSingle
End With
Info_Title(0) = "权限单位"
Info_Title(1) = "输入"
Info_Title(2) = "查询"
Info_Title(3) = "修改"
Info_Title(4) = "权限范围"
For Info_Cols = 0 To UBound(Info_Title())
MSFGLimit.Row = 0
MSFGLimit.Col = Info_Cols
MSFGLimit.Text = Info_Title(Info_Cols)
MSFGLimit.CellAlignment = flexAlignCenterCenter
Next Info_Cols
'//////////// 读出权限 //////////////
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?