frmactiveset.frm

金算盘软件代码

'                If frmMain.mnuWindowDiagram.Checked Then
'                   FrmNavigate2.RefreshFlowChart
'                End If
'              #End If
            #End If
            Unload Me
        Case 1
            Unload Me
    End Select
End Sub

Private Sub Form_Activate()
    gclsSys.CurrFormName = Me.hwnd
    SetHelpID C2lng(Me.HelpContextID)
End Sub

Private Sub Form_Load()
    On Error GoTo ErrHandle
    Me.HelpContextID = 80012
    Utility.LoadFormResPicture Me
    Set mclsMainControl = gclsSys.MainControls.Add(Me)
    '初始化节点
    '调用保存好的设置
    LoadData
    Exit Sub
    Dim edtErrReturn As ErrDealType
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload Me
    End If
End Sub

Private Sub Form_Resize()
    If Me.Left + Me.width < 0 Or Me.Left > Screen.width Then
       Me.Left = 300
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    Utility.UnLoadFormResPicture Me
    gclsSys.MainControls.Remove Me
    Set mclsMainControl = Nothing
End Sub
'调用保存好的设置
Private Sub LoadData()
    Dim recActive As rdoResultset
    Dim strSql As String
    Dim lngModID As Long
    #If conWan = 1 Then
        If gVersionType = vtAccount Then
           If gclsBase.ControlAccount Then  '控制科目
              lngModID = gclsBase.OperatorID + 200000
           Else  '非控制科目
              If gclsBase.BaseNoControl = True Then
                 lngModID = gclsBase.OperatorID + 210000
              Else
                 lngModID = gclsBase.OperatorID + 200000
              End If
           End If
        Else
           lngModID = gclsBase.OperatorID + 20000
        End If
    #Else
        If gVersionType = vtAccount Then
           If gclsBase.ControlAccount Then  '控制科目
              lngModID = gclsBase.OperatorID + 100000
           Else  '非控制科目
              If gclsBase.BaseNoControl = True Then
                  #If conHos = 1 Then '医疗版
                       lngModID = gclsBase.OperatorID + 120000
                  #Else
                       lngModID = gclsBase.OperatorID + 110000
                  #End If
              Else
                 lngModID = gclsBase.OperatorID + 100000
              End If
           End If
        Else
           lngModID = gclsBase.OperatorID + 10000
        End If
    #End If
    strSql = "select * from setting where lngmoduleid=" & lngModID & _
              " order by TO_NUMBER(Setting.strTypeName) "
    Set recActive = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    If recActive.EOF Then
       recActive.Close
       InitData
       strSql = "select * from setting where lngmoduleid=" & lngModID & _
              " order by TO_NUMBER(Setting.strTypeName) "
       Set recActive = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    End If
    recActive.MoveLast
    recActive.MoveFirst
    With lstSelectedItem
        Do While Not recActive.EOF
           If IsHaveNode(recActive!strSection) Then
              .AddItem recActive!strKey
              If Trim(recActive!strSetting) <> "" Then
                .Selected(.NewIndex) = True
              Else
                .Selected(.NewIndex) = False
              End If
           End If
           recActive.MoveNext
        Loop
    .ListIndex = 0
    End With
    
End Sub

Private Function IsHaveNode(ByVal strNode As String) As Boolean
        Dim strActive As String
        
        If gVersionType = vtAccount Then    ''InCome','Pay','CashBank',
           If gclsBase.ControlAccount = False Then  '非控制科目
              If gclsBase.BaseNoControl = True Then
                  strActive = "'Account','Salary','FixedAssets'," & _
                       "'LeaderLook','AnalysofFinances','InfoOFBusiness'ELECTRICTABLE','Busssiness'"
              Else
                  strActive = "'Account',InCome','Pay','CashBank','Salary','FixedAssets'," & _
                       "'LeaderLook','AnalysofFinances','InfoOFBusiness'ELECTRICTABLE','Busssiness'"
              End If
           Else  '控制科目
              strActive = "'Account',InCome','Pay','CashBank','Salary','FixedAssets'," & _
                     "'LeaderLook','AnalysofFinances','InfoOFBusiness'ELECTRICTABLE','Busssiness'"
           End If
        Else
           strActive = "'Account','InCome','Pay','CashBank','Salary','FixedAssets'," & _
                     "'LeaderLook','AnalysofFinances','InfoOFBusiness'ELECTRICTABLE'," & _
                     "'Purchase','Sale','Stock','LendProcess','AnalysofManage','Busssiness'"
        End If
        If InStr(1, strActive, strNode) = 0 Then
           IsHaveNode = False
        Else
           IsHaveNode = True
        End If
End Function


