frmactiveset.frm

金算盘软件代码

VERSION 5.00
Begin VB.Form frmActiveSet 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "业务配置"
   ClientHeight    =   4230
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4395
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4230
   ScaleWidth      =   4395
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame2 
      Caption         =   "说明"
      Height          =   2535
      Left            =   3060
      TabIndex        =   3
      Top             =   1320
      Width           =   1215
      Begin VB.Label lblActiveSet 
         Caption         =   "  您可以通过选择业务来配置流程图的内容"
         Height          =   1245
         Index           =   0
         Left            =   120
         TabIndex        =   4
         Top             =   600
         Width           =   975
      End
   End
   Begin VB.CommandButton Command1 
      Default         =   -1  'True
      Height          =   345
      Index           =   0
      Left            =   3060
      Style           =   1  'Graphical
      TabIndex        =   2
      Tag             =   "1001"
      Top             =   180
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Cancel          =   -1  'True
      Height          =   350
      Index           =   1
      Left            =   3060
      Style           =   1  'Graphical
      TabIndex        =   1
      Tag             =   "1002"
      Top             =   630
      UseMaskColor    =   -1  'True
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Caption         =   "选择业务"
      Height          =   3795
      Left            =   120
      TabIndex        =   0
      Top             =   60
      Width           =   2625
      Begin VB.ListBox lstSelectedItem 
         Height          =   3210
         Left            =   120
         Style           =   1  'Checkbox
         TabIndex        =   7
         Top             =   360
         Width           =   1935
      End
      Begin VB.CommandButton cmdUpWard 
         Enabled         =   0   'False
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   396
         Left            =   2130
         Style           =   1  'Graphical
         TabIndex        =   6
         TabStop         =   0   'False
         Tag             =   "1019"
         Top             =   2595
         UseMaskColor    =   -1  'True
         Width           =   300
      End
      Begin VB.CommandButton cmdDownWard 
         Enabled         =   0   'False
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   396
         Left            =   2130
         Style           =   1  'Graphical
         TabIndex        =   5
         TabStop         =   0   'False
         Tag             =   "1020"
         Top             =   3174
         UseMaskColor    =   -1  'True
         Width           =   300
      End
   End
End
Attribute VB_Name = "frmActiveSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'业务重组
'作者：郑全
'日期：1998.11.20

Option Explicit
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private mblnisPress As Boolean
Private Sub ReDefineOrder()
'Dim lngModID As Long
'    If gVersionType = vtAccount Then
'       If gclsBase.ControlAccount Then
'          lngModID = gclsBase.OperatorID + 100000
'       Else
'          lngModID = gclsBase.OperatorID + 110000
'       End If
'    Else
'       lngModID = gclsBase.OperatorID + 10000
'    End If
'    strSql = "SELECT * FROM Setting WHERE lngModuleID=" _
'                 & lngModelID & " AND Trim(strKey)='" & Trim(strNode) & "'"

End Sub
Public Sub RefreshSetting()
       Dim rec As rdoResultset
       Dim strSql As String
       Dim lngModelID As Long
       #If conWan = 1 Then
            If gVersionType = vtAccount Then
               If gclsBase.ControlAccount Then '控制科目
                  lngModelID = gclsBase.OperatorID + 200000
               Else  '非控制科目
                  If gclsBase.BaseNoControl = True Then
                     lngModelID = gclsBase.OperatorID + 210000
                  Else
                     lngModelID = gclsBase.OperatorID + 200000
                  End If
               End If
            Else
               lngModelID = gclsBase.OperatorID + 20000
            End If
       #Else
            If gVersionType = vtAccount Then
               If gclsBase.ControlAccount Then '控制科目
                  lngModelID = gclsBase.OperatorID + 100000
               Else  '非控制科目
                  If gclsBase.BaseNoControl = True Then
                     #If conHos = 1 Then '医疗版
                         lngModelID = gclsBase.OperatorID + 120000
                     #Else
                         lngModelID = gclsBase.OperatorID + 110000
                     #End If
                  Else
                     lngModelID = gclsBase.OperatorID + 100000
                  End If
               End If
            Else
               lngModelID = gclsBase.OperatorID + 10000
            End If
       #End If
       strSql = "SELECT * FROM Setting WHERE lngModuleID=" _
                    & lngModelID & " Order By TO_CHAR(strTypeName,'99')"
       Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues) ', dbOpenSnapshot)
       If rec.EOF Then
            InitData
       Else
            With rec
              Dim lngOrder As Long
              lngOrder = 1
              .MoveFirst
              Do While Not .EOF
                .Edit
                If EnableMudal(!strSection) Then
