企业管理

开发平台：
Visual Basic

frmSell.frm：源码内容
							VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmSell 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "销售信息"
   ClientHeight    =   4260
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   6450
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4260
   ScaleWidth      =   6450
   ShowInTaskbar   =   0   'False
   Begin VB.Frame fraMerchType 
      Caption         =   "销售信息"
      Height          =   3255
      Left            =   240
      TabIndex        =   8
      Top             =   240
      Width           =   6015
      Begin VB.TextBox txtRemark 
         Height          =   735
         Left            =   1200
         MultiLine       =   -1  'True
         TabIndex        =   5
         Text            =   "frmSell.frx":0000
         Top             =   2280
         Width           =   4695
      End
      Begin VB.TextBox txtPrice 
         Height          =   350
         Left            =   1200
         MaxLength       =   8
         TabIndex        =   4
         Text            =   "txtPrice"
         Top             =   1710
         Width           =   1335
      End
      Begin VB.ComboBox cboUnit 
         Height          =   300
         ItemData        =   "frmSell.frx":000A
         Left            =   2760
         List            =   "frmSell.frx":0011
         Style           =   2  'Dropdown List
         TabIndex        =   3
         Top             =   1230
         Width           =   1335
      End
      Begin VB.TextBox txtCount 
         Height          =   350
         Left            =   1200
         MaxLength       =   8
         TabIndex        =   2
         Text            =   "txtCount"
         Top             =   1200
         Width           =   1335
      End
      Begin VB.ComboBox cboMerchName 
         Height          =   300
         ItemData        =   "frmSell.frx":001C
         Left            =   1200
         List            =   "frmSell.frx":001E
         Style           =   2  'Dropdown List
         TabIndex        =   0
         Top             =   300
         Width           =   1815
      End
      Begin MSComCtl2.DTPicker dtpRegDate 
         Height          =   345
         Left            =   1200
         TabIndex        =   1
         Top             =   735
         Width           =   1815
         _ExtentX        =   3201
         _ExtentY        =   609
         _Version        =   393216
         Format          =   22872065
         CurrentDate     =   38263
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "统计时间"
         Height          =   180
         Left            =   240
         TabIndex        =   14
         Top             =   840
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "售出商品"
         Height          =   180
         Left            =   240
         TabIndex        =   13
         Top             =   360
         Width           =   720
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "备注"
         Height          =   180
         Left            =   240
         TabIndex        =   12
         Top             =   2400
         Width           =   360
      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         Caption         =   "售出数量"
         Height          =   180
         Left            =   240
         TabIndex        =   11
         Top             =   1320
         Width           =   720
      End
      Begin VB.Label Label8 
         AutoSize        =   -1  'True
         Caption         =   "售出单价"
         Height          =   180
         Left            =   240
         TabIndex        =   10
         Top             =   1800
         Width           =   720
      End
      Begin VB.Label Label9 
         AutoSize        =   -1  'True
         Caption         =   "（人民币）"
         Height          =   180
         Left            =   2760
         TabIndex        =   9
         Top             =   1800
         Width           =   900
      End
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Height          =   330
      Left            =   3480
      TabIndex        =   6
      Top             =   3720
      Width           =   1215
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "取消"
      Height          =   330
      Left            =   4920
      TabIndex        =   7
      Top             =   3720
      Width           =   1215
   End
End
Attribute VB_Name = "frmSell"
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 clsSell         '数据对象，用来存储用户输入数据
Public m_ViewType As gxcViewType  '显示状态，指添加还是修改
Private m_TypeId As Long
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 = "保存"
  Case vtInfo   '查看
    CancelButton.Visible = False
    OKButton.Caption = "关闭"
  End Select
End Sub
'打开对话框，并传出用户输入数据
Public Function ShowDlg(ByRef obj As Object, _
                        ByVal eViewType As gxcViewType, _
                        Optional nTypeId As Long = -1, _
                        Optional strUser As String = "") 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
  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
      txtCount.Text = .Count
      txtPrice.Text = .SellPrice
      txtRemark.Text = .Remark
      cboUnit.ListIndex = 0
      dtpRegDate.Value = .RegDate
      
      For i = 0 To cboMerchName.ListCount - 1
        If cboMerchName.ItemData(i) = .MerchandiseID Then
          cboMerchName.ListIndex = i         '客户类型Id
          Exit For
        End If
      Next i
      
    End With
  End If
  
End Sub
'检查输入有效性
Private Function CheckValid() As Boolean
  CheckValid = False
  
  If txtCount.Text = "" _
    Or txtPrice.Text = "" _
    Or txtRemark.Text = "" Then
    MsgBox "请填写完毕以上各项内容"
    Exit Function
  End If
  If cboMerchName.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(dtpRegDate.Value) Then
    MsgBox "请输入正确的日期格式"
    Exit Function
  End If
  
  CheckValid = True
  
End Function
'保存数据
Private Sub SaveValue()
  '给“成员变量”对象赋值
  With m_obj
    '注意以下利用RealString函数替换去除输入中的单引号
    .Count = txtCount.Text
    .SellPrice = txtPrice.Text
    .Remark = RealString(txtRemark.Text)
    .MerchandiseID = cboMerchName.ItemData(cboMerchName.ListIndex)  '商品类型Id
    .MerchName = cboMerchName.Text
    .RegDate = dtpRegDate.Value
    .OperatorId = m_Account   '操作者账号
    
  End With
End Sub
'取消按钮
Private Sub CancelButton_Click()
  Unload Me
End Sub
Private Sub Form_Load()
  Dim opMerch As New clsOpMerch
  opMerch.FillCombo cboMerchName
End Sub
'确定按钮
Private Sub OKButton_Click()
  OK = True
  
  '检测输入有效性
  If Not CheckValid Then Exit Sub
  
  '如果是新增状态，则初始化一个数据对象
  If m_ViewType = vtadd Then Set m_obj = New clsSell
  
  '保存用户输入
  SaveValue
  Me.Hide
  
End Sub

						