📄 frmbuy.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmBuy
BorderStyle = 3 'Fixed Dialog
Caption = "进货信息"
ClientHeight = 5610
ClientLeft = 2760
ClientTop = 3750
ClientWidth = 6615
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5610
ScaleWidth = 6615
ShowInTaskbar = 0 'False
Begin VB.Frame fraBuy
Caption = "进货信息"
Height = 4695
Left = 240
TabIndex = 11
Top = 120
Width = 6015
Begin VB.ComboBox cboMerchName
Height = 300
Left = 1200
Style = 2 'Dropdown List
TabIndex = 0
Top = 300
Width = 1815
End
Begin VB.TextBox txtCount
Height = 350
Left = 1200
MaxLength = 8
TabIndex = 5
Text = "txtCount"
Top = 2640
Width = 1335
End
Begin VB.ComboBox cboUnit
Height = 300
ItemData = "frmBuy.frx":0000
Left = 2760
List = "frmBuy.frx":0007
Style = 2 'Dropdown List
TabIndex = 6
Top = 2665
Width = 1335
End
Begin MSComCtl2.DTPicker dtpBuyDate
Height = 345
Left = 1200
TabIndex = 2
Top = 1210
Width = 1815
_ExtentX = 3201
_ExtentY = 609
_Version = 393216
Format = 60030977
CurrentDate = 38263
End
Begin VB.TextBox txtPrice
Height = 350
Left = 1200
MaxLength = 8
TabIndex = 7
Text = "txtPrice"
Top = 3155
Width = 1335
End
Begin VB.TextBox txtConsignee
Height = 350
Left = 1200
MaxLength = 18
TabIndex = 4
Text = "txtConsignee"
Top = 2195
Width = 2535
End
Begin VB.TextBox txtRemark
Height = 735
Left = 1200
MultiLine = -1 'True
TabIndex = 8
Text = "frmBuy.frx":0012
Top = 3720
Width = 4695
End
Begin VB.TextBox txtDeliver
Height = 350
Left = 1200
MaxLength = 20
TabIndex = 3
Text = "txtDeliver"
Top = 1700
Width = 2535
End
Begin VB.ComboBox cboProvider
Height = 300
Left = 1200
Style = 2 'Dropdown List
TabIndex = 1
Top = 765
Width = 1815
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "(人民币)"
Height = 180
Left = 2760
TabIndex = 20
Top = 3240
Width = 900
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "购入单价"
Height = 180
Left = 240
TabIndex = 19
Top = 3240
Width = 720
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "购入数量"
Height = 180
Left = 240
TabIndex = 18
Top = 2760
Width = 720
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "经手人姓名"
Height = 180
Left = 240
TabIndex = 17
Top = 2280
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "备注"
Height = 180
Left = 240
TabIndex = 16
Top = 3840
Width = 360
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "购买商品"
Height = 180
Left = 240
TabIndex = 15
Top = 360
Width = 720
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "送货人姓名"
Height = 180
Left = 240
TabIndex = 14
Top = 1800
Width = 900
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "供应商"
Height = 180
Left = 240
TabIndex = 13
Top = 840
Width = 540
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "进货时间"
Height = 180
Left = 240
TabIndex = 12
Top = 1320
Width = 720
End
End
Begin VB.CommandButton OKButton
Caption = "确定"
Height = 330
Left = 3480
TabIndex = 9
Top = 5040
Width = 1215
End
Begin VB.CommandButton CancelButton
Caption = "取消"
Height = 330
Left = 4920
TabIndex = 10
Top = 5040
Width = 1215
End
End
Attribute VB_Name = "frmBuy"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private OK As Boolean '确定用户按了OK还是CANCEL按钮
Public m_ViewType As gxcViewType '显示状态,指添加还是修改
Private m_obj As clsBuy '数据对象,用来存储用户输入数据
Private m_Account As String '调用此对话框的操作员
'根据是“新增”还是修改,确定显示内容
Private Sub SetStatus()
'设置控件默认值
Call SetDefaultValue
'设置状态
Select Case m_ViewType
Case vtadd '添加
CancelButton.Visible = True
OKButton.Caption = "确定"
Case vtModify '修改
CancelButton.Visible = True
OKButton.Caption = "保存"
End Select
End Sub
'打开对话框,并传出用户输入数据
Public Function ShowDlg(ByRef obj As Object, _
ByVal eViewType As gxcViewType, _
Optional strUser As String = "") As Boolean
'保存数据
Set m_obj = obj '用户输入数据存放于此对象中
m_ViewType = eViewType '对话框状态
m_Account = strUser '调用此对话框的用户账号
'根据新增、编辑或查看设置显示内容
SetStatus
'显示对话框
OK = False
Me.Show vbModal
If OK = False Then
ShowDlg = False
Exit Function
End If
'保存数据
Set obj = m_obj
'返回并释放对话框
ShowDlg = True
Unload Me
End Function
'设置控件默认值
Private Sub SetDefaultValue()
Dim ctl As Control
Dim i As Integer
'如果是新增,则清空所有文本框
'此处判断 m_obj为空与判断m_ViewType = vtAdd等效,但更安全
If m_obj Is Nothing Then
For Each ctl In Controls
If TypeOf ctl Is TextBox Then
ctl.Text = ""
End If
Next
Else '用传入对象的值更新数据
With m_obj
txtDeliver.Text = .Deliver
txtConsignee.Text = .Consignee
cboUnit.ListIndex = 0
txtCount.Text = .Count
txtPrice.Text = .StockPrice
txtRemark.Text = .Remark
dtpBuyDate.Value = .StockDate
' 选择商品
For i = 0 To cboMerchName.ListCount - 1
If cboMerchName.ItemData(i) = .MerchandiseID Then
cboMerchName.ListIndex = i '商品Id
Exit For
End If
Next i
'选择供应商
For i = 0 To cboProvider.ListCount - 1
If cboProvider.ItemData(i) = .ProviderId Then
cboProvider.ListIndex = i '供应商Id
Exit For
End If
Next i
End With
End If
End Sub
'检查输入有效性
Private Function CheckValid() As Boolean
CheckValid = False
If txtDeliver.Text = "" _
Or txtConsignee.Text = "" _
Or txtCount.Text = "" _
Or txtPrice.Text = "" _
Or cboMerchName.Text = "" _
Or cboProvider.Text = "" _
Or txtRemark.Text = "" Then
MsgBox "请填写完毕以上各项内容"
Exit Function
End If
If Not IsNumeric(txtPrice.Text) Then
MsgBox "价格请输入数字"
Exit Function
End If
If Not IsNumeric(txtCount.Text) Then
MsgBox "数量请输入数字"
Exit Function
End If
If Not IsDate(dtpBuyDate.Value) Then
MsgBox "请输入正确的日期格式"
Exit Function
End If
CheckValid = True
End Function
'保存数据
Private Sub SaveValue()
'给“成员变量”对象赋值
With m_obj
'注意以下利用RealString函数替换去除输入中的单引号
.Deliver = RealString(txtDeliver.Text)
.Consignee = RealString(txtConsignee.Text)
.Count = txtCount.Text
.StockPrice = txtPrice.Text
.StockDate = dtpBuyDate.Value
.Remark = RealString(txtRemark.Text)
.MerchandiseID = cboMerchName.ItemData(cboMerchName.ListIndex)
.MerchName = cboMerchName.Text
.ProviderId = cboProvider.ItemData(cboProvider.ListIndex)
.ProviderName = cboProvider.Text
.OperatorId = m_Account '操作者账号
End With
End Sub
'取消按钮
Private Sub CancelButton_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim opMerch As New clsOpMerch
Dim opProvider As New clsOpProvider
opMerch.FillCombo cboMerchName
opProvider.FillCombo cboProvider
End Sub
'确定按钮
Private Sub OKButton_Click()
OK = True
'检测输入有效性
If Not CheckValid Then Exit Sub
'如果是新增状态,则初始化一个数据对象
If m_ViewType = vtadd Then Set m_obj = New clsBuy
'保存用户输入
SaveValue
Me.Hide
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -