frmsalaryitem.frm

金算盘软件代码

                        Else
                            strInWhere = strInWhere & "," & .TextMatrix(i, 4)
                        End If
                    End If
                End If
                recTmp.Close
                Set recTmp = Nothing
                i = i + 1
            Loop
        End With
        '本次发放的项目
        i = 1
        With msgSalaryItem(1)
            Do While i < .Rows
                strTmp = "SELECT SalaryField.* FROM SalaryField  " & _
                         " WHERE lngSalaryListID=" & lngSalaryID & _
                         " AND LTRIM(RTRIM(SalaryField.lngViewFieldID))=" & Val(.TextMatrix(i, 4))
                Set recTmp = gclsBase.BaseDB.OpenResultset(strTmp, rdOpenDynamic, rdConcurRowVer, 64)
                If recTmp.EOF Then
                    recTmp.AddNew
                    recTmp!lngViewFieldID = .TextMatrix(i, 4)
                    recTmp!lngSalaryFieldNO = i
                    recTmp!lngSalaryListID = lngSalaryID
                    recTmp.Update
                Else
                    recTmp.Edit
                    recTmp!lngSalaryFieldNO = i
                    recTmp.Update
                End If
                recTmp.Close
                Set recTmp = Nothing
                i = i + 1
            Loop
        End With
        '删除非本次项目
        If Trim(strInWhere) <> "" Then
            strSql = "DELETE FROM SalaryField WHERE lngViewFieldID IN" & strInWhere & ")  AND SalaryField.lngSalaryListID = " & lngSalaryID
            gclsBase.BaseDB.Execute strSql
        End If
        frmSalaryEdit.Calc = True
        Unload Me
    Case 1
        mblnFormcloseIsOk = False
        Unload Me
    End Select
End Sub

