frmprojectcard.frm

金算盘软件代码

            Strikethrough   =   0   'False
         EndProperty
      End
      Begin VB.Label lblProj 
         AutoSize        =   -1  'True
         Caption         =   "项目核算(&X)"
         Height          =   180
         Index           =   9
         Left            =   150
         TabIndex        =   4
         Top             =   1215
         Width           =   990
      End
      Begin VB.Label lblProj 
         AutoSize        =   -1  'True
         Caption         =   "统计核算(&T)"
         Height          =   180
         Index           =   8
         Left            =   150
         TabIndex        =   2
         Top             =   840
         Width           =   990
      End
      Begin VB.Label lblProj 
         AutoSize        =   -1  'True
         Caption         =   "会计科目(&A)"
         Height          =   180
         Index           =   0
         Left            =   150
         TabIndex        =   0
         Top             =   480
         Width           =   990
      End
      Begin VB.Label lblProj 
         AutoSize        =   -1  'True
         Caption         =   "工程编号(&C)"
         Height          =   180
         Index           =   1
         Left            =   150
         TabIndex        =   6
         Top             =   1575
         Width           =   990
      End
      Begin VB.Label lblProj 
         AutoSize        =   -1  'True
         Caption         =   "工程名称(&N)"
         Height          =   180
         Index           =   2
         Left            =   150
         TabIndex        =   8
         Top             =   1940
         Width           =   990
      End
      Begin VB.Label lblProj 
         AutoSize        =   -1  'True
         Caption         =   "工程负责人(&E)"
         Height          =   180
         Index           =   3
         Left            =   150
         TabIndex        =   14
         Top             =   3035
         Width           =   1170
      End
      Begin VB.Label lblProj 
         AutoSize        =   -1  'True
         Caption         =   "概预算金额(&S)"
         Height          =   180
         Index           =   4
         Left            =   150
         TabIndex        =   16
         Top             =   3405
         Width           =   1170
      End
      Begin VB.Label lblProj 
         AutoSize        =   -1  'True
         Caption         =   "计量单位(&U)"
         Height          =   180
         Index           =   5
         Left            =   150
         TabIndex        =   10
         Top             =   2305
         Width           =   990
      End
      Begin VB.Label lblProj 
         AutoSize        =   -1  'True
         Caption         =   "数量(&Q)"
         Height          =   180
         Index           =   6
         Left            =   150
         TabIndex        =   12
         Top             =   2670
         Width           =   630
      End
   End
   Begin VB.CheckBox chkPause 
      Caption         =   "停用"
      Height          =   180
      Left            =   4320
      TabIndex        =   26
      Top             =   4485
      Width           =   795
   End
   Begin VB.CommandButton cmdOKCancel 
      Height          =   345
      Index           =   2
      Left            =   4320
      Style           =   1  'Graphical
      TabIndex        =   25
      Tag             =   "1009"
      Top             =   1260
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOKCancel 
      Height          =   350
      Index           =   0
      Left            =   4320
      Style           =   1  'Graphical
      TabIndex        =   23
      Tag             =   "1001"
      Top             =   480
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOKCancel 
      Cancel          =   -1  'True
      Height          =   345
      Index           =   1
      Left            =   4320
      Style           =   1  'Graphical
      TabIndex        =   24
      Tag             =   "1002"
      Top             =   870
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
End
Attribute VB_Name = "frmProjectCard"
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 mblnIsNew As Boolean                           '是新增还是修改操作
Private mblnNotExit As Boolean
Private mblnIsList As Boolean
Private mblnIsInit 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 mblnIsEdit As Boolean
Private mintLevel As Integer
Private mintOldLevel As Integer
Private mlngPCodeID As Long                            'NEW--上级ID，EDIT--目的ID
Private mlngProjectID As Long
Private mlngLstID(0 To 2) As Long
Private mlngLstOldID(0 To 2) As Long
Private mdblBudgetAmount As Double
Private mdblOldBudgetAmount As Double
Private mstrCode As String
Private mstrName As String
Private mstrPrincipal As String
Private mstrOldCode As String                           '以前的CODE
Private mstrOldName As String                           '以前的NAME
Private mstrFullName As String
Private mstrOldFullName As String
Private mstrStartDate As String
Private mstrTitle As String

'引入单位类别
Public Function AddProject(ByVal strProject As String) As Integer
    Dim strCode As String, strName As String, blnIsStop As Boolean
    Dim strTemp As String
    
    AddProject = 0
    If Not GetString(strProject, strCode, 1) Then Exit Function
    If Not GetString(strProject, strName, 2) Then Exit Function
    If Not GetString(strProject, strTemp, 3) Then Exit Function
    blnIsStop = (strTemp = "1")
    
    If strCode = "" Or strName = "" Then Exit Function
    txtInput(0).Text = strCode
    txtInput(1).Text = strName
    chkPause.Value = IIf(blnIsStop, 1, 0)
    mblnIsNew = True
    If Not SaveCard(True) Then Exit Function
    AddProject = 1
End Function

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

