frmeditwarestype.frm

针对农资系统的商品进销存管理系统软件

VERSION 5.00
Begin VB.Form frmEditWaresType 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "编辑商品类别"
   ClientHeight    =   2505
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4095
   Icon            =   "frmEditWaresType.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2505
   ScaleWidth      =   4095
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定"
      Height          =   375
      Left            =   720
      TabIndex        =   2
      Top             =   2040
      Width           =   1095
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      CausesValidation=   0   'False
      Height          =   375
      Left            =   2400
      TabIndex        =   3
      Top             =   2040
      Width           =   1095
   End
   Begin VB.Frame Frame1 
      Height          =   1875
      Left            =   120
      TabIndex        =   4
      Top             =   0
      Width           =   3855
      Begin VB.TextBox txtThisCode 
         Height          =   300
         Left            =   960
         TabIndex        =   0
         Top             =   1040
         Width           =   495
      End
      Begin VB.TextBox txtThisName 
         Height          =   300
         Left            =   960
         MaxLength       =   30
         TabIndex        =   1
         Top             =   1440
         Width           =   2775
      End
      Begin VB.Label lblThisCode 
         AutoSize        =   -1  'True
         Caption         =   "本级代码"
         Height          =   180
         Left            =   120
         TabIndex        =   10
         Top             =   1080
         Width           =   720
      End
      Begin VB.Label lblTypeName 
         AutoSize        =   -1  'True
         Caption         =   "上级名称"
         Height          =   180
         Left            =   120
         TabIndex        =   9
         Top             =   600
         Width           =   720
      End
      Begin VB.Line Line1 
         BorderColor     =   &H00808080&
         Index           =   0
         X1              =   30
         X2              =   3820
         Y1              =   880
         Y2              =   880
      End
      Begin VB.Line Line1 
         BorderColor     =   &H00FFFFFF&
         Index           =   1
         X1              =   30
         X2              =   3820
         Y1              =   900
         Y2              =   900
      End
      Begin VB.Label lblThisName 
         AutoSize        =   -1  'True
         Caption         =   "本级名称"
         Height          =   180
         Left            =   120
         TabIndex        =   8
         Top             =   1485
         Width           =   720
      End
      Begin VB.Label lblTypeCode 
         AutoSize        =   -1  'True
         Caption         =   "上级代码"
         Height          =   180
         Left            =   120
         TabIndex        =   7
         Top             =   240
         Width           =   720
      End
      Begin VB.Label lblParentCode 
         AutoSize        =   -1  'True
         Caption         =   "lblParentCode"
         Height          =   180
         Left            =   960
         TabIndex        =   6
         Top             =   240
         Width           =   1170
      End
      Begin VB.Label lblParentName 
         AutoSize        =   -1  'True
         Caption         =   "lblParentName"
         Height          =   180
         Left            =   960
         TabIndex        =   5
         Top             =   600
         Width           =   1170
      End
   End
End
Attribute VB_Name = "frmEditWaresType"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public m_bOk As Boolean
Dim m_sParentCode As String, m_sParentName As String
Dim m_sOldThisCode As String, m_sOldThisName As String

Property Let TypeAttribute(sParentCode As String, sParentName As String, sOldThisCode As String, sOldThisName As String)
    m_sParentCode = sParentCode
    m_sParentName = sParentName
    m_sOldThisCode = sOldThisCode
    m_sOldThisName = sOldThisName
End Property

Private Sub cmdCancel_Click()
    m_bOk = False
    Me.Hide
End Sub

Private Sub cmdOk_Click()
    Dim sCode As String, sOldCode As String
    
    sCode = m_sParentCode & txtThisCode.Text
    sOldCode = m_sParentCode & m_sOldThisCode
    If txtThisCode.Text = m_sOldThisCode And txtThisName.Text = m_sOldThisName Then
        m_bOk = False
        Me.Hide
        Exit Sub
    ElseIf txtThisCode.Text <> m_sOldThisCode Then     '代码改变, 检查代码合法性
        If Not RsIsEmpty("Select * From WaresList Where FWaresCode = '" & sCode & "'") Then
            MsgBox "本级代码重复输入!", vbOKOnly + vbExclamation, "提示："
            txtThisCode.SetFocus
            Exit Sub
        End If
    End If
    
    On Error GoTo Error_Handler
    
    m_gDBCnn.BeginTrans
    If m_sOldThisCode = "" Then     '增加类别
        m_gDBCnn.Execute "Insert Into WaresList (FWaresCode, FThisCode, FName, FMaster) Values ('" & sCode & "', '" & txtThisCode.Text & "', '" & txtThisName.Text & "', True)"
    Else                            '修改类别
    
        If txtThisCode.Text <> m_sOldThisCode Then
            m_gDBCnn.Execute "Update WaresLIst Set FWaresCode = '" & sCode & "' & Mid(FWaresCode, " & Len(sCode) & " + 1), FThisCode = '" & txtThisCode.Text & "' Where FWaresCode Like '" & sOldCode & "%'"
        End If
        If txtThisName.Text <> m_sOldThisName Then
            m_gDBCnn.Execute "Update WaresLIst Set FName = '" & txtThisName.Text & "' Where FWaresCode = '" & IIf(txtThisCode.Text <> m_sOldThisCode, sCode, sOldCode) & "'"
        End If
    End If
    m_gDBCnn.CommitTrans
    
    m_bOk = True
    Me.Hide
    Exit Sub

Error_Handler:
    m_gDBCnn.RollbackTrans
    MsgBox "数据更新不成功, 本级类别名称可能超长!", vbOKOnly + vbCritical, "提示："
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{Tab}"
    End If
End Sub

Private Sub Form_Load()
    SetForm Me, 9
    
    If m_sOldThisCode = "" Then
        Me.Caption = "增加商品类别"
    Else
        Me.Caption = "修改商品类别"
    End If
    
    lblParentCode.Caption = m_sParentCode
    lblParentName.Caption = m_sParentName
    txtThisCode.Text = m_sOldThisCode
    txtThisName.Text = m_sOldThisName
    
    txtThisCode.MaxLength = GetNextSeriesLength(m_sParentCode)
    m_bOk = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Me.MousePointer = vbDefault
End Sub

Private Sub txtThisCode_Validate(Cancel As Boolean)
    With txtThisCode
        .Text = Trim(.Text)
        If .Text = "" Then
            MsgBox "请输入本级代码!", vbInformation + vbOKOnly, "提示："
            Cancel = True
        ElseIf Not IsNumeric(.Text) Then
            MsgBox "本级代码请输入数字!", vbInformation + vbOKOnly, "提示："
            Cancel = True
        ElseIf Len(.Text) < GetNextSeriesLength(m_sParentCode) Then
            .Text = String(GetNextSeriesLength(m_sParentCode) - Len(.Text), "0") & .Text
        End If
    End With
End Sub

Private Sub txtThisName_Validate(Cancel As Boolean)
    With txtThisName
        .Text = Trim(.Text)
        If .Text = "" Then
            MsgBox "请输入本级类别名称!", vbInformation + vbOKOnly, "提示："
            Cancel = True
        End If
    End With
End Sub