'初始化参数表
Public Sub InitData()
    Dim strSql As String
    Dim recActive As rdoResultset
    Dim lngModID As Long
    Dim i As Integer
    Dim intPos As Integer
    
    '注类型保存版本信息，0表示所有版本，1表示标准版专用
    #If conWan = 1 Then
        If gVersionType = vtAccount Then
           If gclsBase.ControlAccount Then  '控制科目
              lngModID = gclsBase.OperatorID + 200000
           Else  '非控制科目
              If gclsBase.BaseNoControl = True Then
                 lngModID = gclsBase.OperatorID + 210000
              Else
                 lngModID = gclsBase.OperatorID + 200000
              End If
           End If
        Else
           lngModID = gclsBase.OperatorID + 20000
        End If
    #Else
        If gVersionType = vtAccount Then
           If gclsBase.ControlAccount Then  '控制科目
              lngModID = gclsBase.OperatorID + 100000
           Else  '非控制科目
              If gclsBase.BaseNoControl = True Then
                  #If conHos = 1 Then '医疗版
                     lngModID = gclsBase.OperatorID + 120000
                  #Else
                     lngModID = gclsBase.OperatorID + 110000
                  #End If
              Else
                 lngModID = gclsBase.OperatorID + 100000
              End If
           End If
        Else
           lngModID = gclsBase.OperatorID + 10000
        End If
    #End If
    strSql = "select * from setting where lngmoduleid=" & lngModID
    Set recActive = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    If Not recActive.EOF Then Exit Sub
    If recActive.EOF Then
       strSql = "insert into setting values(" & _
           lngModID & ",'Account','帐务',' ','1')"
       gclsBase.BaseDB.Execute strSql
       
    'next if Construction is modfied by ozj
    If gVersionType = vtAccount Then 'ozj
       If gclsBase.ControlAccount = True Then '控制科目
          strSql = "insert into setting values(" & _
                  lngModID & ",'InCome','应收',' ','2')"
          gclsBase.BaseDB.Execute strSql
    
          strSql = "insert into setting values(" & _
                lngModID & ",'Pay','应付',' ','3')"
          gclsBase.BaseDB.Execute strSql
     
          strSql = "insert into setting values(" & _
               lngModID & ",'CashBank','现金银行',' ','4')"
          gclsBase.BaseDB.Execute strSql
       Else  '非控制科目(在非控制科目下，若发现gclsBase.BaseNoControl = False时，则按控制科目处理)
          If gclsBase.BaseNoControl = False Then
              strSql = "insert into setting values(" & _
                      lngModID & ",'InCome','应收',' ','2')"
              gclsBase.BaseDB.Execute strSql
        
              strSql = "insert into setting values(" & _
                    lngModID & ",'Pay','应付',' ','3')"
              gclsBase.BaseDB.Execute strSql
         
              strSql = "insert into setting values(" & _
                   lngModID & ",'CashBank','现金银行',' ','4')"
              gclsBase.BaseDB.Execute strSql
          End If
       End If
    Else
        strSql = "insert into setting values(" & _
                  lngModID & ",'InCome','应收',' ','2')"
          gclsBase.BaseDB.Execute strSql
    
          strSql = "insert into setting values(" & _
                lngModID & ",'Pay','应付',' ','3')"
          gclsBase.BaseDB.Execute strSql
     
          strSql = "insert into setting values(" & _
               lngModID & ",'CashBank','现金银行',' ','4')"
          gclsBase.BaseDB.Execute strSql
    End If 'ozj
       strSql = "insert into setting values(" & _
           lngModID & ",'Salary','工资',' ','5')"
       gclsBase.BaseDB.Execute strSql
       
       strSql = "insert into setting values(" & _
           lngModID & ",'FixedAssets','固定资产',' ','6')"
       gclsBase.BaseDB.Execute strSql
        
       strSql = "insert into setting values(" & _
           lngModID & ",'LeaderLook','领导查询',' ','7')"
       gclsBase.BaseDB.Execute strSql
       
       strSql = "insert into setting values(" & _
           lngModID & ",'AnalysofFinances','财务分析',' ','8')"
       gclsBase.BaseDB.Execute strSql
       strSql = "insert into setting values(" & _
           lngModID & ",'InfoOFBusiness','企业资料',' ','9')"
       gclsBase.BaseDB.Execute strSql
       
       strSql = "insert into setting values(" & _
           lngModID & ",'ELECTRICTABLE','电子表格',' ','10')"
       gclsBase.BaseDB.Execute strSql
       
        
       #If conVersionType <> 16 Then
           

           
           strSql = "insert into setting values(" & _
                lngModID & ",'Purchase','采购',' ','11')"
            gclsBase.BaseDB.Execute strSql
            strSql = "insert into setting values(" & _
                lngModID & ",'Sale','销售',' ','12')"
            gclsBase.BaseDB.Execute strSql
            strSql = "insert into setting values(" & _
                lngModID & ",'Stock','库存',' ','13')"
            gclsBase.BaseDB.Execute strSql
            strSql = "insert into setting values(" & _
                lngModID & ",'LendProcess','委托加工',' ','14')"
            gclsBase.BaseDB.Execute strSql
            strSql = "insert into setting values(" & _
                lngModID & ",'AnalysofManage','经营分析',' ','15')"
            gclsBase.BaseDB.Execute strSql
         #End If
        
        intPos = 0
        strSql = "select * from setting where lngmoduleid=" & lngModID & _
                 " order by TO_NUMBER(Setting.strTypeName)"
        Set recActive = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
        '根据加密狗设置权限
        With recActive
            .MoveLast
            .MoveFirst
            Do While Not .EOF
                '读加密狗
                If EnableMudal(!strSection) Then
                   intPos = intPos + 1
                   .Edit
                   !strSetting = "Y" & intPos
                   .Update
                End If
                .MoveNext
            Loop
        End With
   End If
    recActive.Close
    Set recActive = Nothing
