Long=-1,_
OptionalstrUserAsString="")AsBoolean
'保存数据
Setm_obj=obj'用户输入数据存放于此对象中
m_ViewType=eViewType'对话框状态
IfnTypeId=-1And(Notm_objIsNothing)Then
m_TypeId=m_obj.TypeId
Else
m_TypeId=nTypeId
EndIf
m_Account=strUser'调用此对话框的用户账号
'根据新增、编辑或查看设置显示内容
SetStatus
'显示对话框
OK=False
Me.ShowvbModal
IfOK=FalseThen
ShowDlg=False
ExitFunction
EndIf
'保存数据
Setobj=m_obj
'返回并释放对话框
ShowDlg=True
UnloadMe
EndFunction
'设置控件默认值
PrivateSubSetDefaultValue()
DimctlAsControl
DimiAsInteger
'如果是新增,则清空所有文本框
'此处判断m_obj为空与判断m_ViewType=vtAdd等效,但更安全
Ifm_objIsNothingThen
ForEachctlInControls
IfTypeOfctlIsTextBoxThen
ctl.Text=""
EndIf
Next
Else'用传入对象的值更新数据
Withm_obj
txtCount.Text=.Count
txtReason.Text=.Reason
txtRemark.Text=.Remark
cboUnit.ListIndex=0
dtpRegDate.Value=.RegDate
Fori=0TocboMerchName.ListCount-1
IfcboMerchName.ItemData(i)=.MerchandiseIDThen
cboMerchName.ListIndex=i'客户类型Id
ExitFor
EndIf
Nexti
EndWith
EndIf
EndSub
'检查输入有效性
PrivateFunctionCheckValid()AsBoolean
CheckValid=False
IftxtCount.Text=""_
OrtxtReason.Text=""_
OrtxtRemark.Text=""Then
MsgBox"请填写完毕以上各项内容"
ExitFunction
EndIf
IfcboMerchName.Text=""Then
MsgBox"请填写完毕以上各项内容"
ExitFunction
EndIf
IfNotIsNumeric(txtCount.Text)Then
MsgBox"数量请输入数字"
ExitFunction
EndIf
IfNotIsDate(dtpRegDate.Value)Then
MsgBox"请输入正确的日期格式"
ExitFunction
EndIf
CheckValid=True
EndFunction
'保存数据
PrivateSubSaveValue()
'给"成员变量"对象赋值
Withm_obj
'注意以下利用RealString函数替换去除输入中的单引号
.Count=txtCount.Text
.Reason=RealString(txtReason.Text)
.Remark=RealString(txtRemark.Text)
.MerchandiseID=cboMerchName.ItemData(cboMerchName.ListIndex)'商品类型Id
.MerchName=cboMerchName.Text
.RegDate=dtpRegDate.Value
.OperatorId=m_Account'操作者账号
EndWith
EndSub
'取消按钮
PrivateSubCancelButton_Click()
UnloadMe
EndSub
PrivateSubForm_Load()
DimopMerchAsNewclsOpMerch
opMerch.FillCombocboMerchName
EndSub
'确定按钮
PrivateSubOKButton_Click()
OK=True
'检测输入有效性
IfNotCheckValidThenExitSub
'如果是新增状态,则初始化一个数据对象
Ifm_ViewType=vtaddThenSetm_obj=NewclsDispose
'保存用户输入
SaveValue
Me.Hide
EndSub
3:供应商表:
代码分析:
OptionExplicit
PrivateOKAsBoolean'确定用户按了OK还是CANCEL按钮
Privatem_objAsclsProvider'数据对象,用来存储用户输入数据
Publicm_ViewTypeAsgxcViewType'显示状态,指添加还是修改
'根据是"新增"还是修改,确定显示内容
PrivateSubSetStatus()
'设置控件默认值
CallSetDefaultValue
'设置状态
SelectCasem_ViewType
Casevtadd'添加
CancelButton.Visible=True
OKButton.Caption="确定"
CasevtModify'修改
CancelButton.Visible=True
OKButton.Caption="保存"
CasevtInfo'查看
CancelButton.Visible=False
OKButton.Caption="关闭"
EndSelect
EndSub
'打开对话框,并传出用户输入数据
PublicFunctionShowDlg(ByRefobjAsObject,_
ByValeViewTypeAsgxcViewType)AsBoolean
'保存数据
Setm_obj=obj'用户输入数据存放于此对象中
m_ViewType=eViewType'对话框状态
'根据新增、编辑或查看设置显示内容
SetStatus
'显示对话框
OK=False
Me.ShowvbModal
IfOK=FalseThen
ShowDlg=False
ExitFunction
EndIf
'保存数据
Setobj=m_obj
'返回并释放对话框
ShowDlg=True
UnloadMe
EndFunction
'设置控件默认值
PrivateSubSetDefaultValue()
DimctlAsControl
DimiAsInteger
'如果是新增,则清空所有文本框
'此处判断m_obj为空与判断m_ViewType=vtAdd等效,但更安全
Ifm_objIsNothingThen
ForEachctlInControls
IfTypeOfctlIsTextBoxThen
ctl.Text=""
EndIf
Next
Else'用传入对象的值更新数据
Withm_obj
txtName.Text=.ProviderName
txtIntro.Text=.Introduce
txtRemark.Text=.Remark
EndWith
EndIf
EndSub
'检查输入有效性
PrivateFunctionCheckValid()AsBoolean
IftxtName.Text=""_
OrtxtIntro.Text=""_
OrtxtRemark.Text=""Then
MsgBox"请填写完毕以上各项内容"
CheckValid=False
ExitFunction
EndIf
CheckValid=True
EndFunction
'保存数据
PrivateSubSaveValue()
'给"成员变量"对象赋值
Withm_obj
'注意以下利用RealString函数替换去除输入中的单引号
.ProviderName=RealString(txtName.Text)
.Introduce=RealString(txtIntro.Text)
.Remark=RealString(txtRemark.Text)
EndWith
EndSub
'取消按钮
PrivateSubCancelButton_Click()
UnloadMe
EndSub
'确定按钮
PrivateSubOKButton_Click()
OK=True
'检测输入有效性
IfNotCheckValidThenExitSub
'如果是新增状态,则初始化一个数据对象
Ifm_ViewType=vtaddThenSetm_obj=NewclsProvider
'保存用户输入
SaveValue
Me.Hide
EndSub
5:管理员列表:
代码分析:
OptionExplicit
DimopAdminAsNewclsOpAdmin
PrivateSubCancelButton_Click()
UnloadMe
EndSub
PrivateSubcmdAdd_Click()
opAdmin.AddlvAdmin
EndSub
PrivateSubcmdDel_Click()
opAdmin.DeletelvAdmin
EndSub
PrivateSubcmdModify_Click()
opAdmin.ModifylvAdmin
EndSub
PrivateSubForm_Load()
opAdmin.FillListViewlvAdmin
EndSub
6:主界面设计:
代码分析:
OptionExplicit
ConstNAME_COLUMN=0
ConstTYPE_COLUMN=1
ConstSIZE_COLUMN=2
ConstDATE_COLUMN=3
DimmbMovingAsBoolean
ConstsglSplitLimit=500
PrivateSubForm_Load()
LoadResStringsMe
Me.Left=GetSetting(App.Title,"Settings","MainLeft",1000)
Me.Top=GetSetting(App.Title,"Settings","MainTop",1000)
Me.Width=GetSetting(App.Title,"Settings","MainWidth",6500)
Me.Height=GetSetting(App.Title,"Settings","MainHeight",6500)
lvMerch.View=Val(GetSetting(App.Title,"Settings","ViewMode","0"))
'初始化数据
CallInitMain
EndSub
PrivateSubForm_Unload(CancelAsInteger)
DimiAsInteger
'closeallsubforms
Fori=Forms.Count-1To1Step-1
UnloadForms(i)
Next
IfMe.WindowState<>vbMinimizedThen
SaveSettingApp.Title,"Settings","MainLeft",Me.Left
SaveSettingApp.Title,"Settings","MainTop",Me.Top
SaveSettingApp.Title,"Settings","MainWidth",Me.Width
SaveSettingApp.Title,"Settings","MainHeight",Me.Height
EndI
上一篇:
vb超市管理系统无论文(论文和程序)
下一篇:
经济酒店发展:China''s economy hotel market development strategies