frmsalarymonneyset.frm

金算盘软件代码

        i = 0
        litMonneySet.SeekCol = "-1,1"
        litMonneySet.ClearRefer
        Do While Not recViewField.EOF
            strText = recViewField!strViewFieldDesc & vbTab _
                & recViewField!lngViewFieldID & vbTab
            litMonneySet.AddRefer strText, i, 1
            '配款项目初始化
            If Val(recSetting!strSetting) = recViewField!lngViewFieldID Then
                litMonneySet.Text = strText
                litMonneySet.ReferRow = i
            End If
            recViewField.MoveNext
            i = i + 1
        Loop
        litMonneySet.ColWidth(2) = 0
    End If
    recViewField.Close
    Set recViewField = Nothing
    '取出扣零级别
    Strsql = "SELECT dblDeductLevel,lngDeductFieldID FROM SalaryList WHERE " _
        & "lngSalaryListID=" & mlngSalarylistID
    'Set recSalaryList = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    Set recSalaryList = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
    mdblDeductLevel = recSalaryList!dblDeductLevel
    recSalaryList.Close
    Set recSalaryList = Nothing
    '根据面额排序，对应选择面额chkMonneySet数组，初始化赋值
    '取出大于或等于扣零级别的面额
    'strSql = "SELECT Val(Left(strKey,Len(strKey)-1)) AS Denomination,strSetting,strKey" _
        & " FROM Setting WHERE lngModuleID=9 AND Right(strKey,1)='元' AND " _
        & "Val(Left(strKey,Len(strKey)-1))>=" & mdblDeductLevel & " ORDER BY " _
        & "(200-Val(Left(strKey,Len(strKey)-1)))"
    'Set recSetting = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    Strsql = "SELECT TO_NUMBER(SUBSTR(strKey,1,LENGTH(strKey)-1)) AS Denomination,strSetting,strKey" _
        & " FROM Setting WHERE lngModuleID=9 AND SUBSTR(strKey,LENGTH(strKey),LENGTH(strKey))='元' AND " _
        & "TO_NUMBER(SUBSTR(strKey,1,LENGTH(strKey)-1))>=" & mdblDeductLevel & " ORDER BY " _
        & "(200-TO_NUMBER(SUBSTR(strKey,1,LENGTH(strKey)-1)))"
    Set recSetting = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
    'recSetting.MoveLast
    'recSetting.MoveFirst
    i = 0
    Do While Not recSetting.EOF
        If recSetting!strSetting = "True" Then
            chkMonneySet(i).Value = True
        Else
            chkMonneySet(i).Value = False
        End If
        i = i + 1
        recSetting.MoveNext
    Loop
    '扣零级别的面额为必选并置灰
    If i > 0 Then
        chkMonneySet(i - 1).Value = True
        chkMonneySet(i - 1).Enabled = False
    End If
    '其他面额为置灰
    Do While i < 12
        chkMonneySet(i).Value = False
        chkMonneySet(i).Enabled = False
        i = i + 1
    Loop
    '扣零项目名称保存
    'strSql = "SELECT ViewField.strViewFieldDesc FROM SalaryList INNER JOIN ViewField ON " _
        & "SalaryList.lngDeductFieldID = ViewField.lngViewFieldID WHERE lngSalaryListID=" _
        & frmSalaryList.SalaryID
    'Set recViewField = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        
    Strsql = "SELECT ViewField.strViewFieldDesc FROM SalaryList , ViewField  " _
        & " WHERE SalaryList.lngDeductFieldID = ViewField.lngViewFieldID AND lngSalaryListID=" _
        & frmSalaryList.SalaryID
    Set recViewField = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
    If Not recViewField.EOF Then
        mstrZeroItemName = recViewField!strViewFieldDesc
        litMonneySet.Text = recViewField!strViewFieldDesc
    Else
        litMonneySet.Text = ""
    End If
    recViewField.Close
    Set recViewField = Nothing
    '初始化来源工资表
    Strsql = "SELECT SalaryList.lngSalaryListID, SalaryList.strSalaryListName FROM SalaryList ORDER BY SalaryList.strDate DESC"
    'Set recSalaryList = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    Set recSalaryList = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
    If Not recSalaryList.EOF Then
        litSalarySource.SeekCol = "-1,2"
        Set litSalarySource.Recordset = recSalaryList
        litSalarySource.ColWidth(1) = 0
        litSalarySource.SeekId mlngSalarylistID
    End If
    recSalaryList.Close
    Set recSalaryList = Nothing
    Strsql = "SELECT SalaryList.lngSalaryListID, SalaryList.strSalaryListName FROM SalaryList WHERE SalaryList.lngSalaryListID= " & mlngSalarylistID
    'Set recSalaryList = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    Set recSalaryList = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
    If Not recSalaryList.EOF Then
        litSalarySource.Text = recSalaryList!strSalaryListName
    End If
    recSalaryList.Close
    Set recSalaryList = Nothing
    SetHelpID Me.hwnd, 60128
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture (140)
    Utility.RemoveFormResPicture (139)
    gclsSys.MainControls.Remove Me               '
    Set mclsMainControl = Nothing                '清除主控对象
    Set mclsFilter = Nothing
    Set frmSalaryMonneySet = Nothing
