frmsystem_main.frm

企业生产管理系统 提供对企业的日常生产管理

Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private con As New ADODB.Connection
Private rs As New ADODB.Recordset
Private con1 As New ADODB.Connection
Private rs1 As New ADODB.Recordset
Private con2 As New ADODB.Connection
Private rs2 As New ADODB.Recordset
Private str As String
Private str1 As String
Private str2 As String
Public add_i As Integer
Public showfram_i As Integer
Dim Save_No As Integer
Dim i As Integer

Private Sub cmd_save_Click()
If Save_No = 1 Then '添加
On Error Resume Next
Adodc2.Recordset.AddNew
Adodc2.Recordset.Fields(0).Value = Text9.Text
Adodc2.Recordset.Fields(1).Value = Text10.Text
Adodc2.Recordset.Fields("是否在线").Value = "不在线"
Adodc2.Recordset.Update
CmdAddItem.SetFocus
End If ' 修改
If Save_No = 2 Then
Adodc2.RecordSource = "update 公司项目工作表 set 项目编号='" & Text9.Text & ",项目名称='" & Text10.Text & "'where like '" & Text9.Text & "'"
MsgBox ""
End If
cmdFirst.Enabled = True
cmdP.Enabled = True
cmdN.Enabled = True
cmdL.Enabled = True
cmdDel.Enabled = True
cmdUp.Enabled = True
cmdF.Enabled = True
cmd_save.Enabled = False
CmdAddItem.Enabled = True
CmdAddItem.SetFocus
showData
End Sub

Private Sub CmdAddItem_Click()
Save_No = 1 '二次利用cmd_sava 按钮
Text9.Text = ""
Text10.Text = ""
Dim temp1
temp1 = Format(Now, "yyyymmdd")
Adodc2.RecordSource = "select * from 公司工作项目表 order by 项目编号"
Adodc2.Refresh
If Adodc2.Recordset.RecordCount > 0 Then
   Adodc2.Recordset.MoveLast
   Text9.Text = Format(Now, "yyyymmdd") & Format(Val(Right(Adodc2.Recordset.Fields(0), 4) + 1), "0000")
Else
   Text9.Text = Format(Now, "yyyymmdd") + "0001"
End If
cmdFirst.Enabled = False
cmdP.Enabled = False
cmdN.Enabled = False
cmdL.Enabled = False
cmdDel.Enabled = False
cmdUp.Enabled = False
cmdF.Enabled = False
cmd_save.Enabled = True
CmdAddItem.Enabled = False
Text10.SetFocus
End Sub

Private Sub cmdC_Click()
cmdFirst.Enabled = True
cmdP.Enabled = True
cmdN.Enabled = True
cmdL.Enabled = True
cmdDel.Enabled = True
cmdUp.Enabled = True
cmdF.Enabled = True
cmd_save.Enabled = False
CmdAddItem.Enabled = True
showData
End Sub

Private Sub cmdDel_Click()
On Error Resume Next
Adodc2.Recordset.Delete
showData
End Sub

Private Sub cmdDp_Click()
  Frmsystem_main_fpxm.Show
End Sub

Private Sub cmdF_Click()
Dim msg1 As String
msg1 = InputBox$("输入项目编号")
Adodc2.RecordSource = "select * from 公司工作项目表 where 项目编号 ='" & msg1 & "'"
Text9.Text = Adodc2.Recordset.Fields(0).Value
Text10.Text = Adodc2.Recordset.Fields(1).Value
Adodc2.Refresh
End Sub

Private Sub cmdFirst_Click()
Adodc2.Recordset.MoveFirst
Text9.Text = Adodc2.Recordset.Fields(0).Value
Text10.Text = Adodc2.Recordset.Fields(1).Value
End Sub

Private Sub cmdL_Click()
Adodc2.Recordset.MoveLast
Text9.Text = Adodc2.Recordset.Fields(0).Value
Text10.Text = Adodc2.Recordset.Fields(1).Value
End Sub

Private Sub cmdN_Click()
On Error Resume Next
If Adodc2.Recordset.EOF Then
MsgBox "向后已经没有数据了"
Else
Adodc2.Recordset.MoveNext
End If
Text9.Text = Adodc2.Recordset.Fields(0).Value
Text10.Text = Adodc2.Recordset.Fields(1).Value
End Sub

