frmsalarylistset.frm

金算盘软件代码

        txtListName.Text = strName
        lngIndex = GetItemListIndex(strName, mlngListID)
        lngListID = mlngListID
    End If
    'strSql = "SELECT ListField.*,ViewField.blnIsFixed FROM ListField INNER " _
         & "JOIN ViewField ON ListField.lngViewFieldID = " _
         & "ViewField.lngViewFieldID WHERE ListField.lngListID=" & lngListID _
         & " ORDER BY ListField.lngListFieldNO"
     strSql = "SELECT ListField.*,ViewField.blnIsFixed FROM ListField ,ViewField " _
         & " WHERE ListField.LngViewFieldID = ViewField.lngViewFieldID " _
         & " AND ListField.lngListID=" & lngListID _
         & " ORDER BY ListField.lngListFieldNO"
     Set recList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
     With recList
         If Not .EOF Then
             .MoveLast
             .MoveFirst
             msgGrid(0).Clear
             msgGrid(1).Clear
             msgGrid(0).Rows = 1
             msgGrid(1).Rows = 1
             For i = 0 To .RowCount - 1
                 'If !blnIsChoosed Then
                 If !blnIsChoosed = 1 Then
                     If Len(Trim(msgGrid(1).Text)) > 0 Then
                         msgGrid(1).AddItem ""
                     End If
                     msgGrid(1).TextMatrix(msgGrid(1).Rows - 1, 0) = !lngListFieldID
                     msgGrid(1).TextMatrix(msgGrid(1).Rows - 1, 1) = !strListFieldDesc
                     msgGrid(1).TextMatrix(msgGrid(1).Rows - 1, 2) = IIf(!blnIsFixed, 1, 0)
                 Else
                     If Len(Trim(msgGrid(0).Text)) > 0 Then
                         msgGrid(0).AddItem ""
                     End If
                     msgGrid(0).TextMatrix(msgGrid(0).Rows - 1, 0) = !lngListFieldID
                     msgGrid(0).TextMatrix(msgGrid(0).Rows - 1, 1) = !strListFieldDesc
                     msgGrid(0).TextMatrix(msgGrid(0).Rows - 1, 2) = IIf(!blnIsFixed, 1, 0)
                 End If
             .MoveNext
             Next
         End If
     End With
     recList.Close
     Set recList = Nothing
     Call InitCmdButton
End Sub

Private Sub cmdCheck_Click(Index As Integer)
    Dim i As Integer
    Select Case Index
    Case 0
        Call Right_One
    Case 1
        Call Right_All
    Case 2
        Call Left_One
    Case 3
        Call Left_All
    Case 4
        With msgGrid(1)
            i = .Row
            If i > 0 Then
                '固定栏与非固定烂交换
                If .TextMatrix(i, 2) <> .TextMatrix(i - 1, 2) Then
                    Exit Sub
                End If
            Else
                Exit Sub
            End If
            Call frmSalaryList.ChangList(False, frmSalaryListSet.msgGrid(1), 2)
            If i > 0 Then
                .Row = i - 1
            Else
                .Row = i
            End If
            .col = 0
            .ColSel = 2
        End With
    Case 5
        With msgGrid(1)
            i = .Row
            If i < .Rows - 1 Then
                '固定栏与非固定烂交换
                If .TextMatrix(i, 2) <> .TextMatrix(i + 1, 2) Then
                    Exit Sub
                End If
            Else
                Exit Sub
            End If
            Call frmSalaryList.ChangList(True, frmSalaryListSet.msgGrid(1), 2)
            If i < .Rows - 1 Then
                .Row = i + 1
            Else
                .Row = i
            End If
            .col = 0
            .ColSel = 2
        End With
    End Select
    Call InitCmdButton
End Sub
Private Sub cmdOK_Click(Index As Integer)
    Dim lngIsOK As Long
    Dim strName As String
    Dim strSql As String
    Select Case Index
    Case 0
        mblnOk = True
        frmSalaryEdit.ListSetOK = True
        Call FinishSet
    Case 1
        mblnOk = False
        If frmSalaryEdit.ListName = "" Or frmSalaryEdit.ListName = "所有栏目" Then
            frmSalaryEdit.ListName = ""
        Else
            strSql = "UPDATE List SET lngOperatorID=-1 WHERE lngOperatorID=" & mlngOperatorID & " AND lngViewID=" & mintSalaryViewID
            gclsBase.ExecSQL strSql
        End If
        Unload Me
    Case 2  '删除设置
        strName = txtListName.Text
        lngIsOK = ShowMsg(Me.hwnd, "是否删除原有的栏目设置'" & strName & "'？", vbQuestion + vbYesNo, Me.Caption)
        If lngIsOK = vbYes Then
            Me.MousePointer = vbHourglass
            DelListSet mlngListID
            InitInputItem
            Me.MousePointer = vbDefault
        Else
            Exit Sub
        End If
    Case 3
        mblnOk = True
        frmSalaryEdit.ListSetOK = True
        Call SaveListSet
    End Select
End Sub

Private Sub Form_Activate()
    SetHelpID Me.HelpContextID
End Sub

Private Sub Form_Load()
    mblnOk = False
    Me.Left = (Screen.width - Me.width) / 2
    Me.top = (Screen.Height - Me.Height) / 2
    msgGrid(0).ColWidth(0) = 0
    msgGrid(1).ColWidth(0) = 0
    msgGrid(0).ColWidth(1) = 1600
    msgGrid(1).ColWidth(1) = 1600
    msgGrid(0).ColWidth(2) = 0
    msgGrid(1).ColWidth(2) = 0
    msgGrid(0).Clear
    msgGrid(1).Clear
    msgGrid(0).Rows = 1
    msgGrid(1).Rows = 1
    mlngListID = frmSalaryEdit.ListID
    With msgGrid(0)
        If Len(Trim(.TextMatrix(0, 1))) > 0 Then
            .ColSel = .Cols - 1
        Else
            .ColSel = 0
        End If
    End With
    With msgGrid(1)
        .ColSel = .Cols - 1
    End With
    Set cmdOK(0).Picture = Utility.GetFormResPicture(1001, 0)
    Set cmdOK(1).Picture = Utility.GetFormResPicture(1002, 0)
    Set cmdCheck(4).Picture = Utility.GetFormResPicture(1019, 0)
    Set cmdCheck(5).Picture = Utility.GetFormResPicture(1020, 0)
    Set Me.Icon = Utility.GetFormResPicture(139, vbResIcon)
    mintSalaryViewID = frmSalaryList.SalaryViewID
    mlngOperatorID = frmSalaryEdit.OperatorID
    mstrListName = frmSalaryEdit.ListName
    mlngSalarylistID = frmSalaryList.SalaryID
