📄 frminipower.frm
字号:
VERSION 5.00
Object = "{0D6234D1-DBA2-11D1-B5DF-0060976089D0}#6.0#0"; "TODG6.OCX"
Begin VB.Form frmIniPower
BackColor = &H00D39E9F&
Caption = "605"
ClientHeight = 4335
ClientLeft = 60
ClientTop = 345
ClientWidth = 6795
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4335
ScaleWidth = 6795
StartUpPosition = 3 '窗口缺省
Begin TrueOleDBGrid60.TDBGrid lstGroup
Height = 2475
Left = 120
OleObjectBlob = "frminiPower.frx":0000
TabIndex = 16
Top = 420
Width = 1335
End
Begin VB.CommandButton cmdNew
Caption = "604"
Height = 375
Left = 3600
TabIndex = 15
Top = 3870
Width = 1095
End
Begin VB.CommandButton cmdDel
Caption = "603"
Height = 375
Left = 1980
TabIndex = 14
Top = 3870
Width = 1005
End
Begin VB.CommandButton cmdUser
Caption = "610"
Height = 375
Left = 3660
TabIndex = 13
Top = 2160
Width = 465
End
Begin VB.CommandButton cmdUserAll
Caption = "609"
Height = 375
Left = 3660
TabIndex = 12
Top = 1710
Width = 465
End
Begin VB.CommandButton cmdsys
Caption = "607"
Height = 375
Left = 3660
TabIndex = 11
Top = 1080
Width = 465
End
Begin VB.CommandButton cmdsysAll
BackColor = &H00D39E9F&
Caption = "608"
Height = 375
Left = 3660
TabIndex = 10
Top = 630
Width = 465
End
Begin VB.Frame Frame1
BackColor = &H00C0C0C0&
Caption = "137"
Height = 735
Left = 120
TabIndex = 3
Top = 3060
Width = 6495
Begin VB.CheckBox chkCW
Caption = "144"
Height = 195
Left = 5580
TabIndex = 9
Top = 360
Width = 825
End
Begin VB.CheckBox chkPost
Caption = "606"
Height = 195
Left = 4590
TabIndex = 8
Top = 360
Width = 825
End
Begin VB.CheckBox chkCheck
Caption = "22"
Height = 195
Left = 3600
TabIndex = 7
Top = 360
Width = 825
End
Begin VB.CheckBox chkQuery
Caption = "145"
Height = 195
Left = 2520
TabIndex = 6
Top = 360
Width = 825
End
Begin VB.CheckBox chkUpdate
Caption = "12"
Height = 195
Left = 1440
TabIndex = 5
Top = 360
Width = 825
End
Begin VB.CheckBox chkNew
Caption = "143"
Height = 195
Left = 360
TabIndex = 4
Top = 360
Width = 825
End
End
Begin TrueOleDBGrid60.TDBGrid lstSysPower
Height = 2475
Left = 1560
OleObjectBlob = "frminiPower.frx":2839
TabIndex = 17
Top = 420
Width = 2055
End
Begin TrueOleDBGrid60.TDBGrid lstPower
Height = 2475
Left = 4200
OleObjectBlob = "frminiPower.frx":5075
TabIndex = 18
Top = 420
Width = 2415
End
Begin VB.Label Label2
Caption = "602"
Height = 195
Left = 4590
TabIndex = 2
Top = 90
Width = 1005
End
Begin VB.Label Label1
Caption = "601"
Height = 195
Left = 2250
TabIndex = 1
Top = 90
Width = 1305
End
Begin VB.Label lblsysPower
Caption = "600"
Height = 195
Left = 540
TabIndex = 0
Top = 90
Width = 975
End
End
Attribute VB_Name = "frmIniPower"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public MyParent As frmPubOAPower
Private Sub cmdDel_Click()
Dim rstini As Recordset
GetCNClient.Execute "Delete from PubOAUserWork Where UserId ='" & Mid(PubOAKey, 3, 50) & "'"
Set rstini = New Recordset
rstini.Open " SELECT PubOAUser.Explain AS UserExplain, PubOAGroup.Explain AS GroupExplain, " _
& " PubOAUserWork.Explain, PubOAUserWork.AllowNew, PubOAUserWork.AllowUpdate," _
& " PubOAUserWork.OnlyRead, PubOAUserWork.[Check], PubOAUserWork.Post, " _
& " PubOAUserWork.rs FROM PubOAGroup INNER JOIN PubOAPower ON PubOAGroup.GroupID = PubOAPower.GroupID RIGHT OUTER JOIN " _
& " PubOAUserWork ON PubOAPower.FunctionID = PubOAUserWork.FunctionID LEFT OUTER JOIN " _
& " PubOAUser ON PubOAUserWork.UserID = PubOAUser.UserID " _
& " Where PubOAUser.UserID= '" & Trim(Mid(PubOAKey, 3, 50)) & "' ORDER BY PubOAUser.Explain, PubOAGroup.Explain ", GetCNClient, adOpenStatic, adLockOptimistic
Set MyParent.TDBGrid1.DataSource = rstini
InitTurboGrid MyParent.TDBGrid1, MyParent.Name, , True
End Sub
Private Sub cmdNew_Click()
Dim rstini As Recordset
Set rstini = New Recordset
rstini.Open "Select * From PubOAPower where IsSelect=1 ", GetCNClient, adOpenForwardOnly
If Left(PubOAKey, 2) = "U_" Then
Do Until rstini.EOF
GetCNClient.Execute " Insert into PubOAUserWork(UserID, FunctionID, Explain, AllowNew, AllowUpdate, OnlyRead, [Check], Post,RS) Values" _
& " ('" & Mid(PubOAKey, 3, 50) & "','" & rstini![FunctionID] & "','" & rstini![Explain] & "','" & Me.chkNew.Value & "','" & Me.chkUpdate.Value & "','" & Me.chkQuery.Value & "','" & Me.chkCheck.Value & "','" & Me.chkPost.Value & "','" & Me.chkCW.Value & "' )"
rstini.MoveNext
Loop
GetCNClient.Execute "Update PubOAPower Set IsSelect=0 where IsSelect=1 "
Else
If PubOAKey = "OAAdmin" Then
GetCNClient.Execute "Delete From PubOAUserWork Where UserID='Admin'"
Set rstini = New Recordset
rstini.Open "Select * From PubOAPower ", GetCNClient, adOpenForwardOnly
Do Until rstini.EOF
GetCNClient.Execute " Insert into PubOAUserWork(UserID, FunctionID, Explain, AllowNew, AllowUpdate, OnlyRead, [Check], Post,RS) Values" _
& " ('" & Mid(PubOAKey, 3, 50) & "','" & rstini![FunctionID] & "','" & rstini![Explain] & "',1,1,1,1,1,1 )"
rstini.MoveNext
Loop
End If
End If
Set rstini = New Recordset
rstini.Open " SELECT PubOAUser.Explain AS UserExplain, PubOAGroup.Explain AS GroupExplain, " _
& " PubOAUserWork.Explain, PubOAUserWork.AllowNew, PubOAUserWork.AllowUpdate," _
& " PubOAUserWork.OnlyRead, PubOAUserWork.[Check], PubOAUserWork.Post, " _
& " PubOAUserWork.rs FROM PubOAGroup INNER JOIN PubOAPower ON PubOAGroup.GroupID = PubOAPower.GroupID RIGHT OUTER JOIN " _
& " PubOAUserWork ON PubOAPower.FunctionID = PubOAUserWork.FunctionID LEFT OUTER JOIN " _
& " PubOAUser ON PubOAUserWork.UserID = PubOAUser.UserID " _
& " Where PubOAUser.UserID= '" & Trim(Mid(PubOAKey, 3, 50)) & "' ORDER BY PubOAUser.Explain, PubOAGroup.Explain ", GetCNClient, adOpenStatic, adLockOptimistic
Set MyParent.TDBGrid1.DataSource = rstini
InitTurboGrid MyParent.TDBGrid1, MyParent.Name, , True
End Sub
Private Sub cmdsys_Click()
GetCNClient.Execute "Update PubOAPower Set IsSelect=1 Where IsSelect=0 and sysGroupID ='" & Me.lstGroup.Columns(0).Text & "' and FunctionID='" & Me.lstSysPower.Columns(0).Text & "' "
iniList
End Sub
Private Sub cmdsysAll_Click()
GetCNClient.Execute "Update PubOAPower Set IsSelect=1 Where IsSelect=0 and sysGroupID ='" & Me.lstGroup.Columns(0).Text & "' "
iniList
End Sub
Private Sub cmdUser_Click()
GetCNClient.Execute "Update PubOAPower Set IsSelect=0 Where IsSelect=1 and sysGroupID ='" & Me.lstGroup.Columns(0).Text & "' and FunctionID='" & Me.lstPower.Columns(0).Text & "' "
iniList
End Sub
Private Sub cmdUserAll_Click()
GetCNClient.Execute "Update PubOAPower Set IsSelect=0 Where IsSelect=1 and sysGroupID ='" & Me.lstGroup.Columns(0).Text & "' "
iniList
End Sub
Private Sub Form_Load()
Dim rstPower As Recordset
Set rstPower = New Recordset
Me.Caption = LoadResString(Val(Me.Caption & GLanguageID))
GGetRes GLanguageID, Me
rstPower.Open "Select GroupID,Explain From PubOAGroup Where IsSys=0 Order By IndexNo ", GetCNClient, adOpenStatic, adLockReadOnly
Set Me.lstGroup.DataSource = rstPower
Me.lstGroup.Columns(1).Width = Me.lstGroup.Width - 50
Me.lstGroup.Columns(0).Visible = False
Me.lstGroup.Columns(0).AllowSizing = False
If rstPower.RecordCount > 0 Then
rstPower.MoveFirst
Me.lstGroup.Columns(1).ValueItems.Presentation = 2
Me.lstGroup.Columns(1).ValueItems.Validate = True
Me.lstGroup.Columns(1).ValueItems.Translate = True
Dim ii As New ValueItem
Do Until rstPower.EOF
ii.Value = rstPower![Explain]
If IsNumeric(rstPower![Explain]) Then
ii.DisplayValue = LoadResString(Val(rstPower![Explain] & GLanguageID))
Else
ii.DisplayValue = rstPower![Explain]
End If
Me.lstGroup.Columns(1).ValueItems.Add ii
rstPower.MoveNext
Loop
End If
GetCNClient.Execute "update PubOAPower set IsSelect=0 "
GetCNClient.Execute "update PubOAPower set IsSelect=2 FROM PubOAUserWork , PubOAPower WHERE PubOAUserWork.UserID = '" & Mid(PubOAKey, 3, 50) & "' and PubOAUserWork.FunctionID = PubOAPower.FunctionID "
End Sub
Private Sub lstGroup_Click()
'MsgBox Me.lstGroup.Text
'iniList
End Sub
Private Sub iniList()
Dim rstPower As Recordset
Set rstPower = New Recordset
'GetCNClient.Execute "Update PubOAPower Set IsSelect=0"
'If Me.lstGroup.Text = "*" Then
' rstPower.Open "Select Explain From PubOAPower Where IsSelect=0 Order by Explain ", GetCNClient, adOpenForwardOnly
'Else
rstPower.Open "Select FunctionID,Explain From PubOAPower Where IsSelect=0 and sysGroupID ='" & Me.lstGroup.Columns(0).Text & "' Order by PubOAPower.Explain ", GetCNClient, adOpenStatic, adLockReadOnly
'End If
Set Me.lstSysPower.DataSource = rstPower
Me.lstSysPower.Columns(1).Width = Me.lstSysPower.Width - 50
Me.lstSysPower.Columns(0).Visible = False
Me.lstSysPower.Columns(0).AllowSizing = False
If rstPower.RecordCount > 0 Then
rstPower.MoveFirst
Me.lstSysPower.Columns(1).ValueItems.Presentation = 2
Me.lstSysPower.Columns(1).ValueItems.Validate = True
Me.lstSysPower.Columns(1).ValueItems.Translate = True
Dim ii As New ValueItem
Do Until rstPower.EOF
ii.Value = rstPower![Explain]
ii.DisplayValue = LoadResString(Val(rstPower![Explain] & GLanguageID))
Me.lstSysPower.Columns(1).ValueItems.Add ii
rstPower.MoveNext
Loop
End If
Set rstPower = New Recordset
rstPower.Open "Select FunctionID,Explain From PubOAPower Where IsSelect=1 or IsSelect=2 Order by PubOAPower.Explain ", GetCNClient, adOpenStatic, adLockReadOnly
Set Me.lstPower.DataSource = rstPower
Me.lstPower.Columns(1).Width = Me.lstPower.Width - 50
Me.lstPower.Columns(0).Visible = False
Me.lstPower.Columns(0).AllowSizing = False
If rstPower.RecordCount > 0 Then
rstPower.MoveFirst
Me.lstPower.Columns(1).ValueItems.Presentation = 2
Me.lstPower.Columns(1).ValueItems.Validate = True
Me.lstPower.Columns(1).ValueItems.Translate = True
Do Until rstPower.EOF
ii.Value = rstPower![Explain]
ii.DisplayValue = LoadResString(Val(rstPower![Explain] & GLanguageID))
Me.lstPower.Columns(1).ValueItems.Add ii
rstPower.MoveNext
Loop
End If
'rstPower.Close
End Sub
Private Sub lstGroup_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
iniList
End Sub
Private Sub lstsysPower_DblClick()
cmdsys_Click
End Sub
Private Sub lstUserPower_DblClick()
cmdUser_Click
End Sub
Private Sub TDBGrid1_Click()
End Sub
Private Sub UpDown1_Change()
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -