inventorydlg.frm

汽车维修管理软件。其中包含三个编辑控件。

VERSION 5.00
Begin VB.Form InventoryDlg 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   3540
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   4755
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3540
   ScaleWidth      =   4755
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox InvUnit 
      Height          =   270
      Left            =   1560
      MaxLength       =   10
      TabIndex        =   5
      Top             =   1560
      Width           =   2655
   End
   Begin VB.ComboBox InvType 
      Height          =   300
      ItemData        =   "InventoryDlg.frx":0000
      Left            =   1560
      List            =   "InventoryDlg.frx":0002
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   2040
      Width           =   2655
   End
   Begin VB.TextBox InvName 
      Height          =   270
      Left            =   1560
      MaxLength       =   50
      TabIndex        =   3
      Top             =   1080
      Width           =   2655
   End
   Begin VB.TextBox InvCode 
      Height          =   270
      Left            =   1560
      MaxLength       =   10
      TabIndex        =   2
      Top             =   600
      Width           =   2655
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "取消"
      Height          =   375
      Left            =   2760
      TabIndex        =   1
      Top             =   3000
      Width           =   1215
   End
   Begin VB.CommandButton OkOrSaveButton 
      Height          =   375
      Left            =   840
      TabIndex        =   0
      Top             =   3000
      Width           =   1215
   End
   Begin VB.Frame Frame 
      Caption         =   "存货档案"
      Height          =   2655
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   4455
      Begin VB.Label Label4 
         Caption         =   "存货类型"
         Height          =   255
         Left            =   240
         TabIndex        =   10
         Top             =   1920
         Width           =   855
      End
      Begin VB.Label Label3 
         Caption         =   "存货单位"
         Height          =   255
         Left            =   240
         TabIndex        =   9
         Top             =   1440
         Width           =   855
      End
      Begin VB.Label Label2 
         Caption         =   "存货名称"
         Height          =   255
         Left            =   240
         TabIndex        =   8
         Top             =   960
         Width           =   855
      End
      Begin VB.Label Label1 
         Caption         =   "存货编码"
         Height          =   255
         Left            =   240
         TabIndex        =   7
         Top             =   480
         Width           =   855
      End
   End
End
Attribute VB_Name = "InventoryDlg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_DoMode As PopupMode
'Private m_Conn As ADODB.Connection
Private m_Comm As ADODB.Command
Private m_ReturnCode As ReturnCode
Private m_pCode As String
Private m_OldId As Long
Private m_OldCode As String
Private m_OldName As String
Private m_TypeRecode As ADODB.Recordset
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\汽车修理管理\Data.mdb;Persist Security Info=False

Private Sub CancelButton_Click()
Unload Me
End Sub

Public Function DoModal(DoMode As PopupMode, Optional pCode As String) As ReturnCode
m_DoMode = DoMode
m_pCode = pCode
m_ReturnCode = RC_NOTHING
Select Case m_DoMode
       Case PopupMode.PM_ADD
           'Is it add
       Case PopupMode.PM_EDIT
           If pCode = "" Then
              DoModal = RC_ERROR
              Exit Function
           End If
       Case PopupMode.PM_VIWE
           If pCode = "" Then
              DoModal = RC_ERROR
              Exit Function
           End If
       Case Else
           DoModal = RC_ERROR
           Exit Function
End Select
OkOrSaveButton.Enabled = False
Me.Show vbModal
DoModal = m_ReturnCode
End Function

Private Sub Form_Activate()
If m_DoMode = PM_ADD Or PM_EDIT Then InvCode.SetFocus
If m_ReturnCode = RC_ERROR Then Unload Me


End Sub

Private Sub Form_Load()
Dim re As ADODB.Recordset
Select Case m_DoMode
       Case PopupMode.PM_ADD
            OkOrSaveButton.Caption = "增加"
            Me.Caption = "增加"
            
       Case PopupMode.PM_EDIT
            OkOrSaveButton.Caption = "保存"
            Me.Caption = "修改"
       Case PopupMode.PM_VIWE
            OkOrSaveButton.Caption = "确定"
            Me.Caption = "查看"
            InvCode.Locked = True
            InvName.Locked = True
            InvUnit.Locked = True
            InvType.Locked = True
End Select
If g_Conn Is Nothing Then
Set g_Conn = New ADODB.Connection
With g_Conn
    .Provider = g_Provider
    .CommandTimeout = 7
    .ConnectionTimeout = 10
    .Open g_DataSource
End With
End If
If g_Conn.State = adStateClosed Then
   g_Conn.Open g_DataSource
End If
Set re = g_Conn.Execute("SELECT * FROM InvType ORDER BY Id")
If re.BOF And re.EOF Then
   m_ReturnCode = RC_ERROR
   MsgBox "存货分类不存在", vbCritical Or vbOKOnly, "错误"
   Unload Me
End If
re.MoveFirst
While Not re.EOF
    InvType.AddItem re.Fields(1)
    re.MoveNext
Wend
If m_DoMode = PM_EDIT Or m_DoMode = PM_VIWE Then

   Set re = SQLFind(m_pCode, "Inventory", "Code", FT_CHAR)
   If re.BOF And re.EOF Then
      MsgBox "该记录已经不存在了", vbCritical Or vbOKOnly, "错误"
      m_ReturnCode = RC_ERROR
      Exit Sub
   End If
   m_OldId = re.Fields(0).Value
   m_OldCode = re.Fields(1).Value
   m_OldName = re.Fields(2).Value
   InvCode.Text = m_OldCode
   InvName.Text = m_OldName
   InvUnit.Text = re.Fields(3).Value
   InvType.ListIndex = re.Fields(4).Value - 1