'    '栏目设置初始化
'    Call InitInputItem
'    '设置按钮
'    Call InitCmdButton
End Sub
Private Sub FinishSet(Optional blnCheck As Boolean = True)
    Dim strSql As String
    Dim i As Integer
    Dim strInSql As String
    'Dim recList As Recordset
    Dim recList As rdoResultset
    Dim blnSave As Boolean
    Dim strMsg As String
    'Dim recListSet As Recordset
    Dim recListSet As rdoResultset
    Dim strTmp As String
    
    blnSave = True
    If blnCheck Then
        With msgGrid(1)
            If .Rows < 5 Then
                ShowMsg Me.hwnd, "录入栏目至少为1个。", vbInformation, Me.Caption
                Exit Sub
            End If
        End With
        '判断是否保存
        If Trim(txtListName.Text) <> "" And cboInputItem.Text = "所有栏目" Then
            If ShowMsg(Me.hwnd, "是否保存栏目设置？", vbQuestion + vbYesNo, Me.Caption) = vbYes Then
                blnCheck = False
                mlngListID = frmSalaryEdit.ListID
                If ContainErrorChar(txtListName.Text, """") Or ContainErrorChar(txtListName.Text, "'") Or ContainErrorChar(txtListName.Text, "|") Then
                    ShowMsg Me.hwnd, "栏目名称不能包含：“" & """" & ",',|”", vbInformation, Me.Caption
                    txtListName.SetFocus
                    Exit Sub
                End If
                If StrLen(Trim(txtListName.Text)) > 30 Then
                    ShowMsg Me.hwnd, "栏目名称不能超过30个字符。", vbInformation, Me.Caption
                    txtListName.SetFocus
                    Exit Sub
                End If
                '判断是否重名
                'strSql = "SELECT SalaryListSet.lngSalaryListID, List.lngListID, List.lngOperatorID, " & _
                         " List.strListName, List.lngViewID,  SalaryList.strSalaryListName " & _
                         " FROM (List INNER JOIN SalaryListSet ON List.lngListID = SalaryListSet.lngListID) " & _
                         " INNER JOIN SalaryList ON SalaryListSet.lngSalaryListID = SalaryList.lngSalaryListID " & _
                         "  WHERE List.lngViewID = " & mintSalaryViewID & _
                         " AND List.strListName ='" & Trim(txtListName.Text) & "'"
                strSql = "SELECT SalaryListSet.lngSalaryListID, List.lngListID, List.lngOperatorID, " & _
                         " List.strListName, List.lngViewID,  SalaryList.strSalaryListName " & _
                         " FROM List,SalaryListSet,SalaryList " & _
                         " WHERE List.lngListID = SalaryListSet.lngListID " & _
                         " AND SalaryListSet.lngSalaryListID = SalaryList.lngSalaryListID " & _
                         " AND List.lngViewID = " & mintSalaryViewID & _
                         " AND List.strListName ='" & Trim(txtListName.Text) & "'"
                Set recList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer, 64)
                If Not recList.EOF Then
                    strMsg = "工资表" & Trim(recList!strSalaryListName) & "已经使用了此栏目名称。"
                    ShowMsg Me.hwnd, strMsg, vbInformation, Me.Caption
                    Exit Sub
                End If
                recList.Close
                Set recList = Nothing
            Else
                blnSave = False
                If Trim(cboInputItem.Text) = "所有栏目" Then
                    frmSalaryEdit.ListName = ""
                Else
                    frmSalaryEdit.ListName = Trim(cboInputItem.Text)
                End If
            End If
        End If
    End If
    On Error GoTo ErrHandle
    Me.MousePointer = vbHourglass
    gclsBase.BaseWorkSpace.BeginTrans
    If Not blnCheck Then
        strSql = "UPDATE List SET List.lngOperatorID=" & mlngOperatorID _
            & ",strListName='" & Trim(txtListName.Text) & "' WHERE List.lngListID=" _
            & mlngListID
        gclsBase.BaseDB.Execute strSql
        frmSalaryEdit.ListID = mlngListID
        '写对照关系
        strSql = "SELECT SalaryListSet.lngSalaryListID, SalaryListSet.lngListID " & _
                 " FROM SalaryListSet WHERE SalaryListSet.lngListID = " & mlngListID & _
                 " AND SalaryListSet.lngSalaryListID = " & mlngSalarylistID
        Set recListSet = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer, 64)
        If recListSet.EOF Then
            recListSet.AddNew
            recListSet!lngSalaryListID = mlngSalarylistID
            recListSet!lngListID = mlngListID
            recListSet.Update
        End If
    Else
        If cboInputItem.Text <> "所有栏目" Then
            '将当前操作员ID的List记录的操作员置为-1
            strSql = "Update List SET lngOperatorID=-1 WHERE lngOperatorID=" & mlngOperatorID _
                & " AND lngViewID=" & mintSalaryViewID
            gclsBase.BaseDB.Execute strSql
            '将选定的List记录的操作员置为当前操作员
            strSql = "Update List SET strListName='" & Trim(txtListName.Text) _
                & "',lngOperatorID=" & mlngOperatorID & " WHERE lngListID=" & mlngListID
            gclsBase.BaseDB.Execute strSql
            frmSalaryEdit.ListID = mlngListID
        End If
    End If
    If blnSave Then
       frmSalaryEdit.ListName = IIf(Trim(cboInputItem.Text) = "所有栏目" And Trim(txtListName.Text) = "", "", Trim(txtListName.Text))
    End If
    '将所有项目预先置为非选择
    strSql = "Update ListField SET blnIsChoosed=0 WHERE lngListID=" & mlngListID
    gclsBase.BaseDB.Execute strSql
    strInSql = "("
    i = 0
    With msgGrid(1)
        Do While i < .Rows
            strInSql = strInSql & .TextMatrix(i, 0) & ","
            i = i + 1
        Loop
    End With
    strSql = Left(strInSql, Len(strInSql) - 1)
    strSql = strSql & ")"
    '将选择项目置为选择
    '所有项目的顺序号预先置为最大选择号+1
    strSql = "Update ListField SET lngListFieldNO=" & i + 1 & " WHERE lngListID=" _
        & mlngListID
    gclsBase.BaseDB.Execute strSql
    '赋顺序号
    If mlngListID = 0 Then
        mlngListID = frmSalaryEdit.ListID
    End If
    i = 0
    With msgGrid(1)
        Do While i < .Rows
            strTmp = "UPDATE ListField SET blnIsChoosed =1,lngListFieldNO =" & i _
                & " WHERE lngListID=" & mlngListID _
                & " AND LTRIM(RTRIM(ListField.strListFieldDesc))='" & Trim(.TextMatrix(i, 1)) & "'"
            gclsBase.BaseDB.Execute strTmp
            i = i + 1
        Loop
    End With
    gclsBase.BaseWorkSpace.CommitTrans
    Me.MousePointer = vbDefault
    Unload Me
    Exit Sub
ErrHandle:
    Me.MousePointer = vbDefault
    gclsBase.BaseWorkSpace.RollBacktrans
    Resume Next
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Utility.RemoveFormResPicture (1001)
    Utility.RemoveFormResPicture (1002)
    Utility.RemoveFormResPicture (139)
    If Not mblnOk Then
        frmSalaryEdit.ListName = ""
    End If
    Set frmSalaryListSet = Nothing
End Sub

Private Sub msgGrid_Click(Index As Integer)
    With msgGrid(Index)
        If Index = 0 Then
            If Len(Trim(.TextMatrix(0, 1))) = 0 Then
                .ColSel = 0
                Exit Sub
            End If
        End If
        .ColSel = .Cols - 1
    End With
End Sub

Private Sub msgGrid_DblClick(Index As Integer)
    Select Case Index
    Case 1
        With msgGrid(1)