📄 frmmerch.frm
字号:
VERSION 5.00
Begin VB.Form frmMerch
BorderStyle = 3 'Fixed Dialog
Caption = "商品信息"
ClientHeight = 4710
ClientLeft = 2760
ClientTop = 3750
ClientWidth = 6675
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4710
ScaleWidth = 6675
ShowInTaskbar = 0 'False
Begin VB.Frame fraMerch
Caption = "商品信息"
Height = 3615
Left = 240
TabIndex = 8
Top = 240
Width = 6015
Begin VB.TextBox txtStorage
Height = 350
Left = 1080
MaxLength = 8
TabIndex = 2
Text = "txtStorage"
Top = 1230
Width = 735
End
Begin VB.ComboBox cboUnit
Height = 300
ItemData = "frmMerch.frx":0000
Left = 2280
List = "frmMerch.frx":0007
Style = 2 'Dropdown List
TabIndex = 3
Top = 1275
Width = 1335
End
Begin VB.ComboBox cboType
Height = 300
Left = 1080
Style = 2 'Dropdown List
TabIndex = 1
Top = 795
Width = 1815
End
Begin VB.TextBox txtName
Height = 350
Left = 1080
MaxLength = 18
TabIndex = 0
Text = "txtName"
Top = 270
Width = 2535
End
Begin VB.TextBox txtIntro
Height = 735
Left = 1080
MaxLength = 255
MultiLine = -1 'True
TabIndex = 4
Text = "frmMerch.frx":0012
Top = 1755
Width = 4695
End
Begin VB.TextBox txtRemark
Height = 735
Left = 1080
MaxLength = 255
MultiLine = -1 'True
TabIndex = 5
Text = "frmMerch.frx":001D
Top = 2640
Width = 4695
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "库存量"
Height = 180
Left = 240
TabIndex = 13
Top = 1320
Width = 540
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "商品类型"
Height = 180
Left = 240
TabIndex = 12
Top = 840
Width = 720
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "商品介绍"
Height = 180
Left = 240
TabIndex = 11
Top = 1800
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "商品名"
Height = 180
Left = 240
TabIndex = 10
Top = 360
Width = 540
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "备注"
Height = 180
Left = 240
TabIndex = 9
Top = 2880
Width = 360
End
End
Begin VB.CommandButton OKButton
Caption = "确定"
Height = 330
Left = 3720
TabIndex = 6
Top = 4080
Width = 1215
End
Begin VB.CommandButton CancelButton
Caption = "取消"
Height = 330
Left = 5160
TabIndex = 7
Top = 4080
Width = 1215
End
End
Attribute VB_Name = "frmMerch"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private OK As Boolean '确定用户按了OK还是CANCEL按钮
Private m_obj As clsMerch '数据对象,用来存储用户输入数据
Public m_ViewType As gxcViewType '显示状态,指添加还是修改
Private m_TypeId As Long '商品类型
'根据是“新增”还是修改,确定显示内容
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 nTypeId As Long = -1) As Boolean
'保存数据
Set m_obj = obj '用户输入数据存放于此对象中
m_ViewType = eViewType '对话框状态
If nTypeId = -1 And (Not m_obj Is Nothing) Then
m_TypeId = m_obj.TypeId
Else
m_TypeId = nTypeId
End If
'根据新增、编辑或查看设置显示内容
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
txtName.Text = .MerchName
txtStorage.Text = .Storage
cboUnit.ListIndex = 0
txtIntro.Text = .Introduce
txtRemark.Text = .Remark
For i = 0 To cboType.ListCount - 1
If cboType.ItemData(i) = m_TypeId Then
cboType.ListIndex = i '商品类型Id
Exit For
End If
Next i
End With
End If
End Sub
'检查输入有效性
Private Function CheckValid() As Boolean
If txtName.Text = "" _
Or txtIntro.Text = "" _
Or txtRemark.Text = "" Then
MsgBox "请填写完毕以上各项内容"
CheckValid = False
Exit Function
End If
If cboType.Text = "" Then
MsgBox "请填写完毕以上各项内容"
CheckValid = False
Exit Function
End If
If Not IsNumeric(txtStorage.Text) Then
MsgBox "库存量请输入数字"
Exit Function
End If
CheckValid = True
End Function
'保存数据
Private Sub SaveValue()
'给“成员变量”对象赋值
With m_obj
'注意以下利用RealString函数替换去除输入中的单引号
.MerchName = RealString(txtName.Text)
.Remark = RealString(txtRemark.Text)
.Storage = RealString(txtStorage.Text)
.Introduce = RealString(txtIntro.Text)
.TypeId = cboType.ItemData(cboType.ListIndex) '商品类型Id
.TypeName = cboType.Text
End With
End Sub
'取消按钮
Private Sub CancelButton_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim opMType As New clsOpMType
opMType.FillCombo cboType
End Sub
'确定按钮
Private Sub OKButton_Click()
OK = True
'检测输入有效性
If Not CheckValid Then Exit Sub
'如果是新增状态,则初始化一个数据对象
If m_ViewType = vtadd Then Set m_obj = New clsMerch
'保存用户输入
SaveValue
Me.Hide
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -