frmsalaryedit.frm

金算盘软件代码

        mblnLoad = False
        cboInputItem_Click
    Case 1   '查找
        If mblnFindSort Then Exit Sub
        With mclsSalaryGrid.SalaryDbGridCtrl
            If mblnFindSort Then Exit Sub
            For i = 0 To .Cols - 1 Step 1
                If InStr(Trim(.CellValue(0, i)), Trim(cboEdit(1).Text)) = 1 Then
                    Exit For
                End If
            Next i
            If i = .Cols Then
                Exit Sub
            End If
            If cboEdit(1).ListIndex > -1 Then
                '排序
                Sort (i)
            End If
        End With
    End Select
End Sub
Private Sub cboInputItem_Click()
    Dim strSql As String
    If mblnLoad Then Exit Sub
    Call GetItemListIndex(cboInputItem.Text, mlngListID)
    If cboInputItem.ListIndex > 0 And mlngListID > 0 Then
        '将当前操作员的List记录置为公用
        strSql = "UPDATE List SET lngOperatorID=0 WHERE lngOperatorID=" & mlngOperatorID _
            & " AND lngViewID=" & mintSalaryViewID
        gclsBase.ExecSQL strSql
        strSql = "UPDATE List SET lngOperatorID=" & mlngOperatorID & " WHERE lngListID=" & mlngListID
        gclsBase.ExecSQL strSql
        Call GetListField
        mstrListName = cboInputItem.Text
        Call mnuRefresh
    Else   '所有栏目
        Call Select_All_Item
        Call mnuRefresh
        mstrListName = ""
    End If
End Sub

Private Sub chkAutoCalc_Click()
    mblnAutoCalc = chkAutoCalc.Value
    If chkAutoCalc.Value Then
        If Not mblnIsPostDate Then
            Me.MousePointer = vbHourglass
            Call CalcOldData(mlngSalaryID, True)
            prgBar.Visible = False
            Call mnuRefresh
            Me.MousePointer = vbDefault
        End If
    End If
End Sub

Private Sub cmdEdit_Click(Index As Integer)
    Dim x, y As Single
    Call CreateMenu
    Call RefreshMenu
    x = cmdEdit(Index).Left
    y = cmdEdit(Index).top + cmdEdit(Index).Height
    '激活菜单
    Select Case Index
    Case 0
        PopupMenu frmMain.mnuListEdit, , x, y
    Case 1
        RefreshMenu
        PopupMenu frmMain.mnuListReport, , x, y
    End Select
End Sub

Private Sub cmdFind_Click()
    Dim i As Long
    Dim strFindText As String
    Dim lngOldRow As Long
    Dim lngRow As Long
    Dim strFlag As String
    Dim intDesc As Integer
    Dim strTmp As String
    
    If cboEdit(1).ListIndex > -1 Then
        With mclsSalaryGrid.SalaryDbGridCtrl
            If .Row = 0 Then Exit Sub
            mblnChangeText = True
            i = .Row
            lngOldRow = .Row
            If txtEdit.SelLength > 0 Then
                strFindText = Left(txtEdit.Text, Len(txtEdit.Text) - txtEdit.SelLength)
            Else
                strFindText = txtEdit.Text
            End If
            If .Row < .Rows Then
                If Not IsNull(.CellValue(.Row + 1, mintSortCol)) Then
                    If GetItemType(mintSortCol) = 1 Then
                        intDesc = GetInputItemFieldDec(mintSortCol)
                        If intDesc > 0 Then
                            strFlag = "###,###,##0." & String(intDesc, "0")
                        Else
                            strFlag = "###,###,##0"
                        End If
                        If Val(.CellValue(.Row + 1, mintSortCol)) = 0 Then
                            strTmp = ""
                        Else
                            strTmp = IIf(Trim(Format(.CellValue(.Row + 1, mintSortCol), strFlag)) = "", "", Format(.CellValue(.Row + 1, mintSortCol), strFlag))
                        End If
                    Else
                        strTmp = ""
                    End If
                Else
                    strTmp = ""
                End If
                If strTmp Like strFindText & "*" Then
                    lngRow = .Row + 1
                Else
                    lngRow = .Row
                End If
            Else
                lngRow = .Row
            End If
'            lngRow = FindGridText(strFindText, i)
            If lngRow > 0 And lngRow < .Rows Then
                .Row = lngRow
                If mintSortCol > 4 Then
                    .col = mintSortCol
                Else
                    .col = 5
                End If
                CmdFind.Enabled = True
            Else
                CmdFind.Enabled = False
            End If
            .Refresh
            txtEdit.SelStart = Len(strFindText)
            txtEdit.SelLength = Len(txtEdit.Text) - Len(strFindText)
            mstrFindText = strFindText
            mblnChangeText = False
            '不能再找
            If lngRow = lngOldRow Then
                CmdFind.Enabled = False
            Else
                CmdFind.Enabled = True
            End If
        End With
    End If
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
    gclsSys.CurrFormName = Me.hwnd
    mclsSalaryGrid.SalaryDbGridCtrl.Refresh
    With frmMain
        .mnuEditEdit.Enabled = False
        .mnuEditNew.Enabled = False
        .mnuEditDel.Enabled = False
        .mnuEditFilter = True
        .mnuEditSearch = True
        .mnuEditColumn = True
        .mnuFilePrint.Enabled = True
        .mnuFilePrintSetup.Enabled = True
        .mnuToolRefresh.Enabled = True
        .SetToolBar
    End With
End Sub

Private Sub Form_Load()
    Dim strSql As String
    Dim i As Long
    Dim j As Long
    Dim strName As String
    Dim recSalaryList As rdoResultset
    Dim lngOperatorID As Long
    Dim strWhere As String
    
    Me.MousePointer = vbHourglass
    Set mMenu = gclsSys.MainControls.Add(Me)
    mblnItemSet = False
    mblnLoad = True
    mblnFindSort = False
    mblnEditData = False
    mblnIsSave = True
    mstrListName = ""
    mstrSalaryName = frmSalaryList.SalaryName
    mblnFilter = False
    Me.Height = 6200
    Me.width = 9250
    mblnRefreshGrid = False
    mlngOperatorID = gclsBase.OperatorID
    mlngListID = 0
    mintSalaryViewID = frmSalaryList.SalaryViewID
    '取工资表ID
    mlngSalaryID = frmSalaryList.SalaryID
    '得到当前工资表是否已经结帐
    Call GetSalaryIsPost(mlngSalaryID)
    '初始化视图项目表
    Call InitViewField
    Set mclsSalaryGrid = New SalaryGrid
    Set mclsSalaryGrid.PictureBox = picSalary
    mclsSalaryGrid.SalaryDbGridCtrl.hwnd = picSalary.hwnd
    mclsSalaryGrid.ListSet.ViewId = mintSalaryViewID
    frmSalaryList.SalaryInput = True
    '取工资列表Recordset
    'strSql = "SELECT SalaryList.lngSalaryListID,SalaryList.dblDeductLevel,SalaryList.blnIsMonthDuduct,SalaryList.lngDeductFieldID," _
        & "SalaryList.blnIsTax,SalaryList.lngDeductFieldId,SalaryList.strSalaryListName, Operator.strOperatorName,SalaryList.strDate," _
        & "SalaryList.lngTaxFieldID," & "AccountPeriod.strCloseDate AS strCloseDate FROM AccountPeriod, Operator INNER JOIN SalaryList" _
        & " ON Operator.lngOperatorID=SalaryList.lngOperatorID WHERE cDate(SalaryList.strDate)>=cDate(AccountPeriod.strStartDate) " _
        & "AND cDate(SalaryList.strDate)<=cDate(AccountPeriod.strEndDate) "
    strSql = "SELECT SalaryList.lngSalaryListID,SalaryList.dblDeductLevel,SalaryList.blnIsMonthDuduct,SalaryList.lngDeductFieldID," _
        & "SalaryList.blnIsTax,SalaryList.lngDeductFieldId,SalaryList.strSalaryListName, Operator.strOperatorName,SalaryList.strDate," _
        & "SalaryList.lngTaxFieldID," & "AccountPeriod.strCloseDate AS strCloseDate FROM AccountPeriod, Operator, SalaryList" _
        & " WHERE Operator.lngOperatorID=SalaryList.lngOperatorID " _
        & " AND TO_DATE(SalaryList.strDate,'RRRR-MM-DD')>=TO_DATE(AccountPeriod.strStartDate,'RRRR-MM-DD') " _
        & " AND TO_DATE(SalaryList.strDate,'RRRR-MM-DD')<=TO_DATE(AccountPeriod.strEndDate,'RRRR-MM-DD') "
    strWhere = frmSalaryList.SalaryFilterWhere
    If Trim(strWhere) <> "" Then
        strSql = strSql & " AND (( " & strWhere & ")  OR  ( SalaryList.lngSalaryListID = " & mlngSalaryID & " ))"
    End If
    Set recSalaryList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    '初始化工资名称列表
    If Not recSalaryList.EOF Then
        recSalaryList.MoveLast
        ReDim mlngID(recSalaryList.RowCount)
        i = 0
        cboEdit(0).Clear
        recSalaryList.MoveFirst
        Do While Not recSalaryList.EOF
            If recSalaryList!lngSalaryListID = mlngSalaryID Then
                cboEdit(0).Text = recSalaryList!strSalaryListName
            End If
            mlngID(i) = recSalaryList!lngSalaryListID
            cboEdit(0).AddItem (recSalaryList!strSalaryListName)
            recSalaryList.MoveNext
            i = i + 1
        Loop
    End If
    recSalaryList.Close
    Set recSalaryList = Nothing
    '初始化录入栏目
    Call InitInputItem
    '取消相同操作员的重复记录
    Call CancelOperatorRecord
    '初始化时录入项目为所有栏目
    cboInputItem.ListIndex = 0
    mblnLoad = False
    cboInputItem_Click
    mblnAutoCalc = False
    mblnRefreshGrid = True
    CmdFind.Enabled = True
    Call InitCalc(mlngSalaryID)
    mblnIsLockCol = False
    mlngLockCol = 0
    '是否有工资报表查询权限
    lngOperatorID = gclsBase.OperatorID
    If Not UserRight.IsCanDo(118, lngOperatorID) Then
        cmdEdit(1).Enabled = False
    Else
        cmdEdit(1).Enabled = True
    End If
    mblnDateIsChange = False
    mlngEditViewFieldID = 0
    Me.MousePointer = vbDefault