End If
If m_DoMode = PM_ADD Then
   InvType.ListIndex = 0
End If
OkOrSaveButton.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set m_Comm = Nothing
End Sub

Private Sub InvCode_Change()
OkOrSaveButton.Enabled = CheckInput()
End Sub
Private Function CheckInput() As Boolean
Dim ObjInput As Control
For Each ObjInput In Me.Controls
    If TypeOf ObjInput Is TextBox Or TypeOf ObjInput Is ComboBox Then
       If Trim$(ObjInput.Text) = "" Then
          CheckInput = False
          Exit Function
       End If
    End If
Next ObjInput
CheckInput = True
End Function
'Private Sub InvName_Change()
'OkOrSaveButton.Enabled = CheckInput()
'End Sub

Private Sub InvType_Validate(Cancel As Boolean)
OkOrSaveButton.Enabled = CheckInput()
End Sub

Private Sub InvUnit_Change()
OkOrSaveButton.Enabled = CheckInput()
End Sub
Private Sub OkOrSaveButton_Click()
Dim re As ADODB.Recordset
Dim TempCode As String
Dim TempName As String
Dim TempUnit As String
Dim TempType As String
TempCode = Trim$(InvCode.Text)
TempName = Trim$(InvName.Text)
TempUnit = Trim$(InvUnit.Text)
TempType = Trim$(InvType.Text)
'存货是否已使用
'If m_DoMode = PM_EDIT And m_OldCode <> TempCode Then
'   If Not SQLFindIsNull(CStr(m_OldId), "WorkSub_2", "InvId", FT_NUMBER) Then
'      MsgBox "该存货以使用,故不能修改", vbCritical Or vbOKOnly, "错误"
'      Exit Sub
'   End If
'End If
Set re = SQLFind(TempCode, "Inventory", "Code", FT_CHAR)
If Not (re.BOF And re.EOF) Then
   If (TempCode <> m_OldCode And m_DoMode = PM_EDIT) Or m_DoMode = PM_ADD Then
       MsgBox "单位代码重复", vbCritical Or vbOKOnly, "错误"
       InvCode.SetFocus
       Exit Sub
   End If
End If
'Set re = Nothing
Set re = SQLFind(TempName, "Inventory", "Name", FT_CHAR)
If Not (re.BOF And re.EOF) Then
   If (TempName <> m_OldName And m_DoMode = PM_EDIT) Or m_DoMode = PM_ADD Then
      MsgBox "单位名称重复", vbCritical Or vbOKOnly, "错误"
      InvName.SetFocus
      Exit Sub
   End If
End If

If g_Conn Is Nothing Then
Set g_Conn = New ADODB.Connection
With g_Conn
    .Provider = g_Provider
    .CommandTimeout = 7
    .ConnectionTimeout = 10
    .Open g_DataSource
End With
End If
If g_Conn.State = adStateClosed Then
   g_Conn.Open g_DataSource
End If
Set m_Comm = New ADODB.Command
m_Comm.CommandType = adCmdText
m_Comm.ActiveConnection = g_Conn
Dim ListType As Integer
Set re = SQLFind(TempType, "InvType", "TypeName", FT_CHAR)
If re.BOF And re.EOF Then
       MsgBox "存货类型错误", vbCritical Or vbOKOnly, "错误"
       Exit Sub
End If

ListType = re.Fields(0).Value
Select Case m_DoMode
   Case PopupMode.PM_ADD
        AddSave TempCode, TempName, TempUnit, ListType
   Case PopupMode.PM_EDIT
        EditSave TempCode, TempName, TempUnit, ListType
End Select
End Sub
Private Sub AddSave(ByRef pCode As String, ByRef pName As String, _
                     ByRef pUnit As String, ByVal pType As Integer)
Dim com As String
On Error GoTo InvAddErr
com = "INSERT INTO Inventory (Code,Name,Unit,Type) VALUES ('" & pCode & "','"
com = com & pName & "','" & pUnit & "'," & CStr(pType) & ")"
m_Comm.CommandText = com
m_Comm.Execute , , adExecuteNoRecords
InvCode.Text = ""
InvName.Text = ""
InvUnit.Text = ""
InvType.ListIndex = 0
m_ReturnCode = RC_OK
Exit Sub
InvAddErr:
MsgBox "数据写入未成功", vbCritical Or vbOKOnly, "错误"
End Sub
Private Sub EditSave(ByRef pCode As String, ByRef pName As String, _
                     ByRef pUnit As String, ByVal pType As Integer)
Dim com As String
On Error GoTo InvEditErr
com = "UPDATE Inventory SET Code='" & pCode & "',Name='" & pName & "',Unit='" & pUnit & "',Type=" & CStr(pType) _
     & " WHERE Code='" & m_pCode & "'"
m_Comm.CommandText = com
m_Comm.Execute , , adExecuteNoRecords
m_ReturnCode = RC_OK
Unload Me
Exit Sub
InvEditErr:
MsgBox "数据修改未成功", vbCritical Or vbOKOnly, "错误"
End Sub
Public Property Get TableName() As String
TableName = "Inventory"
End Property