End Sub

Private Sub litMonneySet_Choose()
    Dim Strsql As String
    Dim recSetting As Recordset
    Dim i As Integer
    '为扣零项目，根据扣零级别初始化选择框
    If mstrZeroItemName = Trim(litMonneySet.TextMatrix(litMonneySet.ReferRow, 1)) Then
        'strSql = "SELECT Val(Left(strKey,Len(strKey)-1)) AS Denomination,strSetting" _
            & " FROM Setting WHERE lngModuleID=9 AND Right(strKey,1)='元' AND " _
            & "Val(Left(strKey,Len(strKey)-1))>=" & mdblDeductLevel & " ORDER BY " _
            & "(200-Val(Left(strKey,Len(strKey)-1)))"
        'Set recSetting = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
                
        Strsql = "SELECT TO_NUMBER(SUBSTR(strKey,1,LENGTH(strKey)-1)) AS Denomination,strSetting" _
            & " FROM Setting WHERE lngModuleID=9 AND Right(strKey,1)='元' AND " _
            & " TO_NUMBER(SUBSTR(strKey,1,Len(strKey)-1))>=" & mdblDeductLevel & " ORDER BY " _
            & "(200-TO_NUMBER(SUBSTR(strKey,1,Len(strKey)-1)))"
        Set recSetting = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
        'recSetting.MoveLast
        'recSetting.MoveFirst
        i = 0
        Do While Not recSetting.EOF
            If recSetting!strSetting = "True" Then
                chkMonneySet(i).Value = True
            Else
                chkMonneySet(i).Value = False
            End If
            i = i + 1
            recSetting.MoveNext
        Loop
        chkMonneySet(i - 1).Enabled = False
        chkMonneySet(i - 1).Value = True
        If i < 11 Then
            For i = i To 11 Step 1
                chkMonneySet(i).Value = False
                chkMonneySet(i).Enabled = False
            Next i
        End If
    Else
        '非扣零项目允许所有面额
        For i = 0 To 11 Step 1
            chkMonneySet(i).Enabled = True
            chkMonneySet(i).Value = True
        Next i
    End If
End Sub

'设置命令按钮是否可用(上一步,下一步)
Private Sub InitCmdarrState()
    If SSTab1.Tab = 0 Then
        cmdArr(1).Enabled = False
        cmdArr(2).Enabled = True
        CmdReset.Visible = False
    End If
    If SSTab1.Tab = 2 Then
        cmdArr(2).Enabled = False
        cmdArr(1).Enabled = True
        CmdReset.Visible = True
    End If
    If SSTab1.Tab = 1 Then
        cmdArr(1).Enabled = True
        cmdArr(2).Enabled = True
        CmdReset.Visible = False
    End If
End Sub

Private Sub litSalarySource_Choose()
    If litSalarySource.ReferRow > -1 Then
        mlngSalarylistID = litSalarySource.TextMatrix(litSalarySource.ReferRow, 1)
    End If
End Sub

