📄 frm_hpin.frm
字号:
End
Begin VB.Label Label10
Caption = "还货人"
Height = 300
Left = 5205
TabIndex = 23
Top = 5145
Width = 750
End
Begin VB.Label Label9
ForeColor = &H00C00000&
Height = 315
Left = 75
TabIndex = 22
Top = 5160
Width = 3840
End
End
Attribute VB_Name = "frm_hpin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i As Integer '运用在FOR循环中的变量
Dim StrTemp '用于显示编号信息的变量
Dim StrNum As Long '用于显示编号信息的变量
Dim ETemp As Integer '定义一个日志标识变量
Dim SNum As Integer '用于修改库存数量的变量
Dim Snums As Integer '用于计算未还数量的变量
'*** “添加”货品归还信息按钮的事件过程 ***
Private Sub Cmd_Add_Click()
For i = 0 To 5
Text1(i).Text = ""
Next i
Adodc1.RecordSource = "select * from tb_hpin order by P_ID"
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then
Adodc1.Recordset.MoveLast '将记录移向最后一条
StrNum = Val(Mid(Adodc1.Recordset.Fields("P_ID"), 3, Len(Adodc1.Recordset.Fields("P_ID")))) + 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 = "GH" & Trim(StrTemp) & Trim(Str(StrNum))
Else
Text1(0).Text = "GH000001" '如果数据库中没有记录则给货品归还编号赋一初值
StrNum = 1
End If
Text1(1).SetFocus
Cmd_Save.Enabled = True
End Sub
Private Sub Cmd_exit_Click()
Unload Me
End Sub
'*** “保存”货品归还信息按钮的事件过程 ***
Private Sub Cmd_save_Click()
rtn = SetWindowPos(Me.hwnd, -2, 0, 0, 0, 0, 3) '运用API函数SetWindowPos，来实现取消窗体置前的功能
Adodc1.RecordSource = "select * from tb_hpin where P_ID='" + Text1(0) + "'" '判断所要保存的信息在数据库中是否已经存在
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 = "" Or Text2.Text = "" Then
MsgBox "还货人信息、货品数量、单价或名称不能为空值!", 48, "保存信息提示"
Else
'IsNumeric函数是用于判断输入的数值是否为数值型数据的函数，关于该函数的具体用法请参阅明日公司《Visual Basic编程词典》中的函数应用部分 网址 www.cccxy.com
If Not IsNumeric(Text1(3).Text) Or Not IsNumeric(Text1(4).Text) Then '强制转换输入的信息为数值型数据
MsgBox "输入的货品数量或单价必须为数值型数据", 48, "保存信息提示"
Else
Call main '调用公共模块连接数据库函数
adoRs.Open "select * from tb_KCXX where KC_ids='" + Text1(2).Text + "'", adoCon, adOpenKeyset, adLockOptimistic
If adoRs.RecordCount > 0 Then
Adodc1.RecordSource = "select * from tb_hpout where P_id='" + Text1(1) + "'"
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then
'计算借出货品的未还数量
Snums = Val(Adodc1.Recordset.Fields("p_num")) - Val(Text1(3).Text)
Dim Moneys As Single
Moneys = Val(Snums) * Val(Adodc1.Recordset.Fields("P_Price"))
If Val(Adodc1.Recordset.Fields("P_Num")) >= Val(Text1(3).Text) Then '判断归还货品的数量是否大于借出货品的数量
SNum = Val(adoRs.Fields("KC_Num")) + Val(Text1(3).Text) '计算归还货品的库存数量
'下面语句当中所用到函数的具体用法请参阅明日公司《Visual Basic编程词典》中的函数应用部分 网址 www.cccxy.com
NumId = Val(Mid(Text1(0).Text, 2, Len(Text1(0).Text)))
'保存货品归还信息
Set adoRs = adoCon.Execute("insert into tb_hpin (id,P_ID,P_jhid,P_ids,P_name,P_Num,P_nonum,P_Date,P_hhr,P_People,P_Remark) values(" & StrNum & ",'" & Text1(0).Text & "','" & Text1(1).Text & "','" & Text1(2).Text & "','" & Text3.Text & "','" & Text1(3).Text & "','" & Snums & "','" & Str(DTPicker1.Value) & "','" & Text2.Text & "','" & Name1 & "','" & Text1(5).Text & "')")
'修改归还货品的库存数量信息
Set adoRs = adoCon.Execute("UPDATE tb_KCXX SET KC_Num='" + Str(SNum) + "' where KC_ids='" + Text1(2).Text + "'")
'修改归还货品的借出数据表中的数量信息
Set adoRs = adoCon.Execute("UPDATE tb_hpout SET p_Num='" + Str(Snums) + "',P_Money='" + Str(Moneys) + "' where p_id='" + Text1(1).Text + "'")
MsgBox "信息保存成功", 64, "保存信息提示"
Cmd_Save.Enabled = False
Else
Dim Strs As String
Strs = "该货品的借出数量为 " & adoRs.Fields("kc_num") & " ,货品归还数量不应大于其借出的数量"
MsgBox Strs, 48, "提示信息"
End If
End If
End If
adoCon.Close '关闭数据连接
End If
End If
Else
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()
Call JionBack
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 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db_kcgl.mdb;Persist Security Info=False"
Adodc1.RecordSource = "select * from tb_hpin" '连接货品归还数据表
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
Me.Left = (Screen.Width - Me.Width) / 2 '使窗体居中
Me.Top = (Screen.Height - Me.Height) / 2
DTPicker1.Value = Date
End Sub
Private Sub Text1_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
If Index = 1 Then '如果光标落在第二个文本框当中，则调用frm_JTout窗体
frm_JTout.Show
frm_JTout.Left = 4100
frm_JTout.Top = 2750
frm_JTout.DataGrid1.SetFocus '使光标直接落在frm_JTout窗体的DataGrid1控件上
ElseIf Index = 2 Then
Combo1.SetFocus
ElseIf Index = 3 Then
Adodc1.RecordSource = "select * from tb_hpout where P_id='" + Text1(1) + "'"
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then
'计算货品未还数量
Text1(4).Text = Val(Adodc1.Recordset.Fields("p_num")) - Val(Text1(3).Text)
End If
Text1(4).SetFocus
ElseIf Index = 4 Then
DTPicker1.SetFocus
ElseIf Index = 5 Then
Text2.SetFocus
End If
End If
End Sub
'《Visual Basic编程词典》软件是由吉林省明日科技有限公司开发的面向程序员和编程爱好者的技术最全、案例最多和使用最方便的Visual Basic编程技术词典。它包含30个实际项目的开发过程和源码（每月新增加一个实际开发项目）；最完整、最全面、最实用的函数、控件和基础技术大全；上千个编程技巧和几百个典型实例；同时还提供了编程中所需的各种素材和资源。价值无限，服务无限。技术服务及升级请访问www.cccxy.com , 电话：（0431）4978981,4978982
'《Visual Basic编程词典》软件源码项目部分对所有代码都作了详细的注释和说明，同时提供了所有源码项目详尽、完整的开发过程文档和录像。技术支持及升级请访问www.cccxy.com 电话：（0431）4978981,4978982
'《Visual Basic编程词典》对所有实例的开发过程和设计思路都作了详细的介绍。技术支持及升级请访问www.cccxy.com 电话：（0431）4978981,4978982
'如果您在使用《Visual Basic编程词典》中有疑问或好的建议，请访问我公司"编程词典"技术服务网站www.cccxy.com或拨打我公司电话（0431-4978981，4978982），我们愿为广大编程者提供最好的产品和最佳的服务。对于提出好的建议的读者，我们将给与奖励，详情请访问www.cccxy.com。
'*** 自定义数据反绑定过程 ***
Private Sub JionBack()
On Error Resume Next
Dim SLen As Integer
If Adodc1.Recordset.RecordCount > 0 Then
StrNum = Val(Adodc1.Recordset.Fields("P_ID"))
'Len函数用于取字符串的长度，Trim函数用于去除字符串中的空格，关于这两个函数的具体用法请参阅明日公司《Visual Basic 编程词典》中的函数应用部分 网址 www.cccxy.com
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)
Text1(2).Text = Adodc1.Recordset(3)
Text3.Text = Adodc1.Recordset(4)
Text1(3).Text = Adodc1.Recordset(5)
Text1(4).Text = Adodc1.Recordset(6)
DTPicker1.Value = Adodc1.Recordset(8)
Text1(5).Text = Adodc1.Recordset("P_Remark")
Text2.Text = Adodc1.Recordset("P_hhr")
End If
End Sub
'*** 自定义数据刷新过程 ***
Private Sub TRefresh()
Adodc1.RecordSource = "select * from tb_hpin order by P_ID"
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 + "(" + Text3.Text + ")" + Chr(13) + Chr(10)
ElseIf ETemp = 1 Then '添加删除信息日志
TStr = TStr + " " + Name1 + " " + Format(Now, "yyyy-mm-dd hh:mm:ss") + " " + "删除票号 " + Text1(0).Text + "(" + Text3.Text + ")" + Chr(13) + Chr(10)
End If
Open (App.Path & "\系统日志.ini") For Output As #1 '将日志信息保存到文件当中
Print #1, TStr
Close #1
End Sub
Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Call Cmd_save_Click '调用保存“按钮”的单击事件
Cmd_Add.SetFocus '将光标放置在“添加”按钮当中
End If
End Sub
Private Sub Timer1_Timer() '通过时钟控件随时检测数据库中记录的条数
If Adodc1.Recordset.RecordCount > 0 Then
Label9.Caption = "目前数据库中共有 " & Adodc1.Recordset.RecordCount & " 条归还货品数据"
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
frm_main.Enabled = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -