frmpaydisccard.frm

金算盘软件代码

VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.4#0"; "ATLEDIT1.OCX"
Begin VB.Form frmPayDiscCard 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "新增贴息折扣"
   ClientHeight    =   1725
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4290
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1725
   ScaleWidth      =   4290
   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 txtPayDisc 
      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 lblPayDisc 
      Caption         =   "贴息折扣名称(&N)"
      Height          =   195
      Left            =   270
      TabIndex        =   0
      Top             =   360
      Width           =   1485
   End
End
Attribute VB_Name = "frmPayDiscCard"
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 mlngPayDiscID As Integer   '文化程度ID
Private mblnIsNew As Boolean
Private mblnIsChanged As Boolean

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

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

Public Function DelCard(lngID As Long, Optional lnghWnd As Long = 0) As Boolean
    Dim recPayDisc As rdoResultset
    Dim strName As String, strSql As String
    
    DelCard = False
    strSql = "SELECT * FROM ItemPayDisc WHERE lngItemPayDiscID=" & lngID
    Set recPayDisc = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recPayDisc.EOF Then
        DelCard = True
        recPayDisc.Close
        Exit Function
    Else
        strName = recPayDisc!strItemPayDiscName
    End If
    recPayDisc.Close
    
    If CodeIsUsed(lngID) Then
        ShowMsg lnghWnd, "贴息折扣已有业务发生,不能删除！", vbExclamation + MB_TASKMODAL, "删除贴息折扣"
        Exit Function
    End If
    If ShowMsg(lnghWnd, "你确实要删除“" & strName & "”贴息折扣吗？", vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, _
        "删除贴息折扣") = vbNo Then Exit Function
    strSql = "DELETE FROM ItemPayDisc WHERE lngItemPayDiscID=" & 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 strItemPayDiscName As String)
    Dim strMess As String
    
    If Not CheckIDUsed("ItemPayDisc", "lngItemPayDiscID", lngID) Then
        If Trim(strItemPayDiscName) <> "" Then
            strMess = "“" & strItemPayDiscName & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "贴息折扣不存在,不能进行修改！", _
            vbExclamation + MB_TASKMODAL, "修改贴息折扣"
        Unload Me
    Else
        mlngPayDiscID = 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("ItemPayDiscDate", "lngItemPayDiscID", lngID) Then Exit Function
        If CheckIDUsed("ItemPayDiscDetail", "lngItemPayDiscID", 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 ItemPayDisc WHERE lngItemPayDiscID=" & mlngPayDiscID
        Set recPayDisc = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        txtPayDisc.Text = recPayDisc!strItemPayDiscName
        recPayDisc.Close
    Else
        txtPayDisc.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
            txtPayDisc.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(txtPayDisc.Text) = "" Then Exit Sub
    If mblnIsChanged Then
          strMess = "“" & txtPayDisc.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
    
    On Error Resume Next
    If Not mblnIsChanged Then
        SaveCard = True
        Exit Function
    End If
    If txtPayDisc.Text = "" Then
        ShowMsg hwnd, "贴息折扣名称不能为空！", vbExclamation + MB_TASKMODAL, Caption
        txtPayDisc.SetFocus
        Exit Function
    End If
    If Card.ContainErrorChar(txtPayDisc.Text) Then
        ShowMsg hwnd, "贴息折扣名称包含非法字符，不能存盘！", vbExclamation + MB_TASKMODAL, Caption
        txtPayDisc.SetFocus
        txtPayDisc.SelStart = Len(txtPayDisc.Text)
        BKKEY txtPayDisc.hwnd
        Exit Function
    End If
     
    strSql = "SELECT * FROM ItemPayDisc WHERE strItemPayDiscName='" & txtPayDisc.Text _
        & "' AND lngItemPayDiscID <>" & IIf(mblnIsNew, 0, mlngPayDiscID)
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTemp.EOF Then
        ShowMsg hwnd, "贴息折扣名称不能为重复,请重新录入！", vbExclamation + MB_TASKMODAL, Caption
        txtPayDisc.SetFocus
        recTemp.Close
        Exit Function
    End If
    recTemp.Close
    If mblnIsNew Then
        mlngPayDiscID = GetNewID("ItemPayDisc")
        strSql = "INSERT INTO ItemPayDisc(lngItemPayDiscID,strItemPayDiscName) VALUES(" _
            & mlngPayDiscID & ",'" & txtPayDisc.Text & "')"
        If Not gclsBase.ExecSQL(strSql) Then Exit Function
'        strSql = "SELECT * FROM ItemPayDisc WHERE strItemPayDiscName='" & txtPayDisc.Text & "'"
'        Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'        mlngPayDiscID = recTemp!lngItemPayDiscID
'        recTemp.Close
    Else
        strSql = "UPDATE ItemPayDisc SET strItemPayDiscName='" & txtPayDisc.Text _
            & "'" & "WHERE lngItemPayDiscID=" & mlngPayDiscID
        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 txtPayDisc_Change()
     
    If ContainErrorChar(txtPayDisc.Text) Then BKKEY txtPayDisc.hwnd
    If Not mblnIsInit Then mblnIsChanged = True
End Sub