End Sub
Private Function TranListItem(ByVal strListName As String) As String
    Select Case Trim(strListName)
           Case "帐务"
                TranListItem = "Account"
           Case "应收"
                TranListItem = "InCome"
           Case "应付"
                TranListItem = "Pay"
           Case "现金银行"
                TranListItem = "CashBank"
           Case "工资"
                TranListItem = "Salary"
           Case "固定资产"
                TranListItem = "FixedAssets"
           Case "领导查询"
                TranListItem = "LeaderLook"
           Case "财务分析"
                TranListItem = "AnalysofFinances"
           Case "企业资料"
                TranListItem = "InfoOFBusiness"
           Case "电子表格"
                TranListItem = "ELECTRICTABLE"
           Case "采购"
                TranListItem = "Purchase"
           Case "销售"
                TranListItem = "Sale"
           Case "库存"
                TranListItem = "Stock"
           Case "委托加工"
                TranListItem = "LendProcess"
           Case "经营分析"
                TranListItem = "AnalysofManage"
    End Select
    
End Function
Private Sub SaveData()
    Dim strAll As String
    Dim lngModeID As Long
    Dim intI As Integer
    Dim strSql As String
    Dim intPos As Integer
    
    intPos = 0
    #If conWan = 1 Then
        If gVersionType = vtAccount Then
           If gclsBase.ControlAccount Then  '控制科目
              lngModeID = gclsBase.OperatorID + 200000
           Else  '非控制科目
              If gclsBase.BaseNoControl = True Then
                 lngModeID = gclsBase.OperatorID + 210000
              Else
                 lngModeID = gclsBase.OperatorID + 200000
              End If
           End If
        Else
           lngModeID = gclsBase.OperatorID + 20000
        End If
    #Else
        If gVersionType = vtAccount Then
           If gclsBase.ControlAccount Then  '控制科目
              lngModeID = gclsBase.OperatorID + 100000
           Else  '非控制科目
              If gclsBase.BaseNoControl = True Then
                  #If conHos = 1 Then '医疗版
                     lngModeID = gclsBase.OperatorID + 120000
                  #Else
                     lngModeID = gclsBase.OperatorID + 110000
                  #End If
              Else
                 lngModeID = gclsBase.OperatorID + 100000
              End If
           End If
        Else
           lngModeID = gclsBase.OperatorID + 10000
        End If
    #End If
    '先将所有权限置为False
    strSql = "UPDATE Setting SET strSetting=' ' WHERE lngModuleID=" & lngModeID
    gclsBase.ExecSQL strSql
    With lstSelectedItem
         For intI = 0 To .ListCount - 1
             If .Selected(intI) = True And EnableMudal(TranListItem(.list(intI))) Then
                intPos = intPos + 1
                strSql = "UPDATE Setting SET strSetting='Y" & intPos & _
                       "',strTypeName='" & intI + 1 & "' WHERE lngModuleID=" _
                       & lngModeID & " AND LTrim(strKey)='" & .list(intI) & "'"
             Else
                strSql = "UPDATE Setting SET strSetting='" & IIf(.Selected(intI), "Y", " ") & _
                       "',strTypeName='" & intI + 1 & "' WHERE lngModuleID=" _
                       & lngModeID & " AND LTrim(strKey)='" & .list(intI) & "'"
             End If
             gclsBase.ExecSQL strSql
         Next intI
    End With
End Sub

Private Sub lstSelectedItem_Click()
    If lstSelectedItem.ListIndex < 0 Then
       cmdUpWard.Enabled = False
       cmdDownWard.Enabled = False
    ElseIf lstSelectedItem.ListIndex = 0 Then
       cmdUpWard.Enabled = False
       cmdDownWard.Enabled = True
    ElseIf lstSelectedItem.ListIndex = lstSelectedItem.ListCount - 1 Then
       cmdUpWard.Enabled = True
       cmdDownWard.Enabled = False
    Else
       cmdUpWard.Enabled = True
       cmdDownWard.Enabled = True
    End If
End Sub