'                   .rdoColumns("strTypeName") = lngOrder
                   If Trim(.rdoColumns("strSetting")) <> "" Then
                      .rdoColumns("strSetting") = "Y" & lngOrder
                      lngOrder = lngOrder + 1
                   End If
                   
                Else
                   .rdoColumns("strSetting") = "Y"
                End If
                .Update
                .MoveNext
              Loop
            End With
       End If

End Sub
Public Sub AddNewToSetting(ByVal XlngOperatorID As Long)
'添加新记录到Setting表中
Dim lngModelID As Long
Dim lngModelID1 As Long
Dim strSql As String
Dim RnSource As rdoResultset
Dim RnDes As rdoResultset
       #If conWan = 1 Then
            If gVersionType = vtAccount Then
               If gclsBase.ControlAccount Then '控制科目
                  lngModelID = XlngOperatorID + 200000
                  lngModelID1 = 1 + 200000
               Else  '非控制科目
                  If gclsBase.BaseNoControl = True Then
                     lngModelID = XlngOperatorID + 210000
                     lngModelID1 = 1 + 210000
                  Else
                     lngModelID = XlngOperatorID + 200000
                     lngModelID1 = 1 + 200000
                  End If
               End If
            Else
               lngModelID = XlngOperatorID + 20000
               lngModelID1 = 1 + 20000
            End If
       #Else
            If gVersionType = vtAccount Then
               If gclsBase.ControlAccount Then '控制科目
                  lngModelID = XlngOperatorID + 100000
                  lngModelID1 = 1 + 100000
               Else  '非控制科目
                  If gclsBase.BaseNoControl = True Then
                     #If conHos = 1 Then '医疗版
                         lngModelID = XlngOperatorID + 120000
                         lngModelID1 = 1 + 120000
                     #Else
                         lngModelID = XlngOperatorID + 110000
                         lngModelID1 = 1 + 110000
                     #End If
                  Else
                     lngModelID = XlngOperatorID + 100000
                     lngModelID1 = 1 + 100000
                  End If
               End If
            Else
               lngModelID = XlngOperatorID + 10000
               lngModelID1 = 1 + 10000
            End If
       #End If
Dim i As Integer
strSql = "select * from Setting Where lngModuleID = " & lngModelID1
Set RnSource = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
strSql = "select * from Setting"
Set RnDes = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
With RnSource
  If Not .EOF Then
     .MoveFirst
     Do While Not .EOF
        RnDes.AddNew
          RnDes.rdoColumns(0) = lngModelID
          For i = 1 To .rdoColumns.Count - 1
            RnDes.rdoColumns(i) = .rdoColumns(i)
          Next i
        RnDes.Update
        .MoveNext
     Loop
  End If
