frmsaledisccard.frm

金算盘软件代码

VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.4#0"; "ATLEDIT1.OCX"
Begin VB.Form frmSaleDiscCard 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "新增促销折扣"
   ClientHeight    =   1695
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4260
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1695
   ScaleWidth      =   4260
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdOk 
      Height          =   350
      Index           =   2
      Left            =   2940
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1009"
      Top             =   960
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOk 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   2940
      Style           =   1  'Graphical
      TabIndex        =   3
      Tag             =   "1002"
      Top             =   555
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOk 
      Height          =   350
      Index           =   0
      Left            =   2940
      Style           =   1  'Graphical
      TabIndex        =   2
      Tag             =   "1001"
      Top             =   150
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin AtlEdit.TEdit txtSaleDisc 
      Height          =   285
      Left            =   240
      TabIndex        =   1
      Top             =   570
      Width           =   2205
      _ExtentX        =   3889
      _ExtentY        =   503
      maxchar         =   30
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Text            =   ""
   End
   Begin VB.Label lblSaleDisc 
      Caption         =   "促销折扣名称(&N)"
      Height          =   195
      Left            =   270
      TabIndex        =   0
      Top             =   360
      Width           =   1485
   End
End
Attribute VB_Name = "frmSaleDiscCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                                                '
'                功能:   完成促销折扣的增、删、改。                                              '
'                卡片接口:             EditCard 参数: lngID 记录的ID号                           '
'                作用:                           LNGID为零是增加记录、其它为编辑记录             '
'                                      DelCard 参数: lngID 记录的ID号                            '
'                作用:                           删除ID号为LNGID的记录                           '
'                作者：                                                                                  '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''



Option Explicit

Private mblnIsInit As Boolean
Private mlngSaleDiscID As Integer   '文化程度ID
Private mblnIsNew As Boolean
Private mblnIsChanged As Boolean

Public Property Get getID() As Long
    getID = mlngSaleDiscID
End Property

Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0) As Long
    mlngSaleDiscID = 0
    mblnIsNew = True
    mblnIsChanged = True
    InitCard strName
    Caption = "新增促销折扣"
'    cmdOk(2).Default = True
    Show intModal
    AddCard = mlngSaleDiscID
    ZOrder 0
End Function

Public Function DelCard(lngID As Long, Optional lnghWnd As Long = 0) As Boolean
    Dim recSaleDisc As rdoResultset
    Dim strName As String, strSql As String
    
    DelCard = False
    strSql = "SELECT * FROM ItemSaleDisc WHERE lngItemSaleDiscID=" & lngID
    Set recSaleDisc = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recSaleDisc.EOF Then
        DelCard = True
        recSaleDisc.Close
        Exit Function
    Else
        strName = recSaleDisc!strItemSaleDiscName
    End If
    recSaleDisc.Close
    
    If CodeIsUsed(lngID) Then
        ShowMsg lnghWnd, "促销折扣已有业务发生,不能删除！", vbExclamation + MB_TASKMODAL, "删除促销折扣"
        Exit Function
    End If
    If ShowMsg(lnghWnd, "你确实要删除“" & strName & "”促销折扣吗？", vbQuestion + vbYesNo + MB_TASKMODAL, _
        "删除促销折扣") = vbNo Then Exit Function
    strSql = "DELETE FROM ItemSaleDisc WHERE lngItemSaleDiscID=" & lngID
    If Not gclsBase.ExecSQL(strSql) Then Exit Function
'    gclsSys.SendMessage CStr(Me.hwnd), Message.msgEmployee
    DelCard = True
End Function

Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
        Optional strItemSaleDiscName As String)
    Dim strMess As String
    
    If Not CheckIDUsed("ItemSaleDisc", "lngItemSaleDiscID", lngID) Then
        If Trim(strItemSaleDiscName) <> "" Then
            strMess = "“" & strItemSaleDiscName & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "促销折扣不存在,不能进行修改！", _
            vbExclamation + MB_TASKMODAL, "修改促销折扣"
        Unload Me
    Else
        mlngSaleDiscID = lngID
        mblnIsNew = False
        InitCard
        Caption = "修改促销折扣"
'        cmdOk(0).Default = True
        cmdOk(2).Visible = False
        Show intModal
    '    frmEmployeeList.IsShowCard = True
        ZOrder 0
    End If
End Sub

Private Function CodeIsUsed(ByVal lngID As Long) As Boolean
    CodeIsUsed = True
    If lngID <> 0 Then
        If CheckIDUsed("ItemSaleDiscDetail", "lngItemSaleDiscID", lngID) Then Exit Function
    End If
    CodeIsUsed = False
End Function

