百货/超市行业

开发平台：
Visual Basic

frmAddFit.frm：源码内容
							VERSION 5.00
Begin VB.Form frmAddFit 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "配件信息"
   ClientHeight    =   2745
   ClientLeft      =   5295
   ClientTop       =   5025
   ClientWidth     =   6735
   Icon            =   "frmAddFit.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2745
   ScaleWidth      =   6735
   ShowInTaskbar   =   0   'False
   Begin VB.Frame Frame1 
      Height          =   2055
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   6495
      Begin VB.TextBox txtName 
         Height          =   300
         Left            =   1080
         TabIndex        =   9
         Text            =   "txtName"
         Top             =   240
         Width           =   2055
      End
      Begin VB.TextBox txtUnit 
         Height          =   300
         Left            =   1080
         TabIndex        =   5
         Text            =   "txtUnit"
         Top             =   660
         Width           =   2055
      End
      Begin VB.TextBox txtType 
         Height          =   300
         Left            =   4200
         TabIndex        =   4
         Text            =   "txtType"
         Top             =   240
         Width           =   2055
      End
      Begin VB.TextBox txtDemo 
         Height          =   780
         Left            =   1080
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   3
         Top             =   1080
         Width           =   5175
      End
      Begin VB.Label Labels 
         AutoSize        =   -1  'True
         Caption         =   "配件名称"
         Height          =   180
         Index           =   0
         Left            =   240
         TabIndex        =   10
         Top             =   300
         Width           =   720
      End
      Begin VB.Label Labels 
         AutoSize        =   -1  'True
         Caption         =   "计量单位"
         Height          =   180
         Index           =   2
         Left            =   240
         TabIndex        =   8
         Top             =   720
         Width           =   720
      End
      Begin VB.Label Labels 
         AutoSize        =   -1  'True
         Caption         =   "规格型号"
         Height          =   180
         Index           =   4
         Left            =   3360
         TabIndex        =   7
         Top             =   300
         Width           =   720
      End
      Begin VB.Label Labels 
         AutoSize        =   -1  'True
         Caption         =   "备    注"
         Height          =   180
         Index           =   6
         Left            =   240
         TabIndex        =   6
         Top             =   1080
         Width           =   720
      End
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Height          =   300
      Left            =   4320
      TabIndex        =   1
      Top             =   2280
      Width           =   975
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "取消"
      Height          =   300
      Left            =   5520
      TabIndex        =   0
      Top             =   2280
      Width           =   975
   End
End
Attribute VB_Name = "frmAddFit"
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
  Unload Me
End Sub
Private Sub Form_Load()
SetStatus
End Sub
Private Sub OKButton_Click()
OK = True
Dim ErrMsg As String
  Select Case mvarViewType
  Case vtadd    '添加客户
'    SaveData
    If ExistByName("Client", "CarNo", txtCarNo.Text) Then
        If MsgBox("车号已经存在，确认继续保存吗？", vbQuestion + vbYesNo + _
            vbDefaultButton2) = vbNo Then Exit Sub
    End If
        If Chk Then If RunSql("insert into Client(IDN,CarNo,CarType,MotoNo,MainNo,Demo,inDate,cName,cTel,clkID,stID) " & _
                "Values('" & idnumber.Text & "','" & txtCarNo.Text & "','" & txtCarType.Text & "','" & txtMotoNo.Text & _
                "','" & txtMainNo.Text & "','" & txtDemo.Text & "','" & DTP(0).Value & _
                "','" & txtClientName.Text & "','" & txtTel.Text & "','" & cboClerk.ItemData(cboClerk.ListIndex) & _
                "','" & cboState.ItemData(cboState.ListIndex) & "')", ErrMsg) Then Else MsgBox ErrMsg: Exit Sub
        frmCilent.AddClientToLvw g_Conn.Execute("select ID,carNO,IDN,inDate,carType,MotoNo,MainNo,cName,cTel,stID,clkID,Demo from Client where idn='" & idnumber.Text & "'"), frmCilent.lvListView, False
  Case vtModify '修改客户信息
'    ModiData
    If ExistByValueID("Client", "ID", GetID(mvarID), "CarNo", txtCarNo.Text) Then
        If MsgBox("车号已经存在，确认继续保存吗？", vbQuestion + vbYesNo + _
            vbDefaultButton2) = vbNo Then Exit Sub
    End If
    If Chk Then If RunSql("Update Client set CarNo='" & txtCarNo.Text & "',CarType='" & txtCarType.Text & _
                "',MotoNo='" & txtMotoNo.Text & "',MainNo='" & txtMainNo.Text & "',Demo='" & txtDemo.Text & _
                "',inDate='" & DTP(0).Value & "',cName='" & txtClientName.Text & "',IDN='" & idnumber.Text & _
                "',cTel='" & txtTel.Text & "',clkID='" & cboClerk.ItemData(cboClerk.ListIndex) & _
                "',stID='" & cboState.ItemData(cboState.ListIndex) & "' where ID=" & _
                GetID(mvarID), ErrMsg) Then Else MsgBox ErrMsg: Exit Sub
        frmCilent.AddClientToLvw g_Conn.Execute("select ID,carNO,IDN,inDate,carType,MotoNo,MainNo,cName,cTel,stID,clkID,Demo from Client where idn='" & idnumber.Text & "'"), frmCilent.lvListView, True
  Case Else
  End Select
  Unload Me
End Sub
'根据对话框状态，确定显示内容
Private Sub SetStatus()
  txtCoopMsg.Appearance = 1
  txtCoopMsg.BackColor = &H80000009
  txtCoopMsg.Locked = False
  cmdModify.Visible = False
  dtpCoopDate.Enabled = True
  sldCoop.Enabled = True
    
  SetDefaultValue g_Conn.Execute("Select * from PeiJian WHERE ID=" & GetID(mvarID))
  
  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 Recordset, _
                            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(Optional objClient As ADODB.Recordset)
  Dim ctl As Control
  Dim i As Integer
 
  If objClient Is Nothing Then
    For Each ctl In Controls
      If TypeOf ctl Is TextBox Then
        ctl.Text = ""
      End If
    Next
  Else
    With objClient
      txtName.Text = .Fields("pName")
      txtType.Text = .Fields("pType")
      txtUnit.Text = .Fields("pUnit")
      txtDemo.Text = .Fields("pDemo")
    End With
  End If
End Sub
Private Function Chk() As Boolean
  If txtName.Text = "" Then
      MsgBox "请填写配件名称！", vbOKOnly + vbExclamation
      CheckValid = False
      Exit Function
  ElseIf txtUnit.Text = "" Then
      MsgBox "请真写计量单位！", vbOKOnly + vbExclamation
      CheckValid = False
      Exit Function
  End If
    CheckValid = True
End Function

						