frmdepcardnew.frm

金算盘软件代码

VERSION 5.00
Object = "{F42BDC2B-FC9B-11D1-9ABD-444553540000}#3.4#0"; "ATLEDIT1.OCX"
Begin VB.Form frmDepartmentCard 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "新增部门"
   ClientHeight    =   2295
   ClientLeft      =   1680
   ClientTop       =   1950
   ClientWidth     =   5970
   HelpContextID   =   30009
   Icon            =   "frmDepCardNew.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2295
   ScaleWidth      =   5970
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin AtlEdit.TEdit txtDepartment 
      Height          =   315
      Index           =   0
      Left            =   1560
      TabIndex        =   1
      Top             =   510
      Width           =   2475
      _ExtentX        =   4366
      _ExtentY        =   556
      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            =   4530
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "1002"
      Top             =   540
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOk 
      Height          =   350
      Index           =   0
      Left            =   4530
      Style           =   1  'Graphical
      TabIndex        =   4
      Tag             =   "1001"
      Top             =   150
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOk 
      Height          =   350
      Index           =   2
      Left            =   4530
      Style           =   1  'Graphical
      TabIndex        =   6
      Tag             =   "1009"
      Top             =   950
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton cmdOk 
      Height          =   350
      Index           =   3
      Left            =   4530
      Style           =   1  'Graphical
      TabIndex        =   7
      Tag             =   "1013"
      Top             =   1350
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CheckBox chkStop 
      Caption         =   "停用"
      Height          =   225
      Left            =   4560
      TabIndex        =   8
      Top             =   1890
      Width           =   1215
   End
   Begin AtlEdit.TEdit txtDepartment 
      Height          =   315
      Index           =   1
      Left            =   1530
      TabIndex        =   3
      Top             =   1410
      Width           =   2475
      _ExtentX        =   4366
      _ExtentY        =   556
      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         =   "部门编号(&C)"
      Height          =   195
      Index           =   0
      Left            =   360
      TabIndex        =   0
      Top             =   540
      Width           =   1035
   End
   Begin VB.Label lblNote 
      Caption         =   "部门名称(&N)"
      Height          =   195
      Index           =   1
      Left            =   360
      TabIndex        =   2
      Top             =   1440
      Width           =   1035
   End
End
Attribute VB_Name = "frmDepartmentCard"
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 mblnIsInActive 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 mlngDepartmentID 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 AddDepartment(ByVal strDepartment As String) As Integer
    Dim strCode As String, strName As String, blnIsStop As Boolean
    Dim strTemp As String
    
    AddDepartment = 0
    If Not GetString(strDepartment, strCode, 1) Then Exit Function
    If Not GetString(strDepartment, strName, 2) Then Exit Function
    If Not GetString(strDepartment, mstrNotes, 6) Then Exit Function
    If Not GetString(strDepartment, strTemp, 7) Then Exit Function
    blnIsStop = (strTemp = "1")
    
    If strCode = "" Or strName = "" Then Exit Function
    txtDepartment(0).Text = strCode
    txtDepartment(1).Text = strName
    chkStop.Value = IIf(blnIsStop, 1, 0)
    mblnIsNew = True
    'chkStop.Value=iif(.IsInActive,1,0)
    If Not SaveCard(True) Then Exit Function
    AddDepartment = 1
End Function

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

Public Function AddCard(Optional strName As String = "", Optional intModal As Integer = 0, _
    Optional ByVal IsList As Boolean = False) As Long
    
    mlngDepartmentID = 0
    mblnIsChanged = True
    mblnIsNew = True
    mblnIsList = IsList
    InitCard strName
    Caption = "新增部门"
    Show intModal
    AddCard = mlngDepartmentID
End Function

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

Public Function CodeIsUsed(ByVal lngID As Long, Optional strDep As String = "") As Boolean
    Dim recFixAl As rdoResultset, strSql As String
    Dim strFname As String
    
    CodeIsUsed = True
    If lngID <> 0 Then
        strFname = "lngDepartmentID"
        If UsedInAccountDaily(strFname, lngID) Then Exit Function
        If CheckIDUsed("ActivityDetail", strFname, lngID) Then Exit Function
        If CheckIDUsed("ARAPInit", strFname, lngID) Then Exit Function
        If CheckIDUsed("BudgetBalance", strFname, lngID) Then Exit Function
        If CheckIDUsed("CostPrice", strFname, lngID) Then Exit Function
        If CheckIDUsed("ItemActivity", strFname, lngID) Then Exit Function
        If CheckIDUsed("PurchaseOrder", strFname, lngID) Then Exit Function
        If CheckIDUsed("Salary", strFname, lngID) Then Exit Function
        If CheckIDUsed("SaleOrder", strFname, lngID) Then Exit Function
        If CheckIDUsed("stockTaking", strFname, lngID) Then Exit Function
        If CheckIDUsed("TransVoucherDetail", strFname, lngID) Then Exit Function
        If CheckIDUsed("Employee", strFname, lngID) Then Exit Function
        If CheckIDUsed("VoucherDetail", strFname, lngID) Then Exit Function
'        If strDep <> "" Then
'            strSql = "SELECT * FROM FixedAlter WHERE InStr(strDepartmentStr,'" & strDep & "')>0"
'            Set recFixAl = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'            If Not recFixAl.EOF Then
'                recFixAl.Close
'                Exit Function
'            End If
'                recFixAl.Close
'        End If
    End If