End With
End Sub
'叛断参数表是否有该结点
Public Function BlnIsHaveNode(ByVal strNode As String, Optional intIndex As Integer = 0) As Boolean
       Dim rec As rdoResultset
       Dim strSql As String
       Dim lngModelID As Long
       
       BlnIsHaveNode = False
       #If conWan = 1 Then
            If gVersionType = vtAccount Then
               If gclsBase.ControlAccount Then '控制科目
                  lngModelID = gclsBase.OperatorID + 200000
               Else  '非控制科目
                  If gclsBase.BaseNoControl = True Then
                     lngModelID = gclsBase.OperatorID + 210000
                  Else
                     lngModelID = gclsBase.OperatorID + 200000
                  End If
               End If
            Else
               lngModelID = gclsBase.OperatorID + 20000
            End If
       #Else
            If gVersionType = vtAccount Then
               If gclsBase.ControlAccount Then '控制科目
                  lngModelID = gclsBase.OperatorID + 100000
               Else  '非控制科目
                  If gclsBase.BaseNoControl = True Then
                     #If conHos = 1 Then '医疗版
                         lngModelID = gclsBase.OperatorID + 120000
                     #Else
                         lngModelID = gclsBase.OperatorID + 110000
                     #End If
                  Else
                     lngModelID = gclsBase.OperatorID + 100000
                  End If
               End If
            Else
               lngModelID = gclsBase.OperatorID + 10000
            End If
       #End If
       strSql = "SELECT * FROM Setting WHERE lngModuleID=" _
                    & lngModelID & " Order By TO_CHAR(strTypeName,'99')"
       Set rec = gclsBase.BaseDB.OpenResultset(strSql) ', dbOpenSnapshot)
       If rec.EOF Then
            InitData
'''       Else
'''            With rec
'''              Dim lngOrder As Long
'''              lngOrder = 1
'''              .MoveFirst
'''              Do While Not .EOF
'''                If EnableMudal(!strSection) Then
'''                   .Edit
'''                   .rdoColumns("strTypeName") = lngOrder
''''                   .rdoColumns("strSetting") = "Y" & lngOrder
'''                   .Update
'''                   lngOrder = lngOrder + 1
'''                End If
'''                .MoveNext
'''              Loop
'''            End With
       End If
       strSql = "SELECT * FROM Setting WHERE lngModuleID=" _
                    & lngModelID & " AND LTrim(strKey)='" & LTrim(strNode) & "'"
       Set rec = gclsBase.BaseDB.OpenResultset(strSql)
        If Not rec.EOF Then
            If Trim(rec!strSetting) <> "" Then
               If EnableMudal(rec!strSection) Then
                    BlnIsHaveNode = True
                    intIndex = Val(Mid(rec!strSetting, 2))
               Else
                    BlnIsHaveNode = False
               End If
            Else
               BlnIsHaveNode = False
            End If
        Else
            BlnIsHaveNode = False
        End If
End Function

Private Sub cmdDownWard_Click()
    Dim intTempIndex1 As Integer
    Dim intTempIndex2 As Integer
    Dim strTempText As String
    Dim blnTempSel As Boolean
    
    cmdUpWard.Enabled = True
    With lstSelectedItem
        intTempIndex1 = .ListIndex                      '当前所选项目的ListIndex
        strTempText = .Text                              '当前项目的Text值
        intTempIndex2 = .ListIndex + 1                  '当前项目的后一个项目
        blnTempSel = .Selected(intTempIndex1)
        
        .RemoveItem intTempIndex1
        .AddItem strTempText, intTempIndex2
        .ListIndex = .NewIndex
        .Selected(.ListIndex) = blnTempSel
        If .ListIndex = .ListCount - 1 Then
            cmdDownWard.Enabled = False
        End If
    End With
End Sub

Private Sub cmdUpWard_Click()
    Dim intTempIndex1 As Integer
    Dim intTempIndex2 As Integer
    Dim strTempText As String
    Dim blnTempSel As Boolean
    
    cmdDownWard.Enabled = True
    With lstSelectedItem
        intTempIndex1 = .ListIndex                      '当前所选项目的ListIndex
        strTempText = .Text                              '当前项目的Text值
        intTempIndex2 = .ListIndex - 1                   '当前项目的前一个项目
        blnTempSel = .Selected(intTempIndex1)
        
        .RemoveItem intTempIndex1
        .AddItem strTempText, intTempIndex2
        .ListIndex = .NewIndex
        .Selected(.ListIndex) = blnTempSel
        If .ListIndex = 0 Then
            cmdUpWard.Enabled = False
        End If
    End With
End Sub

Private Sub Command1_Click(Index As Integer)
    Select Case Index
        Case 0
            SaveData
            '以下暂时屏蔽
            #If conWan = 1 Then
                If frmMain.mnuWindowDiagram.Checked Then
                   frmNavigateWan.RefreshFlowChart
                End If
            #Else
'              #If conPE = 1 Then
'              #Else