Private Sub optSalarySet_Click(Index As Integer)
    If optSalarySet(0).Value = True Then
        mblnDmSalarySet = True
    Else
        mblnDmSalarySet = False
    End If
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
    'Dim recViewField As Recordset
    Dim recViewField As rdoResultset
    Dim Strsql As String
    Dim i As Integer
    Dim strText As String
    'Dim recSetting As Recordset
    Dim recSetting As rdoResultset
    '设置命令按钮是否可用
    InitCmdarrState
    If PreviousTab = 0 Then
        If Trim(litSalarySource.Text) = "" Then
            ShowMsg Me.hwnd, "来源工资表不能为空。", vbInformation, Me.Caption
            SSTab1.Tab = 0
            Exit Sub
        End If
    End If
    If SSTab1.Tab = 1 Then
        'strSql = "SELECT ViewField.lngViewFieldID,ViewField.strViewFieldDesc  FROM ViewField INNER JOIN SalaryField ON " & _
             " ViewField.lngViewFieldID = SalaryField.lngViewFieldID  Where " & _
             " ViewField.strTableName='Salary' AND ViewField.strFieldType='Double' AND ViewField.lngViewID=" & mlngViewID & _
             " AND ViewField.strFieldName<>'Salary.dblNowZero' AND ViewField.strFieldName" & _
             " <>'Salary.dblNowTax' AND ViewField.strFieldName<>'Salary.dblLastZero' " & _
             " And SalaryField.lngSalaryListID = " & mlngSalarylistID
        'Set recViewField = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        
        Strsql = "SELECT ViewField.lngViewFieldID,ViewField.strViewFieldDesc  FROM ViewField , SalaryField  " & _
             " WHERE ViewField.lngViewFieldID = SalaryField.lngViewFieldID  AND " & _
             " ViewField.strTableName='Salary' AND UPPER(ViewField.strFieldType='NUMBER' AND ViewField.lngViewID=" & mlngViewID & _
             " AND ViewField.strFieldName<>'Salary.dblNowZero' AND ViewField.strFieldName" & _
             " <>'Salary.dblNowTax' AND ViewField.strFieldName<>'Salary.dblLastZero' " & _
             " And SalaryField.lngSalaryListID = " & mlngSalarylistID
        Set recViewField = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
        '取出配款项目
        Strsql = "SELECT strSetting FROM Setting WHERE lngModuleID=9 AND strKey='配款项目ID'"
        'Set recSetting = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
        Set recSetting = gclsBase.BaseDB.OpenResultset(Strsql, rdOpenStatic)
        If Not recViewField.EOF Then
            'recViewField.MoveLast
            'recViewField.MoveFirst
            i = 0
            litMonneySet.ClearRefer
            litMonneySet.SeekCol = "-1,1"
            Do While Not recViewField.EOF
                strText = recViewField!strViewFieldDesc & vbTab _
                    & recViewField!lngViewFieldID & vbTab
                litMonneySet.AddRefer strText, i, 1
                '配款项目初始化
                If Val(recSetting!strSetting) = recViewField!lngViewFieldID Then
                    litMonneySet.Text = strText
                    litMonneySet.ReferRow = i
                End If
                recViewField.MoveNext
                i = i + 1
            Loop
            litMonneySet.ColWidth(2) = 0
        End If
        recViewField.Close
        Set recViewField = Nothing
    End If
End Sub
'************************************
'以下对应为条件控件过程
Private Sub CmdReset_Click()
      mclsFilter.CmdReset_Click Me
End Sub
Private Sub dateone_lostfocus()
    If SSTab1.Tab <> 2 Then Exit Sub
    mclsFilter.dateone_lostfocus Me
End Sub
Private Sub ReferText1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
     mclsFilter.ReferText1_MouseDown Me, Button, Shift, x, y
End Sub
Private Sub ReferText2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    mclsFilter.ReferText2_MouseDown Me, Button, Shift, x, y
End Sub
Private Sub ReferText2_ItemNotExist()
    mclsFilter.blnNotExist = True
End Sub
Private Sub tvwFilter_Expand(ByVal Node As ComctlLib.Node)
    mclsFilter.tvwFilter_Expand Me, Node
End Sub
'单击树或者,MsgFilter.Row 改变或者单击
Private Sub tvwFilter_nodeClick(ByVal Node As ComctlLib.Node)
    mclsFilter.tvwFilter_nodeClick Me, Node
End Sub
Private Sub MsgFilter_click()
    mclsFilter.MsgFilter_click Me
End Sub
Private Sub refertext1_Choose()
    mclsFilter.refertext1_Choose Me
End Sub
Private Sub txtfrom_LostFocus()
    If SSTab1.Tab <> 2 Then Exit Sub
    mclsFilter.txtfrom_LostFocus Me
End Sub
Private Sub refertext2_Choose()
    mclsFilter.refertext2_Choose Me
End Sub
Private Sub dateto_lostfocus()
    If SSTab1.Tab <> 2 Then Exit Sub
    mclsFilter.dateto_lostfocus Me
End Sub
Private Sub datefrom_lostfocus()
    If SSTab1.Tab <> 2 Then Exit Sub
   mclsFilter.datefrom_lostfocus Me
End Sub
Private Sub TxtTo_KeyDown(KeyCode As Integer, Shift As Integer)
    mclsFilter.TxtTo_KeyDown Me, KeyCode, Shift
End Sub
Private Sub TxtTo_lostfocus()
    If SSTab1.Tab <> 2 Then Exit Sub
   mclsFilter.TxtTo_lostfocus Me
End Sub