frmjobtypecard.frm

金算盘软件代码

VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.4#0"; "ATLEDIT1.OCX"
Begin VB.Form frmJobTypeCard 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "新增工程类型"
   ClientHeight    =   2175
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6015
   HelpContextID   =   30016
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2175
   ScaleWidth      =   6015
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin AtlEdit.TEdit txtInput 
      Height          =   285
      Index           =   1
      Left            =   1740
      TabIndex        =   3
      Top             =   1350
      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             =   510
      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        =   5
      Tag             =   "1002"
      Top             =   570
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   0
      Left            =   4590
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1001"
      Top             =   180
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK 
      Height          =   350
      Index           =   2
      Left            =   4590
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1009"
      Top             =   960
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.Label lblTitle 
      Caption         =   "工程类型名称(&N)"
      Height          =   225
      Index           =   1
      Left            =   330
      TabIndex        =   2
      Top             =   1410
      Width           =   1695
   End
   Begin VB.Label lblTitle 
      Caption         =   "工程类型编码(&C)"
      Height          =   225
      Index           =   0
      Left            =   330
      TabIndex        =   0
      Top             =   540
      Width           =   1575
   End
End
Attribute VB_Name = "frmJobTypeCard"
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 mblnIsList As Boolean
Private mblnIsNew As Boolean                           '是新增还是修改操作
Private mblnIsChanged As Boolean
Private mblnIsDetail As Boolean
Private mblnPIsDetail As Boolean                       'NEW--上级明细，EDIT--目的明细
Private mblnPIsInActive As Boolean
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

'引入工程类别
Public Function AddJobType(ByVal strJobType As String) As Integer
    Dim strCode As String, strName As String
    Dim strTemp As String
    
    AddJobType = 0
    If Not GetString(strJobType, strCode, 1) Then Exit Function
    If Not GetString(strJobType, strName, 2) Then Exit Function
    
    If strCode = "" Or strName = "" Then Exit Function
    txtInput(0).Text = strCode
    txtInput(1).Text = strName
    mblnIsNew = True
    If Not SaveCard(True) Then Exit Function
    AddJobType = 1
End Function

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

'进入新增工程类型操作
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer, _
    Optional ByVal IsList As Boolean = False) As Long
    
    mblnIsNew = True
    mlngJobTypeID = 0
    Caption = "新增工程类型"
    cmdOK(2).Visible = True
    mblnIsList = IsList
    InitCard strName
    Show intModal
    AddCard = mlngJobTypeID
End Function

Private Sub InitCard(Optional ByVal strName As String)
    Dim recJobType As rdoResultset, strSql As String
    
    mblnIsInit = True
    mlngPCodeID = 0
    mblnPIsDetail = False
    If mblnIsNew Then
        txtInput(1).Text = ""
        txtInput(0).Text = Trim(strName)
    Else
        strSql = "SELECT * FROM JobType WHERE lngJobTypeID=" & mlngJobTypeID
        Set recJobType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        txtInput(0).Text = recJobType!strJobTypeCode
        txtInput(1).Text = recJobType!strJobTypeName
        mblnIsDetail = recJobType!blnIsDetail
        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 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(2).Visible = False
        InitCard
        Show intModal
    End If
End Sub

'进入删除工程类型操作，判断编码是否是末级和被使用，删除记录
Public Function DelCard(ByVal lngID As Long, Optional lnghWnd As Long = 0) 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 lnghWnd, "不能删除正在修改的工程类型！", vbExclamation + MB_TASKMODAL, "删除工程类型"
'        Show vbModal
'        Exit Function
'    End If
    DelCard = False
    strSql = "SELECT * FROM JobType WHERE lngJobTypeID=" & lngID
    Set recJobType = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    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 lnghWnd, "“" & strItem & "”有下级工程类型，不能删除！", _
                    vbExclamation + vbOKOnly + MB_TASKMODAL, "删除工程类型"
            recJobType.Close
            Exit Function
        End If
    End If
    recJobType.Close
    If CodeUsed(lngID) Then
        ShowMsg lnghWnd, "工程类型“" & strItem & "”已有业务发生，不能删除！", _
            vbExclamation + vbOKOnly + MB_TASKMODAL, "删除工程类型"
        Exit Function
    End If
    If ShowMsg(lnghWnd, "您确实要删除工程类型“" & strItem & "”吗？" _
        , vbQuestion + vbYesNo + MB_TASKMODAL + vbDefaultButton2, "删除工程类型") = 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 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