企业管理

开发平台：
Visual Basic

frmDispose.frm：源码内容
							VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmDispose 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "报损信息"
   ClientHeight    =   4470
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   6360
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4470
   ScaleWidth      =   6360
   ShowInTaskbar   =   0   'False
   Begin VB.Frame fraMerchType 
      Caption         =   "报损信息"
      Height          =   3495
      Left            =   120
      TabIndex        =   8
      Top             =   240
      Width           =   6015
      Begin VB.TextBox txtReason 
         Height          =   735
         Left            =   1200
         MaxLength       =   255
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   4
         Text            =   "frmDispose.frx":0000
         Top             =   1680
         Width           =   4695
      End
      Begin VB.ComboBox cboMerchName 
         Height          =   300
         ItemData        =   "frmDispose.frx":000C
         Left            =   1200
         List            =   "frmDispose.frx":000E
         Style           =   2  'Dropdown List
         TabIndex        =   0
         Top             =   300
         Width           =   1815
      End
      Begin VB.TextBox txtCount 
         Height          =   350
         Left            =   1200
         MaxLength       =   8
         TabIndex        =   2
         Text            =   "txtCount"
         Top             =   1200
         Width           =   1335
      End
      Begin VB.ComboBox cboUnit 
         Height          =   300
         ItemData        =   "frmDispose.frx":0010
         Left            =   2760
         List            =   "frmDispose.frx":0017
         Style           =   2  'Dropdown List
         TabIndex        =   3
         Top             =   1230
         Width           =   1335
      End
      Begin VB.TextBox txtRemark 
         Height          =   735
         Left            =   1200
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   5
         Text            =   "frmDispose.frx":0022
         Top             =   2520
         Width           =   4695
      End
      Begin MSComCtl2.DTPicker dtpRegDate 
         Height          =   345
         Left            =   1200
         TabIndex        =   1
         Top             =   735
         Width           =   1815
         _ExtentX        =   3201
         _ExtentY        =   609
         _Version        =   393216
         Format          =   23068673
         CurrentDate     =   38263
      End
      Begin VB.Label Label8 
         AutoSize        =   -1  'True
         Caption         =   "报损原因"
         Height          =   180
         Left            =   240
         TabIndex        =   13
         Top             =   1800
         Width           =   720
      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         Caption         =   "报损数量"
         Height          =   180
         Left            =   240
         TabIndex        =   12
         Top             =   1320
         Width           =   720
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "备注"
         Height          =   180
         Left            =   240
         TabIndex        =   11
         Top             =   2640
         Width           =   360
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "报损商品"
         Height          =   180
         Left            =   240
         TabIndex        =   10
         Top             =   360
         Width           =   720
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "统计时间"
         Height          =   180
         Left            =   240
         TabIndex        =   9
         Top             =   840
         Width           =   720
      End
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Height          =   330
      Left            =   3360
      TabIndex        =   7
      Top             =   3960
      Width           =   1215
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "取消"
      Height          =   330
      Left            =   4800
      TabIndex        =   6
      Top             =   3960
      Width           =   1215
   End
End
Attribute VB_Name = "frmDispose"
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 clsDispose         '数据对象，用来存储用户输入数据
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
      txtReason.Text = .Reason
      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 txtReason.Text = "" _
    Or txtRemark.Text = "" Then
    MsgBox "请填写完毕以上各项内容"
    Exit Function
  End If
  If cboMerchName.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
    .Reason = RealString(txtReason.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 clsDispose
  
  '保存用户输入
  SaveValue
  Me.Hide
  
End Sub

						