Private Sub InitCard(Optional strName As String = "")
    Dim recPayDisc As rdoResultset
    Dim strSql As String
    
    mblnIsInit = True
    If Not mblnIsNew Then
        strSql = "SELECT * FROM ItemSaleDisc WHERE lngItemSaleDiscID=" & mlngSaleDiscID
        Set recPayDisc = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        txtSaleDisc.Text = recPayDisc!strItemSaleDiscName
        recPayDisc.Close
    Else
        txtSaleDisc.Text = Trim(strName)
    End If
    mblnIsInit = False
End Sub

Private Sub cmdOK_Click(Index As Integer)
    
    If Index = 0 Then
        If Not SaveCard Then Exit Sub
    ElseIf Index = 2 Then
        If SaveCard Then
'            mlngEducateID = 0
            mblnIsNew = True
            mblnIsChanged = True
            InitCard
            txtSaleDisc.SetFocus
        End If
        Exit Sub
    End If
    Unload Me
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        If Shift = 2 Then
            cmdOk(0).Value = True
        Else
            BKKEY Me.ActiveControl.hwnd, vbKeyTab
        End If
    End If
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
'    SetHelpID hwnd, 10242
    Utility.LoadFormResPicture Me
    Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_Paint()
  FrameBox Me.hwnd, 90, 150, 2775, 1335
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsgReturn As Integer
    Dim strMess As String
    
    If UnloadMode <> vbFormControlMenu Then Exit Sub
    If Trim(txtSaleDisc.Text) = "" Then Exit Sub
    If mblnIsChanged Then
          strMess = "“" & txtSaleDisc.Text & "”" & "促销折扣名称已被修改，是否保存？"
        
        intMsgReturn = ShowMsg(hwnd, strMess, vbQuestion + vbYesNoCancel, Caption)
        If intMsgReturn = vbYes Then
            Cancel = Not SaveCard
        ElseIf intMsgReturn = vbCancel Then
            Cancel = True
        End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    mblnIsChanged = False
    Utility.UnLoadFormResPicture Me
End Sub

Private Function SaveCard() As Boolean
    Dim recTemp As rdoResultset
    Dim strSql As String
    
    SaveCard = False
    
    If Not mblnIsChanged Then
        SaveCard = True
        Exit Function
    End If
    If txtSaleDisc.Text = "" Then
        ShowMsg hwnd, "促销折扣名称不能为空！", vbExclamation + MB_TASKMODAL, Caption
        txtSaleDisc.SetFocus
        Exit Function
    End If
    If Card.ContainErrorChar(txtSaleDisc.Text) Then
        ShowMsg hwnd, "促销折扣名称包含非法字符，不能存盘！", vbExclamation + MB_TASKMODAL, Caption
        txtSaleDisc.SetFocus
        txtSaleDisc.SelStart = Len(txtSaleDisc.Text)
        BKKEY txtSaleDisc.hwnd
        Exit Function
    End If
     
    strSql = "SELECT * FROM ItemSaleDisc WHERE strItemSaleDiscName='" & txtSaleDisc.Text _
        & "' AND lngItemSaleDiscID <>" & IIf(mblnIsNew, 0, mlngSaleDiscID)
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTemp.EOF Then
        ShowMsg hwnd, "促销折扣名称不能为重复,请重新录入！", vbExclamation + MB_TASKMODAL, Caption
        txtSaleDisc.SetFocus
        recTemp.Close
        Exit Function
    End If
    recTemp.Close
    If mblnIsNew Then
        mlngSaleDiscID = GetNewID("ItemSaleDisc")
        strSql = "INSERT INTO ItemSaleDisc(lngItemSaleDiscID,strItemSaleDiscName,strStartDate,strEndDate) " _
             & "VALUES(" & mlngSaleDiscID & ",'" & txtSaleDisc.Text & "',' ',' ')"
        If Not gclsBase.ExecSQL(strSql) Then Exit Function
'        strSql = "SELECT * FROM ItemSaleDisc WHERE strItemSaleDiscName='" & txtSaleDisc.Text & "'"
'        Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'        mlngSaleDiscID = recTemp!lngItemSaleDiscID
'        recTemp.Close
    Else
        strSql = "UPDATE ItemSaleDisc SET strItemSaleDiscName='" & txtSaleDisc.Text _
            & "'" & "WHERE lngItemSaleDiscID=" & mlngSaleDiscID
        If Not gclsBase.ExecSQL(strSql) Then Exit Function
    End If
    SaveCard = True
    mblnIsChanged = False
'    gclsSys.SendMessage CStr(Me.hWnd), Message.msgEmployee
End Function

Private Sub txtSaleDisc_Change()
     
    If ContainErrorChar(txtSaleDisc.Text) Then BKKEY txtSaleDisc.hwnd
    If Not mblnIsInit Then mblnIsChanged = True
End Sub