📄 frmoasellmain.frm
字号:
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{0D6234D1-DBA2-11D1-B5DF-0060976089D0}#6.0#0"; "TODG6.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{2254D35F-316C-11D4-A9BB-00105A83C563}#1.0#0"; "VERTMENU.OCX"
Begin VB.Form PubOASellMain
Caption = "Form2"
ClientHeight = 6660
ClientLeft = 165
ClientTop = 450
ClientWidth = 9660
LinkTopic = "Form2"
ScaleHeight = 6660
ScaleWidth = 9660
StartUpPosition = 2 '屏幕中心
WindowState = 2 'Maximized
Begin VB.Timer Timer1
Interval = 60000
Left = 1080
Top = 5700
End
Begin VertMenu.VerticalMenu VtlMenu
Height = 5535
Left = 60
TabIndex = 9
Top = 60
Width = 1455
_ExtentX = 2566
_ExtentY = 9763
MenuCaption1 = "Menu1"
MenuItemIcon11 = "frmOASellMain.frx":0000
End
Begin VB.PictureBox Picture2
AutoSize = -1 'True
Height = 6840
Left = 1560
Picture = "frmOASellMain.frx":031A
ScaleHeight = 6780
ScaleWidth = 10200
TabIndex = 8
Top = 4440
Visible = 0 'False
Width = 10260
End
Begin MSWinsockLib.Winsock tcpServer
Index = 0
Left = 600
Top = 5700
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock tcpClient
Left = 120
Top = 5700
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000000&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 3915
Left = 1560
ScaleHeight = 3915
ScaleWidth = 7455
TabIndex = 0
Top = 360
Visible = 0 'False
Width = 7455
Begin VB.CommandButton cmdSend
Caption = "发送(&S)"
Height = 375
Left = 6480
TabIndex = 7
Top = 1080
Width = 975
End
Begin VB.CommandButton cmdLink
Caption = "测试连接"
Height = 375
Left = 6480
TabIndex = 1
Top = 480
Width = 975
End
Begin TrueOleDBGrid60.TDBGrid TDBGrid1
Height = 915
Left = 0
OleObjectBlob = "frmOASellMain.frx":F72F
TabIndex = 2
Top = 0
Width = 6015
End
Begin RichTextLib.RichTextBox RTxtSummary
Height = 615
Left = 0
TabIndex = 3
Top = 1560
Width = 7395
_ExtentX = 13044
_ExtentY = 1085
_Version = 393217
ScrollBars = 3
AutoVerbMenu = -1 'True
TextRTF = $"frmOASellMain.frx":11F68
End
Begin RichTextLib.RichTextBox RtxtSend
Height = 855
Left = 0
TabIndex = 4
Top = 2460
Visible = 0 'False
Width = 7395
_ExtentX = 13044
_ExtentY = 1508
_Version = 393217
ScrollBars = 3
AutoVerbMenu = -1 'True
TextRTF = $"frmOASellMain.frx":121F2
End
Begin VB.Label lblTopic
Caption = "主题："
Height = 255
Left = 60
TabIndex = 6
Top = 1320
Width = 4695
End
Begin VB.Label lblSend
Caption = "收件人：发件人："
Height = 255
Left = 60
TabIndex = 5
Top = 1020
Width = 4695
End
End
Begin VB.Label lblState
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Height = 255
Left = 1560
TabIndex = 10
Top = 60
Width = 7995
End
Begin VB.Menu menuFile
Caption = "文件"
NegotiatePosition= 1 'Left
Begin VB.Menu meunExit
Caption = "退出"
End
End
Begin VB.Menu menuBasic
Caption = "基础数据"
Begin VB.Menu menuBasicItem
Caption = "menuBasic"
Index = 0
End
End
Begin VB.Menu menuPurchase
Caption = "采购"
Begin VB.Menu menuPurchaseItem
Caption = "menuPurchase"
Index = 0
End
End
Begin VB.Menu menuStock
Caption = "库存"
Begin VB.Menu menuStockItem
Caption = "menuStock"
Index = 0
End
End
Begin VB.Menu menuSell
Caption = "销售"
Begin VB.Menu menuSellItem
Caption = "menuSell"
Index = 0
End
End
Begin VB.Menu menuFinance
Caption = "财务"
Begin VB.Menu menuFinanceItem
Caption = "menuFinance"
Index = 0
End
End
Begin VB.Menu menuAnalyzer
Caption = "分析"
Begin VB.Menu menuAnalyzerItem
Caption = "menuAnalyzerItem"
Index = 0
End
End
Begin VB.Menu menu7
Caption = "menu7"
Visible = 0 'False
End
Begin VB.Menu menu8
Caption = "menu8"
Visible = 0 'False
End
Begin VB.Menu menu9
Caption = "menu9"
Visible = 0 'False
End
Begin VB.Menu menu10
Caption = "menu10"
Visible = 0 'False
End
Begin VB.Menu menuPower
Caption = "权限设置"
End
End
Attribute VB_Name = "PubOASellMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub TimeWarning()
Dim rstEmail As Recordset
Set rstEmail = New Recordset
rstEmail.Open "Select SendMen from PubOAData Where addressee='" & LoginName & "' ", GetCNClient, adOpenForwardOnly
If rstEmail.EOF Then
Warning "0"
' Me.VtlMenu.MenuCur = 1
Else
Warning "1"
' Me.VtlMenu.MenuCur = 3
End If
End Sub
Private Sub cmdLink_Click()
Dim ServerName As String
If Me.TDBGrid1.Columns.Count > 2 Then
If IsNull(Me.TDBGrid1.Columns(3).Value) Then
Exit Sub
Else
ServerName = Me.TDBGrid1.Columns(3).Value
End If
Else
If IsNull(Me.TDBGrid1.Columns(1).Value) Then
Exit Sub
Else
ServerName = Me.TDBGrid1.Columns(1).Value
End If
End If
If LinkServer(ServerName) = 1 Then
MisMsg "测试连接成功。"
End If
End Sub
Private Sub cmdSend_Click()
Dim ServerName As String
If Me.TDBGrid1.Columns.Count > 2 Then
If IsNull(Me.TDBGrid1.Columns(3).Value) Then
Exit Sub
Else
ServerName = Me.TDBGrid1.Columns(3).Value
End If
Else
If IsNull(Me.TDBGrid1.Columns(1).Value) Then
Exit Sub
Else
ServerName = Me.TDBGrid1.Columns(1).Value
End If
End If
If LinkServer(ServerName) = 0 Then Exit Sub
If Me.RtxtSend.Text = "" Then Exit Sub
tcpClient.SendData LoginName & ": " & Trim(RtxtSend.Text)
Me.RtxtSend.Text = ""
End Sub
Private Sub FormLoadMenu()
End Sub
Private Function iniMenu() As Integer
On Error GoTo Err_iniMenu
Dim rstMenu As Recordset, i As Integer, rstItem As Recordset
iniMenu = 0
Me.menuBasic.Visible = False
Me.menuPurchase.Visible = False
Me.menuSell.Visible = False
Me.menuPurchase.Visible = False
Me.menuStock.Visible = False
Me.menuFinance.Visible = False
Me.menuAnalyzer.Visible = False
Set rstMenu = New Recordset
rstMenu.Open "Select * From v_UserWork_Group where UserID='" & LoginName & "' ", GetCNClient, adOpenForwardOnly
' i = 1
Do Until rstMenu.EOF
Select Case UCase(rstMenu![sysGroupID])
Case "BASIC"
Me.menuBasic.Visible = True
Set rstItem = New Recordset
rstItem.Open "Select * From v_UserWork_Item where UserID = '" & LoginName & "' and sysGroupID='BASIC' ", GetCNClient, adOpenForwardOnly
i = 1
Do Until rstItem.EOF
Load Me.menuBasicItem(i)
Me.menuBasicItem(i).Caption = rstItem![Explain]
Me.menuBasicItem(i).Visible = True
rstItem.MoveNext
i = i + 1
Loop
Me.menuBasicItem(0).Visible = False
Set rstItem = Nothing
Case "PURCHASE"
Me.menuPurchase.Visible = True
Set rstItem = New Recordset
rstItem.Open "Select * From v_UserWork_Item where UserID = '" & LoginName & "' and sysGroupID='PURCHASE' ", GetCNClient, adOpenForwardOnly
i = 1
Do Until rstItem.EOF
Load Me.menuPurchaseItem(i)
Me.menuPurchaseItem(i).Caption = rstItem![Explain]
Me.menuPurchaseItem(i).Visible = True
rstItem.MoveNext
i = i + 1
Loop
Me.menuPurchaseItem(0).Visible = False
Set rstItem = Nothing
Case "SELL"
Me.menuSell.Visible = True
Set rstItem = New Recordset
rstItem.Open "Select * From v_UserWork_Item where UserID = '" & LoginName & "' and sysGroupID='SELL' ", GetCNClient, adOpenForwardOnly
i = 1
Do Until rstItem.EOF
Load Me.menuSellItem(i)
Me.menuSellItem(i).Caption = rstItem![Explain]
Me.menuSellItem(i).Visible = True
rstItem.MoveNext
i = i + 1
Loop
Me.menuSellItem(0).Visible = False
Set rstItem = Nothing
Case "STOCK"
Me.menuStock.Visible = True
Set rstItem = New Recordset
rstItem.Open "Select * From v_UserWork_Item where UserID = '" & LoginName & "' and sysGroupID='STOCK' ", GetCNClient, adOpenForwardOnly
i = 1
Do Until rstItem.EOF
Load Me.menuStockItem(i)
Me.menuStockItem(i).Caption = rstItem![Explain]
Me.menuStockItem(i).Visible = True
rstItem.MoveNext
i = i + 1
Loop
Me.menuStockItem(0).Visible = False
Set rstItem = Nothing
Case "FINANCE"
Me.menuFinance.Visible = True
Set rstItem = New Recordset
rstItem.Open "Select * From v_UserWork_Item where UserID = '" & LoginName & "' and sysGroupID='FINANCE' ", GetCNClient, adOpenForwardOnly
i = 1
Do Until rstItem.EOF
Load Me.menuFinanceItem(i)
Me.menuFinanceItem(i).Caption = rstItem![Explain]
Me.menuFinanceItem(i).Visible = True
rstItem.MoveNext
i = i + 1
Loop
Me.menuFinanceItem(0).Visible = False
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -