frmjobtypelistcard.frm

金算盘软件代码

VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.2#0"; "ATLEDIT.OCX"
Begin VB.Form frmJobTypeListCard 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "新增工程类型"
   ClientHeight    =   2175
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6015
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   ScaleHeight     =   2175
   ScaleWidth      =   6015
   Begin AtlEdit.TEdit txtInput 
      Height          =   285
      Index           =   1
      Left            =   1740
      TabIndex        =   3
      Top             =   1260
      Width           =   2415
      _ExtentX        =   4260
      _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 AtlEdit.TEdit txtInput 
      Height          =   285
      Index           =   0
      Left            =   1740
      TabIndex        =   1
      Top             =   630
      Width           =   2415
      _ExtentX        =   4260
      _ExtentY        =   503
      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 VB.CommandButton cmdOK 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   4590
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1002"
      Top             =   570
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Default         =   -1  'True
      Height          =   350
      Index           =   0
      Left            =   4590
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1001"
      Top             =   180
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   2
      Left            =   4590
      Style           =   1  'Graphical
      TabIndex        =   7
      Tag             =   "1009"
      Top             =   960
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox chkPause 
      Caption         =   "停用"
      Height          =   225
      Left            =   4590
      TabIndex        =   4
      Top             =   1785
      Width           =   1215
   End
   Begin VB.Label lblTitle 
      Caption         =   "工程类型名称(&N)"
      Height          =   225
      Index           =   1
      Left            =   330
      TabIndex        =   2
      Top             =   1320
      Width           =   1695
   End
   Begin VB.Label lblTitle 
      Caption         =   "工程类型编码(&C)"
      Height          =   225
      Index           =   0
      Left            =   330
      TabIndex        =   0
      Top             =   660
      Width           =   1575
   End
End
Attribute VB_Name = "frmJobTypeListCard"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  工程类别卡片
'  作者：苏涛
'  日期：1998.07.08
'
'  功能：完成工程类别表的增、删、改操作
'
'  接口： AddCard   增加工程类别记录。
'                   参数：intModal 显示模式，strName 用户输入值
'         EditCard  修改工程类别记录。
'                   参数： lngRecordID 被修改的记录的ID，intModal 显示模式
'         DelCard   删除工程类别记录。
'                   参数： lngRecordID 被删除的记录的ID
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Option Compare Text

Private mblnIsInit As Boolean
Private mblnIsNew As Boolean                           '是新增还是修改操作
Private mblnIsInActive As Boolean
Private mblnIsChanged As Boolean
Private mblnIsDetail As Boolean
Private mblnPIsInActive As Boolean                     'NEW--上级停用，EDIT--目的停用
Private mblnPIsDetail As Boolean                       'NEW--上级明细，EDIT--目的明细
Private mintLevel As Integer
Private mintOldLevel As Integer
Private mlngPCodeID As Long                            'NEW--上级ID，EDIT--目的ID
Private mlngJobTypeID As Long
Private mstrCode As String
Private mstrName As String
Private mstrOldCode As String                           '以前的CODE
Private mstrOldName As String                           '以前的NAME
Private mstrOldFullName As String
Private mstrFullName As String
Private mstrStartDate As String
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1

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

'进入新增工程类别操作
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer) As Long
    
    If IsContinue Then Exit Function
    mblnIsNew = True
    mlngJobTypeID = 0
    Caption = "新增工程类别"
    cmdOK(2).Default = True
    cmdOK(2).Visible = True
    InitCard strName
    Show intModal
    AddCard = mlngJobTypeID
    Refresh
    ZOrder 0
    Unload MsgForm
End Function

Private Sub InitCard(Optional ByVal strName As String)
    Dim recJobType As rdoResultset, strSql As String

    mblnIsInit = True
    mlngPCodeID = 0
    mblnPIsDetail = False
    mblnPIsInActive = False
    If mblnIsNew Then
        txtInput(1).Text = ""
        txtInput(0).Text = Trim(strName)
        chkPause.Value = Unchecked
    Else
        strSql = "SELECT * FROM JobType WHERE lngJobTypeID=" & mlngJobTypeID
        Set recJobType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
        txtInput(0).Text = recJobType!strJobTypeCode
        txtInput(1).Text = recJobType!strJobTypeName
        mblnIsDetail = recJobType!blnIsDetail
        chkPause.Value = IIf(recJobType!blnIsInActive, 1, 0)
        mblnIsInActive = recJobType!blnIsInActive
        mintOldLevel = recJobType!intLevel
        mstrOldFullName = recJobType!strFullName
        mstrOldCode = txtInput(0).Text
        mstrOldName = txtInput(1).Text
    End If
    mblnIsInit = False
End Sub
'进入修改工程类别操作
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
    Optional strItem As String)
    Dim strMess As String
    
    If IsContinue Then Exit Sub
    If Not CheckIDUsed("JobType", "lngJobTypeID", lngID) Then
        If Trim(strItem) <> "" Then
            strMess = "“" & strItem & "”"
        Else
            strMess = "该"
        End If
        ShowMsg 0, strMess & "工程类别不存在,不能进行修改!", vbExclamation + MB_TASKMODAL, "修改工程类别"
        Unload Me
    Else
        mblnIsNew = False
        mlngJobTypeID = lngID
        Caption = "修改工程类别"
        cmdOK(0).Default = True
        cmdOK(2).Visible = False
        InitCard
        Show intModal
        Refresh
        ZOrder 0
    End If
    Unload MsgForm
End Sub

'进入删除工程类别操作，判断编码是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngID As Long) As Boolean
    Dim strSql As String, strCode As String, strItem As String
    Dim recJobType As rdoResultset

    If lngID = mlngJobTypeID And frmTpJobList.IsShowCard(0) Then
        ShowMsg 0, "不能删除正在修改的工程类别！", vbExclamation + MB_TASKMODAL, "删除工程类别"
        Show
        Exit Function
    End If
    DelCard = False
    strSql = "SELECT * FROM JobType WHERE lngJobTypeID=" & lngID
    Set recJobType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recJobType.EOF Then
        DelCard = True
        recJobType.Close
        Exit Function
    Else
        strCode = Trim(recJobType!strJobTypeCode)
        strItem = Trim(recJobType!strJobTypeCode) & " " & Trim(recJobType!strJobTypeName)
        If recJobType!blnIsDetail = 0 Then
            ShowMsg 0, "“" & strItem & "”有下级工程类别，不能删除！", _
                    vbExclamation + vbOKOnly + MB_TASKMODAL, "删除工程类别"
            recJobType.Close
            Exit Function
        End If
    End If
    recJobType.Close
    If CodeUsed(lngID) Then
        ShowMsg 0, "工程类别“" & strItem & "”已有业务发生，不能删除！", _
            vbExclamation + vbOKOnly + MB_TASKMODAL, "删除工程类别"
        Exit Function
    End If
    If ShowMsg(0, "您确实要删除工程类别“" & strItem & "”吗？" _
        , vbQuestion + vbYesNo + MB_TASKMODAL, "删除工程类别") = vbNo Then
        Exit Function
    End If
    gclsBase.BaseWorkSpace.BeginTrans
    strSql = "DELETE FROM JobType WHERE lngJobTypeID = " & lngID
    If Not gclsBase.ExecSQL(strSql) Then GoTo ErrHandle
    If Not ChangeHigherCardDetail("JobType", "strJobTypeCode", strCode) Then GoTo ErrHandle
    DelCard = True
'    gclsSys.SendMessage CStr(Me.hwnd), Message.msgJobType
    gclsBase.BaseWorkSpace.CommitTrans
    Exit Function
ErrHandle:
    gclsBase.BaseWorkSpace.RollbackTrans
End Function

'判断编码是否被使用（可能有多张表会使用此编码）
Private Function CodeUsed(lngID As Long) As Boolean
    CodeUsed = True
    If CheckIDUsed("Job", "lngJobTypeID", lngID) Then Exit Function
    CodeUsed = False
End Function

Private Sub chkPause_Click()
'    Dim strJobType As String
'
'    strJobType = txtInput(0).Text & " " & txtInput(1).Text
'    If chkPause.Value = Checked And Not mblnIsNew Then
'        If CodeUsed(mlngJobTypeID) Then
'            ShowMsg hwnd, "工程类别“" & strJobType & "”已有业务发生，不能停用！", _
'                vbExclamation, Caption
'            chkPause.Value = Unchecked
'        End If
'    End If
    If Not mblnIsInit Then mblnIsChanged = True
End Sub

Private Sub Form_Activate()
'    mclsMainControl_ChildActive
    gclsSys.CurrFormName = Me.hwnd
End Sub

Private Sub Form_Load()
    Me.Hide
    Me.Left = -30000
    MsgForm.PleaseWait
    SetHelpID hwnd, 30016
    mblnIsChanged = False
    frmTpJobList.IsShowCard(0) = True
    Set mclsMainControl = gclsSys.MainControls.Add(Me)