📄 mainfrm.frm
字号:
Height = 285
Index = 3
Left = 7320
MouseIcon = "MainFrm.frx":2C71F
MousePointer = 99 'Custom
TabIndex = 4
Tag = "库存管理.exe"
Top = 2280
Width = 1260
End
Begin VB.Shape Shape1
BorderColor = &H00000080&
Height = 495
Left = 7200
Shape = 4 'Rounded Rectangle
Top = 4800
Width = 1455
End
Begin VB.Image Image2
Height = 300
Left = 6720
Picture = "MainFrm.frx":2CA29
Top = 1500
Width = 300
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "人事管理"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 285
Index = 4
Left = 4680
MouseIcon = "MainFrm.frx":2CE2A
MousePointer = 99 'Custom
TabIndex = 3
Tag = "人事管理.exe"
Top = 3120
Width = 1260
End
Begin VB.Image Image3
Height = 300
Left = 4080
Picture = "MainFrm.frx":2D134
Top = 3100
Width = 300
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "生产计划"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 285
Index = 0
Left = 4665
MouseIcon = "MainFrm.frx":2D535
MousePointer = 99 'Custom
TabIndex = 2
Tag = "生产计划.exe"
Top = 1500
Width = 1260
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "生产管理"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 285
Index = 1
Left = 7320
MouseIcon = "MainFrm.frx":2D83F
MousePointer = 99 'Custom
TabIndex = 1
Tag = "生产管理.exe"
Top = 1500
Width = 1260
End
Begin VB.Image Image4
Height = 300
Left = 4080
Picture = "MainFrm.frx":2DB49
Top = 1500
Width = 300
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "工资结算"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 285
Index = 2
Left = 4680
MouseIcon = "MainFrm.frx":2DF4A
MousePointer = 99 'Custom
TabIndex = 0
Tag = "工资结算.exe"
Top = 2295
Width = 1260
End
Begin VB.Image Image5
Height = 300
Left = 4080
Picture = "MainFrm.frx":2E254
Top = 2300
Width = 300
End
Begin VB.Image Image1
Height = 6585
Left = 0
Picture = "MainFrm.frx":2E655
Top = 0
Width = 8955
End
End
Attribute VB_Name = "MainFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RtxtBln As Boolean
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Form_Load()
Dim i As Integer
Dim sTmp As String
RtxtBln = False
ReDim sArrVer(Label1.Count)
For i = 0 To Label1.Count - 1
If Label1(i).Visible And Label1(i).Tag <> "" Then
sTmp = getVersion(CStr(App.Path + "\" + Label1(i).Tag))
sArrVer(i) = IIf((sTmp <> "-1"), sTmp, "1")
End If
Next
LabServer.Caption = "远程服务器：" & ServerName
Call sub_listSysName
Call RtxtShow
Dim RsCsDel As ADODB.Recordset
Set RsCsDel = New ADODB.Recordset
RsCsDel.Open "SELECT count(*) as SumCount FROM 发布消息表 where 接收人='" & Xtczy & "' And 已阅 = 0", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
If RsCsDel!SumCount > 0 Then
Label1(9).Caption = RsCsDel!SumCount
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'清除注册表,以保证总控台关闭，不能再进入子系统
SaveSetting Ebo_gsProductName, Ebo_gsPrjName, "Xtsjljc", ""
'下线
Call Register_OnlineUser(LOG_OUT)
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Integer
For i = 0 To Label1.Count - 2
Label1(i).ForeColor = &H8000&
Next i
Label1(9).ForeColor = &HFFFFFF
End Sub
Private Sub Label1_Click(Index As Integer)
On Error GoTo exit_err
If UCase(Trim(Label1(Index).Tag)) <> "EXIT" Then
Shell App.Path & "\" & Label1(Index).Tag, vbNormalFocus
Unload Me: Exit Sub
Else
Unload Me: Exit Sub
End If
Me.WindowState = 1
Exit Sub
exit_err:
MsgBox "没有安装此子系统！ ", 48
End Sub
Private Sub Label1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Label1(Index).ForeColor = &HFF&
End Sub
Private Sub RtxtShow()
Dim RsMsg As ADODB.Recordset
Set RsMsg = New Recordset
RsMsg.Open "select * from Xt_Message where X_Show='1' and D_date>= '" & GSdate & "' order by id desc", Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
If RsMsg.BOF And RsMsg.EOF Then
RtxtBln = False
Rtxt.Visible = False
Else
RtxtBln = True
Rtxt.Visible = True
Rtxt.Text = RsMsg!X_Message
End If
RsMsg.Close
Set RsMsg = Nothing
End Sub
Private Sub sub_listSysName()
Dim jsqte As Integer
Dim Rectemp As New Recordset
Dim sqlstr As String
Dim str_sys As String
ReDim sLabelEnable(Label1.Count)
For jsqte = 0 To Label1.Count - 1
Select Case Trim(Label1(jsqte).Caption)
Case "生产计划"
str_sys = "生产计划"
Case "生产管理"
str_sys = "生产管理"
Case "工资结算"
str_sys = "工资结算"
Case "库存管理"
str_sys = "库存管理"
Case "人事管理"
str_sys = "人事管理"
Case "辅料管理"
str_sys = "辅料管理"
Case "基础数据"
str_sys = "基础数据"
Case "系统管理"
str_sys = "系统管理"
End Select
If Trim(Label1(jsqte).Caption) = "退出系统" Then
Label1(jsqte).Enabled = True
End If
Next
End Sub
Private Sub Picture1_Click()
ShellExecute 0, "open", "www.Ebodiy.com", "", "", 0
End Sub
Private Sub Timer1_Timer()
Dim i As Integer
Dim sTmp As String
ReDim sArrVer(Label1.Count)
For i = 0 To Label1.Count - 2
If Label1(i).Visible And Label1(i).Tag <> "" Then
sTmp = getVersion(CStr(App.Path + "\" + Label1(i).Tag))
If Dir(App.Path & "\" & Label1(i).Tag) = "" Then sTmp = "-1"
sArrVer(i) = IIf((sTmp <> "-1"), sTmp, "1")
End If
Next
Call sub_listSysName
lblMsg.Caption = "准备下载..."
lblMsg.Refresh
Timer1.Enabled = False
If fun_NewVerExist Then Act_Download.Show 1
lblMsg.Caption = "远程服务器无更新版本..."
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -