repairdlg.frm

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

VERSION 5.00
Begin VB.Form RepairDlg 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   3195
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   6030
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Picture         =   "RepairDlg.frx":0000
   ScaleHeight     =   3195
   ScaleWidth      =   6030
   ShowInTaskbar   =   0   'False
   Begin VB.Frame Box 
      Caption         =   "维修项目档案"
      Height          =   2175
      Left            =   480
      TabIndex        =   2
      Top             =   360
      Width           =   5415
      Begin VB.TextBox RepCode 
         Height          =   270
         Left            =   1440
         MaxLength       =   10
         TabIndex        =   5
         Top             =   480
         Width           =   1455
      End
      Begin VB.TextBox RepName 
         Height          =   270
         Left            =   1440
         MaxLength       =   50
         TabIndex        =   4
         Top             =   1080
         Width           =   3855
      End
      Begin VB.TextBox RepRate 
         Height          =   270
         Left            =   1440
         MaxLength       =   2
         TabIndex        =   3
         Text            =   "0"
         Top             =   1680
         Width           =   375
      End
      Begin VB.Label Rate 
         Caption         =   "%"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   255
         Left            =   1920
         TabIndex        =   9
         Top             =   1680
         Width           =   255
      End
      Begin VB.Label LabelCode 
         Caption         =   "维修项目编号:"
         Height          =   255
         Left            =   240
         TabIndex        =   8
         Top             =   480
         Width           =   1215
      End
      Begin VB.Label LabelName 
         Caption         =   "维修项目名称:"
         Height          =   255
         Left            =   240
         TabIndex        =   7
         Top             =   1080
         Width           =   1215
      End
      Begin VB.Label LabelRate 
         Caption         =   "提成比例:"
         Height          =   255
         Left            =   240
         TabIndex        =   6
         Top             =   1680
         Width           =   975
      End
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "取消"
      Height          =   375
      Left            =   3120
      TabIndex        =   1
      Top             =   2640
      Width           =   1215
   End
   Begin VB.CommandButton SaveButton 
      Height          =   375
      Left            =   1560
      TabIndex        =   0
      Top             =   2640
      Width           =   1215
   End
End
Attribute VB_Name = "RepairDlg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_pCode As String
Private m_DoMode As PopupMode
Private m_ReturnCode As ReturnCode
Private m_OldRate As String
Private m_Comm As ADODB.Command
Private m_OldId As Long
Private m_OldCode As String
Private m_OldName As String
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
Me.Show vbModal
DoModal = m_ReturnCode
End Function
Private Sub CancelButton_Click()
Unload Me
End Sub

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

Private Sub Form_Load()
Select Case m_DoMode
       Case PopupMode.PM_ADD
            SaveButton.Caption = "增加"
            Me.Caption = "增加"
            
       Case PopupMode.PM_EDIT
            SaveButton.Caption = "保存"
            Me.Caption = "修改"
       Case PopupMode.PM_VIWE
            SaveButton.Caption = "确定"
            Me.Caption = "查看"
            RepCode.Locked = True
            RepName.Locked = True
            RepRate.Locked = True
End Select
If m_DoMode = PM_EDIT Or m_DoMode = PM_VIWE Then
   Dim re As ADODB.Recordset
   Set re = SQLFind(m_pCode, "RepairItem", "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
   RepCode.Text = m_OldCode
   RepName.Text = m_OldName
   RepRate.Text = re.Fields(3).Value
End If
m_OldRate = "0"
SaveButton.Enabled = False
End Sub
Private Function CheckInput() As Boolean
Dim ObjInput As Control
For Each ObjInput In Controls
If TypeOf ObjInput Is TextBox Then
   If ObjInput.Text = "" Then
      CheckInput = False
      Exit Function
    End If
End If
Next ObjInput
CheckInput = True
End Function

Private Sub RepCode_Change()
SaveButton.Enabled = CheckInput
End Sub
Private Sub RepName_Change()
SaveButton.Enabled = CheckInput
End Sub
Private Sub RepRate_Change()
If RepRate.Text = "" Then
m_OldRate = "0"
RepRate.Text = m_OldRate
End If
If Not IsNumeric(RepRate.Text) Then
   RepRate.Text = m_OldRate
Else
   Dim i As Integer
   i = CInt(RepRate.Text)
   If i < 1 Or i > 99 Then
      RepRate.Text = m_OldRate
   Else
       m_OldRate = RepRate.Text
   End If
End If
SaveButton.Enabled = CheckInput
End Sub

Private Sub RepRate_Click()
RepRate.SelStart = 0
RepRate.SelLength = 2
End Sub

Private Sub SaveButton_Click()
Dim re As ADODB.Recordset
Dim TempCode As String
Dim TempName As String
Dim TempRate As Integer
TempCode = Trim$(RepCode.Text)
TempName = Trim$(RepName.Text)
TempRate = CInt(Trim$(RepRate.Text))
If TempRate < 0 And TempRate > 99 Then
MsgBox "提成比例在0-99之间", vbCritical Or vbOKOnly, "错误"
End If
'If m_DoMode = PM_EDIT And m_OldCode <> TempCode Then
   
'   If Not SQLFindIsNull(CStr(m_OldId), "WorkSub_1", "RepairId", FT_NUMBER) Then
 '     MsgBox "该维修项目以使用,故不能修改", vbCritical Or vbOKOnly, "错误"
 '     Exit Sub
'   End If
'End If
Set re = SQLFind(TempCode, "RepairItem", "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, "错误"
      RepCode.SetFocus
      Exit Sub
   End If
End If
'Set re = Nothing
Set re = SQLFind(TempName, "RepairItem", "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, "错误"
      RepName.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
Select Case m_DoMode
   Case PopupMode.PM_ADD
        AddSave TempCode, TempName, TempRate
   Case PopupMode.PM_EDIT
        EditSave TempCode, TempName, TempRate
End Select
End Sub
Private Sub AddSave(ByRef pCode As String, ByRef pName As String, _
                     ByVal pRate As Integer)
Dim com As String
On Error GoTo RepAddErr
com = "INSERT INTO RepairItem (Code,Name,Rate) VALUES ('" & pCode & "','"
com = com & pName & "'," & CStr(pRate) & ")"
m_Comm.CommandText = com
m_Comm.Execute , , adExecuteNoRecords
RepCode.Text = ""
RepName.Text = ""
m_OldRate = "0"
RepRate.Text = m_OldRate
m_ReturnCode = RC_OK
Exit Sub
RepAddErr:
MsgBox "数据写入未成功", vbCritical Or vbOKOnly, "错误"
End Sub

Private Sub EditSave(ByRef pCode As String, ByRef pName As String, _
                     ByVal pRate As Integer)
Dim com As String
On Error GoTo RepEditErr
com = "UPDATE RepairItem SET Code='" & pCode & "',Name='" & pName & "',Rate=" & CStr(pRate) & " WHERE Code='" & m_pCode & "'"
m_Comm.CommandText = com
m_Comm.Execute , , adExecuteNoRecords
m_ReturnCode = RC_OK
Unload Me
Exit Sub
RepEditErr:
MsgBox "数据修改未成功", vbCritical Or vbOKOnly, "错误"
End Sub
Public Property Get TableName() As String
TableName = "RepairItem"
End Property