📄 frm_in.frm
字号:
Key = "close"
ImageIndex = 7
EndProperty
EndProperty
BorderStyle = 1
End
Begin VB.Label Lbl_info
Caption = "Lbl_info"
ForeColor = &H00C00000&
Height = 315
Left = 0
TabIndex = 11
Top = 4395
Width = 3840
End
End
Attribute VB_Name = "frm_in"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Prices As Single '定义一个计算价格的变量
Dim i As Integer '运用在FOR循环中的变量
Dim StrTemp '用于显示编号信息的变量
Dim StrNum As Long '用于显示编号信息的变量
Dim ETemp As Integer '定义一个日志标识变量
Dim MyFlag As Boolean '定义变量用来存储标识
Private Sub MyAdd()
Call MyClear
Adodc1.RecordSource = "select * from tb_in order by ID"
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then
Adodc1.Recordset.MoveLast '将数据库记录移向最后一条
StrNum = Val(Adodc1.Recordset.Fields("ID")) + 1 '将入库编号加1
Select Case Len(Trim(StrNum)) '位数不足则补0
Case 1
StrTemp = "00000"
Case 2
StrTemp = "0000"
Case 3
StrTemp = "000"
Case 4
StrTemp = "00"
Case 5
StrTemp = "0"
Case 6
StrTemp = ""
End Select
Text1(0).Text = "J" & Trim(StrTemp) & Trim(Str(StrNum))
Else
Text1(0).Text = "J000001" 'Join的缩写 "加入的意思"，给入库编号赋一个初值
StrNum = 1
End If
Text2.SetFocus
End Sub
Private Sub MyDel()
rtn = SetWindowPos(Me.hwnd, -2, 0, 0, 0, 0, 3) '运用API函数SetWindowPos，来实现取消窗体置前的功能
If Adodc1.Recordset.EOF = False Then
c = MsgBox("您确认要删除该记录吗?", 17)
If c = vbOK Then
Adodc1.Recordset.Delete '删除入库信息
Adodc1.Refresh
Call Main
adoRs.Open "select * from tb_KCXX where KC_name='" + Text1(1).Text + "' and KC_SPEC='" + Text1(2).Text + "' and KC_UNIT ='" + Combo1.Text + "' and KC_Price=" & Val(Text1(4).Text) & "", adoCon, adOpenKeyset
If adoRs.RecordCount > 0 Then
Dim SNum As Integer
'重新计算库存货品的数量
SNum = Val(adoRs.Fields("KC_Num")) - Val(Text1(3).Text)
'修改该货品的库存数量
Set adoRs = adoCon.Execute("UPDATE tb_KCXX SET KC_Num='" + Str(SNum) + "' where KC_name='" + Text1(1).Text + "' and KC_SPEC='" + Text1(2).Text + "' and KC_UNIT ='" + Combo1.Text + "' and KC_Price=" & Val(Text1(4).Text) & "")
End If
adoCon.Close
ETemp = 1 '设置删除标识
Call joinRZ '调用添加日志过程
For i = 0 To 5 '清空文本框中的内容
Text1(i).Text = ""
Next i
End If
Else
MsgBox "当前数据库中已经没有可删除的记录", 64
End If
Call TRefresh
End Sub
Private Sub MySave()
rtn = SetWindowPos(Me.hwnd, -2, 0, 0, 0, 0, 3) '运用API函数SetWindowPos，来实现取消窗体置前的功能
Adodc1.RecordSource = "select * from tb_in where ID=" + Trim(Str(StrNum)) + "" '判断所保存的信息在数据库中是否已经存在
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then
MsgBox "该信息已经存在,信息保存不成功", 64
Call TRefresh '调用数据刷新过程
Else
c = MsgBox("您确认要保存该信息吗?", 33)
If c = vbOK Then
'限制输入的部分信息不能为空值
If Text1(1).Text = "" Or Text1(3).Text = "" Or Text1(4).Text = "" Then
MsgBox "货品数量、单价或名称不能为空值!", 48
Else
If Not IsNumeric(Text1(3).Text) Or Not IsNumeric(Text1(4).Text) Then
MsgBox "输入的货品数量或单价必须为数值型数据", 48
Else
Call Main '调用公共模块中的连接数据库过程
NumId = Val(Mid(Text1(0).Text, 2, Len(Text1(0).Text)))
Prices = Val(Text1(3).Text) * Val(Text1(4).Text)
'保存货品入库信息
Set adoRs = adoCon.Execute("insert into tb_IN (ID,IN_NumID,IN_Name,IN_gysid,IN_gysname,IN_SPEC,IN_UNIT,IN_Num,IN_Price,IN_Money,IN_Date,IN_year,IN_Month,IN_People,IN_Remark) values(" & StrNum & ",'" & Text1(0).Text & "','" & Text1(1).Text & "','" & Text2.Text & "','" & Text3.Text & "','" & Text1(2).Text & "','" & Combo1.Text & "','" & Text1(3).Text & "','" & Text1(4).Text & "'," & Prices & ",'" & Str(DTPicker1.Value) & "','" & Trim(Str(DTPicker1.Year)) & "','" & Trim(Str(DTPicker1.Month)) & "','" & Name1 & "','" & Text1(5).Text & "')")
'保存货品入库库存信息
'利用对象打开与操纵数据表
adoRs.Open "select * from tb_KCXX where KC_name='" + Text1(1).Text + "' and KC_SPEC='" + Text1(2).Text + "' and KC_UNIT ='" + Combo1.Text + "' and KC_Price=" & Val(Text1(4).Text) & "", adoCon, adOpenKeyset
If adoRs.RecordCount > 0 Then
Dim SNum As Integer
'重新计算库存货品的数量
SNum = Val(adoRs.Fields("KC_Num")) + Val(Text1(3).Text)
'修改该货品的库存数量
Set adoRs = adoCon.Execute("UPDATE tb_KCXX SET KC_Num='" + Str(SNum) + "' where KC_name='" + Text1(1).Text + "' and KC_SPEC='" + Text1(2).Text + "' and KC_UNIT ='" + Combo1.Text + "' and KC_Price=" & Val(Text1(4).Text) & "")
Else
Adodc1.RecordSource = "select * from tb_kcxx order by KC_ID"
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then
Adodc1.Recordset.MoveLast
StrNum = Val(Adodc1.Recordset.Fields("KC_ID")) + 1
'如果库存中没有该货品的信息，则将入库货品信息保存到库存当中
Set adoRs = adoCon.Execute("insert into tb_KCXX values(" & StrNum & ",'" & Text1(0).Text & "','" & Text1(1).Text & "','" & Text1(2).Text & "','" & Combo1.Text & "','" & Text1(3).Text & "','" & Text1(4).Text & "','" & Str(DTPicker1.Value) & "','')")
Else
StrNum = 1
'如果库存中没有记录，则将入库货品信息保存到库存当中
Set adoRs = adoCon.Execute("insert into tb_KCXX values(" & StrNum & ",'" & Text1(0).Text & "','" & Text1(1).Text & "','" & Text1(2).Text & "','" & Combo1.Text & "','" & Text1(3).Text & "','" & Text1(4).Text & "','" & Str(DTPicker1.Value) & "','')")
End If
End If
ETemp = 0 '设置标识为零，对库存表进行修改
Call joinRZ
MsgBox "信息保存成功", 64
Call TRefresh '调用数据刷新过程
adoCon.Close
End If
End If
End If
End If
Call TRefresh '调用数据刷新过程
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then '如果按下的是回车键，则光标落到文本框当中
Text1(3).SetFocus
End If
End Sub
Private Sub DataGrid1_Click()
If MyFlag = False Then
Call JionBack '调用数据反绑定过程
If Adodc1.Recordset.RecordCount > 0 Then
Temps = Adodc1.Recordset.Fields("IN_Num")
End If
End If
End Sub
Private Sub DTPicker1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then '如果按下的是回车键，则光标落到文本框当中
Text1(5).SetFocus
End If
End Sub
Private Sub Form_Load()
rtn = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3) '运用API函数SetWindowPos，来实现使窗体置前的功能
'使用代码连接数据库
Adodc1.ConnectionString = CnnStr
Adodc1.RecordSource = "select * from tb_in" '连接货品入库数据表
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
Me.Left = (Screen.Width - Me.Width) / 2 '使窗体居中
Me.Top = (Screen.Height - Me.Height) / 2
DTPicker1.Value = Date '在窗体启动的时候，使日期控件中的值为当前系统的日期时间
tlbState Toolbar1, False
End Sub
Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
If Index = 1 Then
Text1(2).SetFocus
ElseIf Index = 2 Then
Combo1.SetFocus
ElseIf Index = 3 Then
Text1(4).SetFocus
ElseIf Index = 4 Then
DTPicker1.SetFocus
ElseIf Index = 5 Then
Exit Sub
End If
End If
End Sub
Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
rtn = SetWindowPos(Me.hwnd, -2, 0, 0, 0, 0, 3) '运用API函数SetWindowPos，来实现取消窗体置前的功能
If KeyCode = 13 Then
frm_Tgysxx.Show '如果按下回车键，调用frm_Tgysxx窗体
frm_Tgysxx.Left = 3800
frm_Tgysxx.Top = 2300
frm_Tgysxx.DataGrid1.SetFocus
End If
End Sub
Private Sub Timer1_Timer() '通过时钟控件随时检测数据库中记录的条数
If Adodc1.Recordset.RecordCount > 0 Then
Lbl_info.Caption = "目前数据库中共有 " & Adodc1.Recordset.RecordCount & " 条入库数据"
End If
End Sub
Private Sub JionBack()
Dim SLen As Integer
If Adodc1.Recordset.RecordCount > 0 Then
StrNum = Val(Adodc1.Recordset.Fields("IN_NumID"))
'Len函数用于取字符串的长度，Trim函数用于去除字符串中的空格
SLen = Len(Trim(StrNum))
Select Case SLen '位数不足者补0
Case 1
StrTemp = "00000"
Case 2
StrTemp = "0000"
Case 3
StrTemp = "000"
Case 4
StrTemp = "00"
Case 5
StrTemp = "0"
Case 6
StrTemp = ""
End Select
On Error Resume Next '执行错误处理
Text1(0).Text = Adodc1.Recordset(1) '将数据信息赋值到文本框当中
Text1(1).Text = Adodc1.Recordset(2)
Text2.Text = Adodc1.Recordset(3)
Text3.Text = Adodc1.Recordset(4)
Text1(2).Text = Adodc1.Recordset(5)
Combo1.Text = Adodc1.Recordset(6)
Text1(3).Text = Adodc1.Recordset(7)
Text1(4).Text = Adodc1.Recordset(8)
DTPicker1.Value = Adodc1.Recordset(10)
Text1(5).Text = Adodc1.Recordset("IN_Remark")
End If
End Sub
Private Sub TRefresh()
Adodc1.RecordSource = "select * from tb_in order by IN_NumID"
Adodc1.Refresh
End Sub
Private Sub joinRZ()
Open (App.Path & "\系统日志.ini") For Input As #1
Do While Not EOF(1)
Line Input #1, Intext
TStr = TStr + Intext + Chr(13) + Chr(10)
Loop
Close #1
If ETemp = 0 Then '添加修改信息日志
TStr = TStr + " " + Name1 + " " + Format(Now, "yyyy-mm-dd hh:mm:ss") + " " + "修改票号 " + Text1(0).Text + "(" + Text1(1).Text + ")" + Chr(13) + Chr(10)
ElseIf ETemp = 1 Then '添加删除信息日志
TStr = TStr + " " + Name1 + " " + Format(Now, "yyyy-mm-dd hh:mm:ss") + " " + "删除票号 " + Text1(0).Text + "(" + Text1(1).Text + ")" + Chr(13) + Chr(10)
End If
Open (App.Path & "\系统日志.ini") For Output As #1 '将日志信息保存到文件当中
Print #1, TStr
Close #1
End Sub
Private Sub Form_Unload(Cancel As Integer)
frm_main.Enabled = True
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.key
Case "add" '添加
tlbState Toolbar1, True
MyFlag = True
Call MyAdd
Case "delete" '删除
Call MyDel
MyFlag = False
Case "save" '保存
If Text2.Text = "" Or Text3.Text = "" Then
MsgBox "供应商编号或供应商名称不能为空！", vbInformation
Text2.SetFocus
Exit Sub
End If
Call MySave
tlbState Toolbar1, False
MyFlag = False
Case "cancel" ' 取消
tlbState Toolbar1, False
Call MyClear
MyFlag = False
Case "find" ' 查询
Mystr = InputBox("请输入要查询的货品名称", "企业进销存管理系统", "J000001")
Adodc1.RecordSource = "select * from tb_in where in_numid ='" + Mystr + "'"
Adodc1.Refresh
Call JionBack
Adodc1.RecordSource = "select * from tb_in"
Adodc1.Refresh
MyFlag = False
Case "close" '关闭
Unload Me
End Select
End Sub
'定义设置Toolbar控件上按钮状态的函数
Public Function tlbState(tlb As Toolbar, state As Boolean)
With tlb
If state = True Then '如果状态变量为True
.Buttons(1).Enabled = False
.Buttons(2).Enabled = False
.Buttons(3).Enabled = False
.Buttons(6).Enabled = False
.Buttons(4).Enabled = True
.Buttons(5).Enabled = True
Else '如果状态变量为False
.Buttons(1).Enabled = True
.Buttons(2).Enabled = True
.Buttons(3).Enabled = True
.Buttons(6).Enabled = True
.Buttons(4).Enabled = False
.Buttons(5).Enabled = False
End If
End With
End Function
Private Sub MyClear()
For i = 0 To 5 '单击“添加”按钮之后，清空文本框中的内容
Text1(i).Text = ""
Next i
Combo1.Text = ""
DTPicker1.Value = Date
Text2.Text = ""
Text3.Text = ""
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -