frmaddcoop.frm

<Visual Basic 数据库开发实例精粹（第二版）>一书首先介绍了Visual Basic(简称VB)开发的技巧和重点技术

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form frmAddCoop 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "添加合作信息"
   ClientHeight    =   3570
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   6165
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3570
   ScaleWidth      =   6165
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdModify 
      Caption         =   "修改"
      Height          =   375
      Left            =   360
      TabIndex        =   9
      Top             =   3000
      Width           =   1215
   End
   Begin VB.Frame fraCoop 
      Caption         =   "合作信息 "
      Height          =   2535
      Left            =   360
      TabIndex        =   2
      Top             =   240
      Width           =   5295
      Begin MSComctlLib.Slider sldCoop 
         Height          =   255
         Left            =   1200
         TabIndex        =   7
         Top             =   840
         Width           =   3015
         _ExtentX        =   5318
         _ExtentY        =   450
         _Version        =   393216
         Max             =   255
         SelStart        =   50
         TickStyle       =   3
         Value           =   50
      End
      Begin VB.TextBox txtCoopMsg 
         BackColor       =   &H80000009&
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   975
         Left            =   1320
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   3
         Top             =   1320
         Width           =   3735
      End
      Begin MSComCtl2.DTPicker dtpCoopDate 
         Height          =   375
         Left            =   1320
         TabIndex        =   4
         Top             =   360
         Width           =   3015
         _ExtentX        =   5318
         _ExtentY        =   661
         _Version        =   393216
         CalendarTitleBackColor=   -2147483635
         Format          =   63111169
         CurrentDate     =   38219
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "满意度"
         Height          =   180
         Left            =   120
         TabIndex        =   8
         Top             =   840
         Width           =   540
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "合作内容"
         Height          =   180
         Left            =   120
         TabIndex        =   6
         Top             =   1320
         Width           =   720
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "合作时间"
         Height          =   180
         Left            =   120
         TabIndex        =   5
         Top             =   360
         Width           =   720
      End
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "取消"
      Height          =   375
      Left            =   4440
      TabIndex        =   1
      Top             =   3000
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Height          =   375
      Left            =   3000
      TabIndex        =   0
      Top             =   3000
      Width           =   1215
   End
End
Attribute VB_Name = "frmAddCoop"
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 objCoop As CCooperate       '合作信息对象
Private mvarViewType As gxcViewType  '显式模式
Private ClientId As Long            '合作者（客户）Id

'显式模式
Public Property Get ViewType() As gxcViewType
  ViewType = mvarViewType
End Property

Private Sub CancelButton_Click()
  '按了取消按钮
  OK = False
  Me.Hide
End Sub

Private Sub cmdModify_Click()
  mvarViewType = vtModify
  SetStatus
End Sub

Private Sub OKButton_Click()
  
  OK = True
  
  '检测输入有效性
  Call CheckValid
  
  '如果是新增状态，则新建立一个“客户信息”对象
  If mvarViewType = vtadd Then Set objCoop = New CCooperate
  
  '给“客户信息”对象赋值
  SaveValue
  
  Me.Hide

End Sub

'根据对话框状态，确定显示内容
Private Sub SetStatus()
  txtCoopMsg.Appearance = 1
  txtCoopMsg.BackColor = &H80000009
  txtCoopMsg.Locked = False
  cmdModify.Visible = False
  dtpCoopDate.Enabled = True
  sldCoop.Enabled = True
    
  '设置控件默认值
  SetDefaultValue
  
  '根据对话框状态，确定控件状态
  Select Case mvarViewType
  Case vtadd      '添加
    CancelButton.Visible = True
    OKButton.Caption = "确定"
    Me.Caption = "添加合作信息"
  Case vtModify   '修改
    CancelButton.Visible = True
    OKButton.Caption = "保存"
    Me.Caption = "修改合作信息"
  Case vtInfo     '查看
    cmdModify.Visible = True
    CancelButton.Visible = False
    OKButton.Caption = "关闭"
    Me.Caption = "查看合作信息"

    txtCoopMsg.Appearance = 0
    txtCoopMsg.BackColor = &H8000000F
    txtCoopMsg.Locked = True
    dtpCoopDate.Enabled = False
    sldCoop.Enabled = False
  Case Else
  End Select

End Sub

'根据传入的模式显示对话框，并传出数据
Public Function RetriveCoop(ByRef oCoop As CCooperate, _
                            ByVal eViewType As gxcViewType, _
                            ByVal nClientId As Long) As Boolean
  Set objCoop = oCoop
  
  mvarViewType = eViewType  '对话框状态
  '保存客户ID
  If nClientId <> -1 Then
    ClientId = nClientId
  Else
    ClientId = oCoop.ClientId
  End If
  
  SetStatus '根据新增或编辑状态设置显示内容
  
  OK = False
  '显示对话框
  Me.Show vbModal
  If OK = False Then Exit Function
  
  '传出对象
  Set oCoop = objCoop
  RetriveCoop = True
  Unload Me
End Function

'设置控件默认值
Private Sub SetDefaultValue()
  Dim ctl As Control
  Dim i As Integer
 
  If objCoop Is Nothing Then
    For Each ctl In Controls
      If TypeOf ctl Is TextBox Then
        ctl.Text = ""
      End If
    Next
  Else
    With objCoop
      txtCoopMsg.Text = .Remark
      dtpCoopDate.Value = .CooperateDate
      sldCoop.Value = .Satisfaction
    End With
  End If
  
End Sub

'检测输入有效性
Private Function CheckValid() As Boolean
  If txtCoopMsg.Text = "" Then
      MsgBox "请填写合作信息", vbOKOnly + vbExclamation
      CheckValid = False
  Else
    CheckValid = True
  End If
End Function

'保存用户输入到合作信息对象objCoop
Private Sub SaveValue()
  
  With objCoop
    .ClientId = ClientId
    .CooperateDate = dtpCoopDate.Value
    .Satisfaction = sldCoop.Value
    .Remark = Trim(txtCoopMsg.Text)
  End With

End Sub