Private Sub cmdChangList_Click(Index As Integer)
    Select Case Index
    Dim i As Integer
    Dim j As Integer
    Case 0  '右移一个
        If msgSalaryItem(0).RowSel >= msgSalaryItem(0).Row Then
            j = 1
        Else
            j = -1
        End If
        i = msgSalaryItem(0).RowSel - msgSalaryItem(0).Row + j
        For j = j To i Step j
            Call frmSalaryList.DbClickList(frmSalaryItem.msgSalaryItem(0), frmSalaryItem.msgSalaryItem(1), 4, 5, 1)
            If j < 0 And msgSalaryItem(0).Row > 1 And Abs(j) < Abs(i) Then
                msgSalaryItem(0).Row = msgSalaryItem(0).Row - 1
                msgSalaryItem(0).ColSel = 3
            End If
        Next j
    Case 1  '右移全部
        msgSalaryItem(0).Row = 1
        msgSalaryItem(0).ColSel = 3
        Do While (msgSalaryItem(0).TextMatrix(1, 4)) <> ""
            Call frmSalaryList.DbClickList(frmSalaryItem.msgSalaryItem(0), frmSalaryItem.msgSalaryItem(1), 4, 5, 1)
        Loop
    Case 2  '左移一个
        If msgSalaryItem(1).RowSel >= msgSalaryItem(1).Row Then
            j = 1
        Else
            j = -1
        End If
        i = msgSalaryItem(1).RowSel - msgSalaryItem(1).Row + j
        For j = j To i Step j
            Call frmSalaryList.DbClickList(frmSalaryItem.msgSalaryItem(1), frmSalaryItem.msgSalaryItem(0), 4, 5, 1)
            If j < 0 And msgSalaryItem(1).Row > 1 And Abs(j) < Abs(i) Then
                msgSalaryItem(1).Row = msgSalaryItem(1).Row - 1
                msgSalaryItem(1).ColSel = 3
            End If
        Next j
    Case 3  '左移全部
        msgSalaryItem(1).Row = 1
        msgSalaryItem(1).ColSel = 3
        Do While Trim(msgSalaryItem(1).TextMatrix(1, 4)) <> ""
            Call frmSalaryList.DbClickList(frmSalaryItem.msgSalaryItem(1), frmSalaryItem.msgSalaryItem(0), 4, 5, 1)
        Loop
    Case 4
        Call frmSalaryList.ChangList(False, frmSalaryItem.msgSalaryItem(1), 4)
        msgSalaryItem(1).ColSel = 3
    Case 5
        Call frmSalaryList.ChangList(True, frmSalaryItem.msgSalaryItem(1), 4)
        msgSalaryItem(1).ColSel = 3
    End Select
    If Index < 4 Then
        Call InitCmdButton(0)
        Call InitCmdButton(1)
    End If
    mblnItemIsChange = True
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_Load()
    Dim strSql As String
    Dim recSalaryField As rdoResultset
    Dim recViewFieldSalary As rdoResultset
    Dim lngSalaryListID As Long
    Dim mintSalaryViewID As Long
    Dim i As Integer
    Dim lngLen As Long
    
    Me.Left = (Screen.width - Me.width) / 2
    Me.top = (Screen.Height - Me.Height) / 2
    mintSalaryViewID = frmSalaryList.SalaryViewID
    '发放项目初始化
    lngSalaryListID = frmSalaryList.SalaryID
    'strSql = "SELECT ViewField.lngViewFieldID, ViewField.strViewFieldDesc," _
        & " ViewField.strFieldType, ViewField.bytFieldSize,ViewField.bytFieldDec" _
        & " FROM  ViewField INNER JOIN SalaryField ON " _
        & " ViewField.lngViewFieldID = SalaryField.lngViewFieldID" _
        & " WHERE SalaryField.lngSalaryListID=" & lngSalaryListID & " ORDER BY " _
        & " SalaryField.lngSalaryFieldNO"
    strSql = "SELECT ViewField.lngViewFieldID, ViewField.strViewFieldDesc," _
        & " ViewField.strFieldType, ViewField.bytFieldSize,ViewField.bytFieldDec" _
        & " FROM ViewField, SalaryField " _
        & " WHERE ViewField.lngViewFieldID = SalaryField.lngViewFieldID" _
        & " AND SalaryField.lngSalaryListID=" & lngSalaryListID _
        & " ORDER BY SalaryField.lngSalaryFieldNO"
    Set recSalaryField = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    i = 1
    If Not recSalaryField.EOF Then
        Do
            With msgSalaryItem(1)
                If i > 1 Then
                    .AddItem ("")
                End If
                .TextMatrix(i, 0) = recSalaryField!strViewFieldDesc
                Select Case UCase(recSalaryField!strFieldType)
                Case "DOUBLE"
                    .TextMatrix(i, 1) = "数字"
                Case "STRING"
                    .TextMatrix(i, 1) = "文本"
                Case "DATE"
                    .TextMatrix(i, 1) = "日期"
                End Select
                .TextMatrix(i, 2) = recSalaryField!bytFieldSize
                .TextMatrix(i, 3) = recSalaryField!bytFieldDec
                .TextMatrix(i, 4) = recSalaryField!lngViewFieldID
                lngLen = Len(Trim(.TextMatrix(i, 3)))
                .TextMatrix(i, 3) = String(4 - lngLen, " ") & .TextMatrix(i, 3)
            End With
            recSalaryField.MoveNext
            i = i + 1
        Loop Until recSalaryField.EOF
    End If
    recSalaryField.Close
    Set recSalaryField = Nothing
    '工资项目列表
    'strSql = "SELECT ViewField.lngViewFieldID, ViewField.strViewFieldDesc," _
    & " ViewField.strFieldType, ViewField.bytFieldSize,ViewField.bytFieldDec" _
    & " FROM ViewField Where lngViewID=" & mintSalaryViewID & " AND blnIsFixed=False AND " _
    & " lngViewFieldID NOT IN (SELECT ViewField.lngViewFieldID FROM (SalaryField INNER JOIN " _
    & " ViewField ON SalaryField.lngViewFieldID = ViewField.lngViewFieldID) INNER JOIN " _
    & " SalaryList ON SalaryField.lngSalaryListID = SalaryList.lngSalaryListID" _
    & " WHERE SalaryList.lngSalaryListID=" & lngSalaryListID & " )  ORDER BY lngViewFieldID"
    strSql = "SELECT ViewField.lngViewFieldID, ViewField.strViewFieldDesc," _
        & " ViewField.strFieldType, ViewField.bytFieldSize,ViewField.bytFieldDec" _
        & " FROM ViewField Where lngViewID=" & mintSalaryViewID & " AND blnIsFixed=0 AND " _
        & " lngViewFieldID NOT IN (SELECT ViewField.lngViewFieldID FROM SalaryField,ViewField,SalaryList " _
        & " WHERE ( SalaryField.lngViewFieldID = ViewField.lngViewFieldID) " _
        & " AND SalaryField.lngSalaryListID = SalaryList.lngSalaryListID" _
        & " AND SalaryList.lngSalaryListID=" & lngSalaryListID & " )  ORDER BY lngViewFieldID"
    Set recViewFieldSalary = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    i = 1
    If Not recViewFieldSalary.EOF Then
        Do
            With msgSalaryItem(0)
                If i > 1 Then
                    .AddItem ("")
                End If
                .TextMatrix(i, 0) = recViewFieldSalary!strViewFieldDesc
                Select Case UCase(recViewFieldSalary!strFieldType)
                Case "DOUBLE"
                    .TextMatrix(i, 1) = "数字"
                Case "STRING"
                    .TextMatrix(i, 1) = "文本"
                Case "DATE"
                    .TextMatrix(i, 1) = "日期"
                End Select
                .TextMatrix(i, 2) = recViewFieldSalary!bytFieldSize
                .TextMatrix(i, 3) = recViewFieldSalary!bytFieldDec
                .TextMatrix(i, 4) = recViewFieldSalary!lngViewFieldID
                lngLen = Len(Trim(.TextMatrix(i, 3)))
                .TextMatrix(i, 3) = String(4 - lngLen, " ") & .TextMatrix(i, 3)
            End With
            recViewFieldSalary.MoveNext
            i = i + 1
        Loop Until recViewFieldSalary.EOF
    Else
        msgSalaryItem(0).HighLight = flexHighlightNever
        cmdChangList(0).Enabled = False
        cmdChangList(1).Enabled = False
    End If
    recViewFieldSalary.Close
    Set recViewFieldSalary = Nothing
    Call InitCmdButton(1)
    With msgSalaryItem(0)
        .ColWidth(0) = 1500
        .ColWidth(1) = 480
        .ColWidth(2) = 460
        .ColWidth(3) = 700
        .ColWidth(4) = 0
    End With
    With msgSalaryItem(1)
        .ColWidth(0) = 1500
        .ColWidth(1) = 480
        .ColWidth(2) = 460
        .ColWidth(3) = 700
        .ColWidth(4) = 0
    End With
    Set cmdAddItem(0).Picture = Utility.GetFormResPicture(1001, 0)
    Set cmdAddItem(1).Picture = Utility.GetFormResPicture(1002, 0)
    Set cmdChangList(4).Picture = Utility.GetFormResPicture(1019, 0)
    Set cmdChangList(5).Picture = Utility.GetFormResPicture(1020, 0)
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    'SetHelpID Me.hwnd, 10230
    mblnItemIsChange = False
    mblnIsFlag = True
    mblnFormcloseIsOk = False
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim intMsg As Integer
    If mblnItemIsChange And Not mblnFormcloseIsOk Then
        intMsg = ShowMsg(Me.hwnd, "工资发放项目已经发生改变，是否保存？", vbOKCancel + vbDefaultButton1 + vbQuestion, Me.Caption)
        If intMsg = 1 Then
            mblnIsFlag = False
            cmdAddItem_Click 0
        End If
    End If
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (1019)
    Utility.RemoveFormResPicture (1020)
    Utility.RemoveFormResPicture (139)
    Set frmSalaryItem = Nothing
