frmemployeetype.frm

金算盘软件代码

VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.4#0"; "ATLEDIT1.OCX"
Begin VB.Form frmEmployeeType 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "新增职员类型"
   ClientHeight    =   2100
   ClientLeft      =   2040
   ClientTop       =   1770
   ClientWidth     =   5640
   HelpContextID   =   10240
   Icon            =   "frmEmployeeType.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form2"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2100
   ScaleWidth      =   5640
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   3
      Left            =   4320
      Style           =   1  'Graphical
      TabIndex        =   7
      Tag             =   "1013"
      Top             =   1380
      UseMaskColor    =   -1  'True
      Width           =   1155
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   2
      Left            =   4320
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1009"
      Top             =   975
      UseMaskColor    =   -1  'True
      Width           =   1155
   End
   Begin VB.CommandButton cmdOK 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   4320
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1002"
      Top             =   585
      UseMaskColor    =   -1  'True
      Width           =   1155
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   0
      Left            =   4320
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1001"
      Top             =   210
      UseMaskColor    =   -1  'True
      Width           =   1155
   End
   Begin AtlEdit.TEdit txtEType 
      Height          =   300
      Index           =   0
      Left            =   1680
      TabIndex        =   1
      Top             =   450
      Width           =   2385
      _ExtentX        =   4207
      _ExtentY        =   529
      maxchar         =   16
      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 AtlEdit.TEdit txtEType 
      Height          =   300
      Index           =   1
      Left            =   1680
      TabIndex        =   3
      Top             =   1320
      Width           =   2385
      _ExtentX        =   4207
      _ExtentY        =   529
      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 lblNote 
      Caption         =   "职员类型名称(&N)"
      Height          =   195
      Index           =   1
      Left            =   300
      TabIndex        =   2
      Top             =   1350
      Width           =   1365
   End
   Begin VB.Label lblNote 
      Caption         =   "职员类型编码(&C)"
      Height          =   195
      Index           =   0
      Left            =   300
      TabIndex        =   0
      Top             =   510
      Width           =   1365
   End
End
Attribute VB_Name = "frmEmployeeType"
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
Option Compare Text

Private mblnIsInit As Boolean
Private mblnIsList As Boolean
Private mblnIsChanged As Boolean
Private mblnIsDetail As Boolean
Private mblnIsNew As Boolean
Private mblnPIsDetail As Boolean      'NEW--上级明细，EDIT--目的明细
Private mintLevel As Integer
Private mintOldLevel As Integer
Private mlngPCodeID As Long           'NEW--上级ID，EDIT--目的ID
Private mlngEmployeeTypeID As Long      '当前职员类型ID
Private mstrNotes As String
Private mstrLastCode As String
Private mstrCode As String
Private mstrName As String
Private mstrLastName As String
Private mstrFullName As String
Private mstrOldFullName As String
Private mstrStartDate As String
'引入职员类别
Public Function AddEmployeeType(ByVal strEmployeeType As String) As Integer
    Dim strCode As String, strName As String
    Dim strTemp As String
    
    AddEmployeeType = 0
    If Not GetString(strEmployeeType, strCode, 1) Then Exit Function
    If Not GetString(strEmployeeType, strName, 2) Then Exit Function
    If Not GetString(strEmployeeType, mstrNotes, 3) Then Exit Function
    
    If strCode = "" Or strName = "" Then Exit Function
    txtEType(0).Text = strCode
    txtEType(1).Text = strName
    mblnIsNew = True
    If Not SaveCard(True) Then Exit Function
    AddEmployeeType = 1
End Function

Public Property Get getID() As Variant
    getID = mlngEmployeeTypeID
End Property

Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0, _
    Optional ByVal IsList As Boolean = False) As Long
    mlngEmployeeTypeID = 0
    mblnIsNew = True
    mblnIsList = IsList
    InitCard strName
    Caption = "新增职员类型"
    Show intModal
    AddCard = mlngEmployeeTypeID
End Function

Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
    Optional strEmployeeType As String)
    Dim strMess As String
    
    If Not CheckIDUsed("EmployeeType", "lngEmployeeTypeID", lngID) Then
        If Trim(strEmployeeType) <> "" Then
            strMess = "“" & strEmployeeType & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "职员类型不存在,不能进行修改！", _
            vbExclamation + MB_TASKMODAL, "修改职员类型"
        Unload Me
    Else
        mlngEmployeeTypeID = lngID
        mblnIsNew = False
        InitCard
        Caption = "修改职员类型"
        cmdOK(2).Visible = False
        cmdOK(3).Move cmdOK(2).Left, cmdOK(2).top
        Show intModal
    End If
End Sub