Private Sub cmdP_Click()
On Error Resume Next
If Adodc2.Recordset.BOF Then
MsgBox "向前已经没有数据了"
Else
Adodc2.Recordset.MovePrevious
End If
Text9.Text = Adodc2.Recordset.Fields(0).Value
Text10.Text = Adodc2.Recordset.Fields(1).Value
End Sub

Private Sub CmdPrint_Click()
DataRGsWork.Show
End Sub

Private Sub cmdUp_Click()
Save_No = 2

cmdFirst.Enabled = False
cmdP.Enabled = False
cmdN.Enabled = False
cmdL.Enabled = False
cmdDel.Enabled = False
cmdUp.Enabled = False
cmdF.Enabled = False
cmd_save.Enabled = True
CmdAddItem.Enabled = False
End Sub

Private Sub Combo1_Click()
tName.Text = Combo1.Text
End Sub

Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Text1.SetFocus
End If
End Sub

Private Sub Command1_Click()
Set con1 = New ADODB.Connection
con1.ConnectionString = "provider=sqloledb;persist security info = false;user id=sa;password=;initial catalog=company;data source=WGH"
con1.Open
Set rs1 = New ADODB.Recordset
If Combo1.Text = tName.Text Then
str1 = "select * from 操作用户 where 姓名='" & Combo1.Text & "'"
Set rs1 = con1.Execute(str1)
On Error Resume Next
Text3.Text = Trim(rs1.Fields("密码"))
rs1.Close
End If
If Text1.Text = Text3.Text Then
If Trim(Text2.Text) = Trim(Text4.Text) Then
Dim sql As String
sql = "update 操作用户 set 密码='" & Text2.Text & "'where 姓名='" & Combo1.Text & "'"
con.Execute sql
MsgBox "系统接受了你的新密码。"
Else
MsgBox "两次输入的新密码不一致"
Text2.Text = ""
Text4.Text = ""
Text1.Text = ""
Exit Sub
End If
Else
MsgBox "你的旧密码不正确！"
Text2.Text = ""
Text4.Text = ""
Text1.Text = ""
End If
Text2.Text = ""
Text4.Text = ""
Text1.Text = ""
End Sub

Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
If Text6.Text = Text8.Text Then
On Error Resume Next
Adodc1.Refresh
Adodc1.Recordset.AddNew
Adodc1.Recordset.Fields(0) = Text5.Text
Adodc1.Recordset.Fields(1) = Text6.Text
Adodc1.Recordset.Update
Adodc1.Refresh
Text5.Text = ""
Text6.Text = ""
Text8.Text = ""
MsgBox "添加成功！"
Else
MsgBox "俩次输入的密码不正确！！"
End If
End Sub

Private Sub Command4_Click()
Unload Me
End Sub

Private Sub Form_Activate()
DataGrid1.Columns(0).Width = 1300
DataGrid1.Columns(1).Width = 2000
DataGrid1.Columns(2).Width = 800
End Sub