End Sub

Private Sub msgSalaryItem_DblClick(Index As Integer)
    If Index = 1 Then
        Call frmSalaryList.DbClickList(frmSalaryItem.msgSalaryItem(1), frmSalaryItem.msgSalaryItem(0), 4, 5, 1)
    Else
        Call frmSalaryList.DbClickList(frmSalaryItem.msgSalaryItem(0), frmSalaryItem.msgSalaryItem(1), 4, 5, 1)
    End If
    mblnItemIsChange = True
    Call InitCmdButton(0)
    Call InitCmdButton(1)
End Sub
'初始化按钮
Private Sub InitCmdButton(ByVal Index As Integer)
    With msgSalaryItem(Index)
        Select Case Index
        Case 0
            If Trim(.TextMatrix(1, 1)) <> "" Then
                cmdChangList(0).Enabled = True
                cmdChangList(1).Enabled = True
                .HighLight = flexHighlightAlways
            Else
                cmdChangList(0).Enabled = False
                cmdChangList(1).Enabled = False
                .HighLight = flexHighlightNever
            End If
        Case 1
            If Trim(.TextMatrix(1, 1)) <> "" Then
                cmdChangList(2).Enabled = True
                cmdChangList(3).Enabled = True
                cmdChangList(4).Enabled = True
                cmdChangList(5).Enabled = True
                .HighLight = flexHighlightAlways
            Else
                cmdChangList(2).Enabled = False
                cmdChangList(3).Enabled = False
                cmdChangList(4).Enabled = False
                cmdChangList(5).Enabled = False
                .HighLight = flexHighlightNever
            End If
            If .Row = 1 Then
                cmdChangList(4).Enabled = False
            Else
                cmdChangList(4).Enabled = True
            End If
            If .Row = .Rows - 1 Then
                cmdChangList(5).Enabled = False
            Else
                cmdChangList(5).Enabled = True
            End If
        End Select
    End With
End Sub

Private Sub msgSalaryItem_RowColChange(Index As Integer)
    If Index = 1 Then
        Call InitCmdButton(1)
    End If
End Sub
Public Function ShowSalaryItem() As Boolean
    frmSalaryItem.Show vbModal
    ShowSalaryItem = mblnFormcloseIsOk
End Function