'进入新增工程项目操作
Public Function AddCard(Optional strName As String = "", Optional intModal As Integer, _
    Optional ByVal IsList As Boolean = False) As Long
    #If conVersionType = 1 Then
        mstrTitle = "在建工程"
    #Else
        mstrTitle = "工程项目"
    #End If
    
    If gclsBase.AccountSys = "1" And gclsBase.Trade = "邮电通信" Then
        If IsCanDo(391) = False Then
            ShowMsg 0, "操作员" & gclsBase.OperatorName & "没有“在建工程”权限 ,不能新增！", vbExclamation + MB_TASKMODAL, "新增" & mstrTitle
            Exit Function
        End If
    End If
    mblnIsNew = True
    mlngProjectID = 0
    Caption = "新增" & mstrTitle
    cmdOkCancel(2).Visible = True
    mblnIsList = IsList
    InitCard strName
    Show vbModal
    AddCard = mlngProjectID
End Function

Private Sub InitCard(Optional ByVal strName As String)
    Dim recProject As rdoResultset, strSql As String
    Dim strX As String
    
    mblnIsInit = True
    mlngPCodeID = 0
    mblnPIsDetail = False
    mblnPIsInActive = False
    If mblnIsNew Then
        mdblOldBudgetAmount = 0
        txtInput(0).Text = Trim(strName)
        txtInput(1).Text = ""
        txtInput(2).Text = ""
        txtInput(3).Text = ""
        mlngLstID(0) = 0
        mlngLstID(1) = 0
        mlngLstID(2) = 0
        chkPause.Value = Unchecked
    Else
        strSql = "SELECT Project.*,Account.strAccountCode || ' ' || Account." _
            & "strAccountName strAccount,Class1.strClassCode || ' ' || " _
            & "Class1.strClassName strClass1,Class2.strClassCode || ' ' || " _
            & "Class2.strClassName strClass2 FROM Project,Account,Class1,Class2 " _
            & "WHERE Project.lngAccountID=Account.lngAccountID(+) AND Project.lngClassID1=" _
            & "Class1.lngClassID(+) AND Project.lngClassID2=Class2.lngClassID(+) AND lngProjectID=" _
            & mlngProjectID
        Set recProject = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        lstText(0).Text = Format(recProject!strAccount, "@;;")
        lstText(1).Text = Format(recProject!strClass1, "@;;")
        lstText(2).Text = Format(recProject!strClass2, "@;;")
        txtInput(0).Text = recProject!strProjectCode
        txtInput(1).Text = recProject!strProjectName
        txtInput(2).Text = Trim(recProject!strPrincipal)
        strX = IIf(recProject!dblBudgetAmount = 0, "", _
            Format(recProject!dblBudgetAmount, gclsBase.GetFormat(gclsBase.NaturalCurDec)))
        txtInput(3).Text = Left(strX, txtInput(3).MaxLength)
        txtInput(4).Text = Trim(recProject!strUnit)
        strX = IIf(recProject!dblQuantity = 0, "", _
            Format(recProject!dblQuantity, gclsBase.GetFormat(gclsBase.QuantityDec)))
        txtInput(5).Text = Left(strX, txtInput(5).MaxLength)
        txtNotes.Text = recProject!strNote
        mdblOldBudgetAmount = recProject!dblBudgetAmount
        dteClose.Text = Trim(recProject!strCloseDate)
        chkClose.Value = recProject!blnIsClosed
        chkPause.Value = recProject!blnIsInActive
        mlngLstID(0) = Format(recProject!lngAccountID, "@;0;")
        mlngLstID(1) = Format(recProject!lngClassID1, "@;0;")
        mlngLstID(2) = Format(recProject!lngClassID2, "@;0;")
        mlngLstOldID(0) = Format(recProject!lngAccountID, "@;0;")
        mlngLstOldID(1) = Format(recProject!lngClassID1, "@;0;")
        mlngLstOldID(2) = Format(recProject!lngClassID2, "@;0;")
        mblnIsInActive = (recProject!blnIsInActive = 1)
        mblnIsDetail = (recProject!blnIsDetail = 1)
        txtInput(3).Enabled = mblnIsDetail
        mintOldLevel = recProject!intLevel
        mstrOldFullName = recProject!strFullName
        mstrOldCode = txtInput(0).Text
        mstrOldName = txtInput(1).Text
'        lstText.Enabled = mblnIsDetail
    End If
    SetTabIndex
'    mblnIsInit = False
End Sub
'进入修改工程项目操作
Public Sub EditCard(ByVal lngID As Long, Optional intModal As Integer = 0, _
    Optional strType As String)
    Dim strMess As String
    
    #If conVersionType = 1 Then
        mstrTitle = "在建工程"
    #Else
        mstrTitle = "工程项目"
    #End If
    
    If gclsBase.AccountSys = "1" And gclsBase.Trade = "邮电通信" Then
        If IsCanDo(391) = False Then
            ShowMsg 0, "操作员" & gclsBase.OperatorName & "没有“在建工程”权限 ,不能修改！", vbExclamation + MB_TASKMODAL, "修改" & mstrTitle
            Exit Sub
        End If
    End If
    If Not CheckIDUsed("Project", "lngProjectID", lngID) Then