📄
字号:
VERSION 5.00
Begin VB.Form Gy_WarehousePower
BorderStyle = 3 'Fixed Dialog
Caption = "仓库操作员权限"
ClientHeight = 3600
ClientLeft = 45
ClientTop = 330
ClientWidth = 5355
Icon = "公用_仓库权限管理.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3600
ScaleWidth = 5355
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton CmdDel
Caption = "<"
Height = 300
Index = 0
Left = 2130
TabIndex = 8
Top = 1800
Width = 1120
End
Begin VB.CommandButton CmdAdd
Caption = ">"
Height = 300
Index = 0
Left = 2130
TabIndex = 7
Top = 960
Width = 1120
End
Begin VB.Frame Frame1
Caption = "仓库操作员"
Height = 2775
Index = 0
Left = 3330
TabIndex = 5
Top = 600
Width = 1935
Begin VB.ListBox List1
Height = 2220
ItemData = "公用_仓库权限管理.frx":1042
Left = 120
List = "公用_仓库权限管理.frx":1044
TabIndex = 6
Top = 315
Width = 1695
End
End
Begin VB.Frame Frame1
Caption = "系统操作员"
Height = 2775
Index = 1
Left = 90
TabIndex = 3
Top = 600
Width = 1935
Begin VB.ListBox List2
Height = 2220
ItemData = "公用_仓库权限管理.frx":1046
Left = 120
List = "公用_仓库权限管理.frx":1048
TabIndex = 4
Top = 315
Width = 1695
End
End
Begin VB.CommandButton Command1
Caption = "退出(&E)"
Height = 300
Left = 2130
TabIndex = 2
Top = 2640
Width = 1120
End
Begin VB.CommandButton CmdAdd
Caption = ">>"
Height = 300
Index = 1
Left = 2130
TabIndex = 1
Top = 1380
Width = 1120
End
Begin VB.CommandButton CmdDel
Caption = "<<"
Height = 300
Index = 1
Left = 2130
TabIndex = 0
Top = 2220
Width = 1120
End
Begin VB.Label Label1
Caption = "Label1"
Height = 345
Left = 1875
TabIndex = 11
Top = 120
Width = 2415
End
Begin VB.Label Label2
Caption = "Label2"
Height = 495
Left = 3990
TabIndex = 10
Top = 0
Visible = 0 'False
Width = 1215
End
Begin VB.Label Label3
Caption = "Label3"
Height = 495
Left = 2040
TabIndex = 9
Top = 3240
Visible = 0 'False
Width = 1215
End
End
Attribute VB_Name = "Gy_WarehousePower"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'* 模 块 名 称 :人员仓库权限设置
'* 功 能 描 述 :
'* 程序员姓名 :徐强
'* 最后修改人 :徐强
'* 最后修改时间:2001/11/27
'* 备 注:
'*******************************************************
Private Sub AddPerson()
Dim RecTemp As New Recordset
Dim StrTemp As String
Dim Rec_T As New Recordset
Dim Tsxx As String
On Error GoTo Swcwcl
Set Rec_T = Cw_DataEnvi.DataConnect.Execute("select czybm from Gy_Czygl where czymc='" & Trim(List2.List(List2.ListIndex)) & "'")
RecTemp.Open "SELECT * FROM Gy_WhLimit WHERE czybm='" + Trim(Rec_T.Fields("czybm")) + "'" & " And whcode ='" & Trim(Label2.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
With RecTemp
If Not .EOF Then
Tsxx = "此人已存在!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End If
.AddNew
.Fields("czybm") = Trim(Rec_T.Fields("czybm"))
.Fields("whcode") = Trim(Label2.Caption)
.Update
End With
List1.AddItem List2.List(List2.ListIndex)
Exit Sub
Swcwcl:
Tsxx = "存盘过程中出现错误,请退出后重新进入!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End Sub
Private Sub CmdAdd_Click(Index As Integer)
Select Case Index
Case 0
If List2.ListIndex >= 0 Then
AddPerson
End If
Case 1
AddPerson1
End Select
End Sub
Private Sub CmdDel_Click(Index As Integer)
Dim jsq As Integer
Dim Rectemp1 As New Recordset
Dim count As Integer
Dim temp_count As Integer
Select Case Index
Case 0
If List1.ListIndex >= 0 Then
Set Rectemp1 = Cw_DataEnvi.DataConnect.Execute("select * from Gy_V_WarehousePower where whcode='" & Trim(Label2.Caption) & "'" & "and czymc='" & Trim(List1.List(List1.ListIndex)) & "'")
Cw_DataEnvi.DataConnect.Execute "delete Gy_WhLimit where whcode ='" + Trim(Label2.Caption) + "'" & "and czybm='" & Trim(Rectemp1.Fields("czybm")) & "'"
List1.RemoveItem List1.ListIndex
End If
Case 1
For count = 0 To List1.ListCount - 1
Set Rectemp1 = Cw_DataEnvi.DataConnect.Execute("select * from Gy_V_WarehousePower where whcode='" & Trim(Label2.Caption) & "'" & "and czymc='" & Trim(List1.List(count)) & "'")
If Rectemp1.EOF Then
Else
Cw_DataEnvi.DataConnect.Execute "delete Gy_WhLimit where whcode ='" + Trim(Label2.Caption) + "'" & "and czybm='" & Trim(Rectemp1.Fields("czybm")) & "'"
End If
Next
temp_count = List1.ListCount - 1
For count = 0 To temp_count
List1.RemoveItem 0
Next
End Select
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
Tcsj
Tcry
End Sub
Public Sub Tcsj()
Dim i As Integer
Dim RecTemp As New Recordset
Dim StrTemp As String
StrTemp = "select * from Gy_V_WarehousePower where whcode='" & Trim(Gy_Warehouse.CzxsGrid.TextMatrix(Gy_Warehouse.RZ, Gy_Warehouse.LZ)) & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(StrTemp)
If Not RecTemp.EOF Then
Label1.Caption = "仓库：" & Trim(RecTemp.Fields("whname"))
Label2.Caption = RecTemp.Fields("whcode")
Label3.Caption = RecTemp.Fields("czybm")
List1.Clear
RecTemp.MoveFirst
For i = 1 To RecTemp.RecordCount
List1.AddItem " " & RecTemp.Fields("czymc")
RecTemp.MoveNext
Next i
Else
List1.Clear
End If
Label1.Caption = "仓库：" & Trim((Gy_Warehouse.CzxsGrid.TextMatrix(Gy_Warehouse.RZ, Gy_Warehouse.LZ + 1)))
Label2.Caption = Trim((Gy_Warehouse.CzxsGrid.TextMatrix(Gy_Warehouse.RZ, Gy_Warehouse.LZ)))
End Sub
Private Sub Tcry()
Dim str_temp As String
Dim i As Integer
Dim Rec_Temp As New Recordset
str_temp = "select czybm,czymc from Gy_Czygl"
Set Rec_Temp = Cw_DataEnvi.DataConnect.Execute(str_temp)
If Not Rec_Temp.EOF Then
Rec_Temp.MoveFirst
For i = 1 To Rec_Temp.RecordCount
List2.AddItem " " & Rec_Temp.Fields("czymc")
Rec_Temp.MoveNext
Next i
End If
End Sub
Private Sub AddPerson1()
Dim RecTemp As New Recordset
Dim StrTemp As String
Dim Tsxx As String
Dim Rec_T As New Recordset
Dim count As Integer
On Error GoTo Swcwcl
For count = 0 To List2.ListCount - 1
Set Rec_T = Cw_DataEnvi.DataConnect.Execute("select czybm from Gy_Czygl where czymc='" & Trim(List2.List(count)) & "'")
If Rec_T.EOF Then
Else
RecTemp.Open "SELECT * FROM Gy_WhLimit WHERE czybm='" + Trim(Rec_T.Fields("czybm")) + "'" & " And whcode ='" & Trim(Label2.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
With RecTemp
If Not .EOF Then
Else
.AddNew
.Fields("czybm") = Trim(Rec_T.Fields("czybm"))
.Fields("whcode") = Trim(Label2.Caption)
.Update
List1.AddItem List2.List(count)
End If
End With
RecTemp.Close
Set RecTemp = Nothing
End If
Next
Exit Sub
Swcwcl:
Tsxx = "存盘过程中出现错误,请退出后重新进入!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -