企业管理

开发平台：
Visual Basic

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

						