End Sub
Private Sub Form_Resize()
    Dim lngValue As Long
    Static blnFirstIn As Boolean
    
    On Error Resume Next
    If blnFirstIn = False Then
        blnFirstIn = True
        If blnFirstIn Then
            If Me.WindowState = 1 Then Me.WindowState = 0
        End If
    End If
    If Me.Left + Me.width < 0 Or Me.Left > Screen.width Then
        Me.Left = 300
    End If
    
    If Me.WindowState <> 1 Then
        If Me.width < 7000 Then
            Me.width = 7000
        End If
        If Me.Height < 3500 Then
            Me.Height = 3500
        End If
        txtEdit.width = Me.width - 5280
        cboInputItem.width = Me.width - 4930
        CmdFind.Left = Me.width - 470
        picSalary.width = Me.width - 200
        picSalary.Height = Me.Height - 1620
        
        cmdEdit(0).top = Me.Height - 780
        cmdEdit(1).top = Me.Height - 780
        chkAutoCalc.top = cmdEdit(0).top + 10
        chkAutoCalc.Left = picSalary.Left + picSalary.width - chkAutoCalc.width
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    '调保存栏目宽度
    Call SaveItemWidth
    '重新计算当前工资表
    If mblnDateIsChange Then
        '计算历史数据
        If Not mblnIsPostDate Then
            Me.MousePointer = vbHourglass
            Call CalcOldData(mlngSalaryID, True)
            Me.MousePointer = vbDefault
        End If
    End If
    '调工资列表菜单
    Call frmSalaryList.CreateMenu
    Call frmSalaryList.RefreshMenu
    Utility.RemoveFormResPicture 101
    gclsSys.MainControls.Remove Me
    Set mclsSalaryGrid = Nothing
    frmSalaryList.SalaryInput = False
End Sub

Private Sub mMenu_Print()
    Dim strName As String
    Dim clsPrint As PrintClass
    Dim intSortCol As Integer
    Dim intSortType As Integer