Private Sub Form_Load()
Frmsystem_main.Width = 6500
Frmsystem_main.Height = 5000
Set con = New ADODB.Connection
con.ConnectionString = "provider=sqloledb;persist security info = false;user id=sa;password=;initial catalog=company;data source=WGH"
con.Open
Set rs = New ADODB.Recordset
str = "select * from 操作用户"
rs.Open str, con, adOpenDynamic, adLockOptimistic
Frame2.Visible = False
Frame3.Visible = False
Image2.BorderStyle = 0
Text5.Text = ""
Text6.Text = ""
StatusBar1.Panels(2).Text = "www.MingRiSoft.com"
StatusBar1.Panels(3).Text = Frmsystem_main.Caption
End Sub
Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image1.BorderStyle = 0
Image2.BorderStyle = 0
Image3.BorderStyle = 0
Image4.BorderStyle = 0
End Sub
Public Sub Image1_Click()
Frame3.Width = Frame2.Width
Frame3.Height = Frame2.Height
Frame3.Left = Frame2.Left
Frame3.Top = Frame2.Top
Frame3.Visible = True
Frame2.Visible = False
Frame4.Visible = False
Frame5.Visible = False
Image1.BorderStyle = 1
Image2.BorderStyle = 0
Text5.SetFocus
StatusBar1.Panels(3).Text = Frmsystem_main.Caption + "--> " + Frame2.Caption
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image1.BorderStyle = 1
End Sub
Public Sub Image2_Click()
Frame2.Visible = True
Frame3.Visible = False
Frame4.Visible = False
Frame5.Visible = False
Image1.BorderStyle = 0
Image2.BorderStyle = 1
If add_i = 0 Then
For i = 0 To Adodc1.Recordset.RecordCount - 1  '动态装载数据库里的用户名
Combo1.AddItem Text7.Text
On Error Resume Next
Adodc1.Recordset.MoveNext
If rs.EOF Then Exit For
Next
add_i = 1
Else
End If
Combo1.Refresh
Combo1.SetFocus
StatusBar1.Panels(3).Text = Frmsystem_main.Caption + "--> " + Frame3.Caption
End Sub

Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image2.BorderStyle = 1
End Sub

Public Sub Image3_Click()
showData
cmd_save.Enabled = False
Frame4.Width = Frame2.Width
Frame4.Height = Frame2.Height
Frame4.Left = Frame2.Left
Frame4.Top = Frame2.Top
Frame2.Visible = False
Frame3.Visible = False
Frame4.Visible = True
Frame5.Visible = False

StatusBar1.Panels(3).Text = Frmsystem_main.Caption + "--> " + Frame4.Caption
End Sub
Sub showData()
On Error Resume Next
Adodc2.Recordset.MoveFirst
Text9.Text = Adodc2.Recordset.Fields(0).Value
Text10.Text = Adodc2.Recordset.Fields(1).Value
End Sub
Private Sub Image3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image3.BorderStyle = 1
End Sub

Public Sub Image4_Click()
Frame5.Width = Frame2.Width
Frame5.Height = Frame2.Height
Frame5.Left = Frame2.Left
Frame5.Top = Frame2.Top
Frame2.Visible = False
Frame3.Visible = False
Frame4.Visible = False
Frame5.Visible = True
StatusBar1.Panels(3).Text = Frmsystem_main.Caption + "--> " + Frame5.Caption
End Sub

Public Sub Image4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image4.BorderStyle = 1
End Sub

Private Sub List1_Click()

End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Text2.SetFocus
End If
End Sub

Private Sub Text10_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then cmd_save.SetFocus
End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Text4.SetFocus
End If
End Sub

Private Sub Text4_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Command1_Click
End If
End Sub

Private Sub Text5_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
If Text5.Text = "" Then
MsgBox "不能为空！"
Text5.SetFocus
Else
Text6.SetFocus
End If
End If
End Sub

Private Sub Text6_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Text8.SetFocus
End If
End Sub

Private Sub Timer1_Timer()
StatusBar1.Panels(1).Text = Format(Now)
End Sub
''''''''''''''''''''''''''''''''''''''''复制过来的
Private Sub cmdDelete_Click()
If i = 1 Then
   adoDelete.RecordSource = "select * from 公司工作项目表 where 项目编号='" & tFind.Text & "'"
   adoDelete.Refresh
   If adoDelete.Recordset.RecordCount = 0 Then
   adoDelete.Recordset.Delete
   Else
   MsgBox "你现在还不能将其删除,公司上级删除后你方可对其删除!"
   End If
Else
MsgBox "你必须先查询出结果在删除"
End If
End Sub

Private Sub cmdFind_Click()
Dim str As String
str = InputBox("输入部门编号", "按部门编号查询")
If str <> "" Then
i = 1
AdoFind.RecordSource = "select * from 部门项目表 where 部门编号='" & str & "'"
AdoFind.Refresh
tFind.Text = AdoFind.Recordset.Fields("项目编号").Value
Else
i = 0
End If
End Sub

Private Sub cmdUpdate_Click()
AdoFind.RecordSource = "select * from 部门项目表"
AdoFind.Refresh
End Sub