Private Function CodeIsUsed(ByVal lngID As Long) As Boolean
    
    CodeIsUsed = True
    If CheckIDUsed("Employee", "lngEmployeeTypeID", lngID) Then Exit Function
    If CheckIDUsed("Salary", "lngEmployeeTypeID", lngID) Then Exit Function
    If CheckIDUsed("SalaryAccount", "lngEmployeeTypeID", lngID) Then Exit Function
    CodeIsUsed = False
End Function

Private Sub cmdOK_Click(Index As Integer)
    Dim strNextCode As String
    
    If Index = 0 Then
        If Not SaveCard Then Exit Sub
    ElseIf Index = 2 Then
        If SaveCard Then
            strNextCode = GetNextCode(txtEType(0).Text)
'            mlngETypeTypeID = 0
            InitCard
            txtEType(0).Text = strNextCode
            txtEType(0).SetFocus
            txtEType(0).SelStart = 0
            txtEType(0).SelLength = Len(txtEType(0).Text)
        End If
        Exit Sub
    ElseIf Index = 3 Then
        mstrNotes = frmNotePad.EditCard(Me.Caption, txtEType(0).Text, _
            txtEType(1).Text, mstrNotes)    '调记事
        Exit Sub
    End If
    Unload Me
    
End Sub

Public Function DelCard(ByVal lngID As Long, Optional lnghWnd As Long = 0) As Boolean
    Dim recDep As rdoResultset, strSql As String
    Dim strDep As String, strCode As String
    
    On Error GoTo ErrHandle
    gclsBase.BaseWorkSpace.BeginTrans
    DelCard = False
    If lngID = 0 Then Exit Function
    strSql = "SELECT * FROM EmployeeType WHERE lngEmployeeTypeID=" & lngID
    Set recDep = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recDep.EOF = True Then
        strCode = recDep!strEmployeeTypeCode
        strDep = "“" & Trim(recDep!strEmployeeTypeCode) & " " _
            & Trim(recDep!strEmployeeTypeName) & "”"
        If recDep!blnIsDetail = 0 Then
            ShowMsg lnghWnd, strDep & "有下级职员类型,不能删除！", vbExclamation + MB_TASKMODAL, "删除职员类型"
            GoTo ErrHandle
        End If
    Else
        DelCard = True
        GoTo ErrHandle
    End If
    If CodeIsUsed(lngID) Then
        ShowMsg lnghWnd, strDep & "职员类型已有业务发生,不能删除！", vbExclamation + MB_TASKMODAL, "删除职员类型"
        GoTo ErrHandle
    End If
    If ShowMsg(lnghWnd, "你确实要删除" & strDep & "职员类型吗？", vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, _
        "删除职员类型") = vbNo Then GoTo ErrHandle
    strSql = "DELETE FROM EmployeeType WHERE lngEmployeeTypeID=" & lngID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    If Not ChangeHigherCardDetail("EmployeeType", "strEmployeeTypeCode", strCode) Then GoTo ErrHandle
    gclsBase.BaseWorkSpace.CommitTrans
'    gclsSys.SendMessage Me.hwnd, Message.msgEmployeeType
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollBacktrans
End Function

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If mblnIsList Then
        mblnIsList = False
        Exit Sub
    End If
    If KeyAscii = vbKeyReturn Then
        BKKEY Me.ActiveControl.hwnd, vbKeyTab
    End If
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn And Shift = 2 Then
        cmdOK(0).Value = True
    End If
End Sub

Private Sub Form_Load()
    Dim edtErrReturn As ErrDealType
    
    On Error GoTo ErrHandle
'    SetHelpID hwnd, 10240
    Utility.LoadFormResPicture Me
'    SendKeys "%{C}"
    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, 130, 160, 4185, 1920
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsgReturn As Integer, strMess As String
    
    If UnloadMode <> vbFormControlMenu Then Exit Sub
    If Trim(txtEType(0).Text & txtEType(1).Text) = "" Then Exit Sub
    If mblnIsChanged Then
        If mblnIsNew Then
            strMess = "您要保存新增的职员类型"
            If txtEType(0).Text <> "" Then
                strMess = strMess & "“" & txtEType(0).Text & "”"
            End If
            If txtEType(1).Text <> "" Then
                strMess = strMess & "“" & txtEType(1).Text & "”"
            End If
            strMess = strMess & "吗？"
        Else
            strMess = "“" & txtEType(0).Text & "”" & " " _
                & "“" & txtEType(1).Text & "”职员类型已被修改，是否保存？"
        End If
        intMsgReturn = ShowMsg(hwnd, strMess, vbQuestion + vbYesNoCancel, Caption)
        If intMsgReturn = vbYes Then
            Cancel = Not SaveCard
        ElseIf intMsgReturn = vbCancel Then
            Cancel = True