salarypolit.frm

金算盘软件代码

        '调用修改凭证模板卡片
        Card.EditCard msgTemplate, mlngTempletID, , 41
        InitLtxtTemplet                   '初始化凭证模板(LtxtTemplet)数据
        ltxtTemplet.SeekId mlngTempletID
    Else
        ShowMsg SSTab1.hwnd, "请选择要修改的凭证模板后再进行修改。", vbInformation, Me.Caption
    End If
End Sub

Private Sub ltxtTemplet_ItemNotExist()
    Dim lngTmpID As Long
    Dim intTmp As Integer
    
    mdlnIsNoItem = True
    intTmp = frmMsgAdd.MsgAddShow("新增凭证模板", "没有凭证模板：'" & ltxtTemplet.Text & "'。")
    If intTmp = vbOK Then
        '调用新增新增凭证模板卡片
        lngTmpID = FrmNewTemplate.AddCard(ltxtTemplet.Text, vbModal, , 41)
        InitLtxtTemplet                      '初始化凭证模板(LtxtTemplet)数据
        ltxtTemplet.SeekId (lngTmpID)
    Else
        ltxtTemplet.Text = ""
    End If
    mdlnIsNoItem = False
End Sub

'初始化凭证类型(ltxtType)数据
Private Sub InitltxtType()
    Dim strSql As String
    Dim recRecordset As rdoResultset
    
    'strSql = "SELECT VoucherType.lngvouchertypeid, VoucherType.strVoucherTypeCode,VoucherType.strVoucherTypeName " & _
             " FROM VoucherType Where VoucherType.blnIsInActive=False AND VoucherType.strVoucherFormat='0'" & _
             " ORDER BY  VoucherType.strVoucherTypeCode "
    strSql = "SELECT VoucherType.lngvouchertypeid, VoucherType.strVoucherTypeCode,VoucherType.strVoucherFormat,VoucherType.strVoucherTypeName " & _
             " FROM VoucherType Where VoucherType.blnIsInActive=0 AND VoucherType.strVoucherFormat='0' " & _
             " ORDER BY  VoucherType.strVoucherTypeCode "
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    ltxtType.ClearRefer
    ltxtType.SeekCol = "1,2,4"
    ltxtType.CodeSort = True
    ltxtType.SQL = strSql
    Set ltxtType.Recordset = recRecordset
    'Set ltxtType.Resultset = recRecordset
    ltxtType.AddRefer "<新增>"
    ltxtType.AddRefer "<修改>"
    ltxtType.AddRefer "<删除>"
    ltxtType.CodeSort = True
    On Error Resume Next
    ltxtType.ColWidth(3) = 0
    If ltxtType.ColWidth(2) < (StrLen("<删除>") + 1) * Me.TextWidth("A") Then
        ltxtType.ColWidth(2) = (StrLen("<删除>") + 1) * Me.TextWidth("A")
    End If
    recRecordset.Close
    Set recRecordset = Nothing
End Sub

Private Sub ltxtType_AddNew()
    Dim lngTmpID As Long
    
    ltxtType.Text = ""
    '调用新增新增凭证类型卡片
    lngTmpID = Card.AddCard(msgVoucherType)
    InitltxtType                '初始化凭证类型(ltxtType)数据
    ltxtType.SeekId (lngTmpID)
End Sub

Private Sub ltxtType_Choose()
    '凭证类型(ltxtType)的选择不为功能项
    If ltxtType.ReferRow <> 0 And ltxtType.ReferRow <> 1 And ltxtType.ReferRow <> 2 Then
        With ltxtType
            If Not IsNull(.TextMatrix(.ReferRow, 1)) Then
                If Trim(.TextMatrix(.ReferRow, 1)) <> "" Then
                    mlngVoucherTypeID = .TextMatrix(.ReferRow, 1)
                End If
            End If
        End With
    End If
End Sub

Private Sub ltxtType_Delete()
    ltxtType.Text = ""
    If mlngVoucherTypeID > 0 Then
    '调用删除凭证类型卡片
    Card.DelCard msgVoucherType, mlngVoucherTypeID
    InitltxtType                    '初始化凭证类型(ltxtType)数据
    Else
        ShowMsg SSTab1.hwnd, "请选择要删除的凭证类型后再进行删除。", vbInformation, Me.Caption
    End If
End Sub

Private Sub ltxtType_Edit()
    ltxtType.Text = ""
    If mlngVoucherTypeID > 0 Then
    '调用修改凭证类型卡片
    Card.EditCard msgVoucherType, mlngVoucherTypeID
    InitltxtType                       '初始化凭证类型(ltxtType)数据
    ltxtType.SeekId mlngVoucherTypeID
    Else
        ShowMsg SSTab1.hwnd, "请选择要修改的凭证类型后再进行修改。", vbInformation, Me.Caption
    End If
End Sub

Private Sub ltxtType_ItemNotExist()
    Dim intTmp As Integer
    Dim lngTmpID As Long
    
    mdlnIsNoItem = True
    intTmp = frmMsgAdd.MsgAddShow("新增凭证类型", "没有凭证类型：'" & ltxtType.Text & "'。")
    If intTmp = vbOK Then
        '调用新增新增凭证类型卡片
        lngTmpID = Card.AddCard(msgVoucherType)
        InitltxtType                  '初始化凭证类型(ltxtType)数据
        ltxtType.SeekId (lngTmpID)
    Else
        ltxtType.Text = ""
    End If
    mdlnIsNoItem = False
End Sub

Private Sub ltxtYear_Change()
    mblnYearIsChange = True
    mblnAccountIsChange(0) = True
End Sub

Private Sub ltxtYear_Choose()
    Dim strSql As String
    Dim recYear As rdoResultset
    Dim strTmpYear As String
    Dim strErr As String
    
    mblnAccountIsChange(0) = True
    strTmpYear = ltxtYear.Text
    strSql = "SELECT AccountYear.intYear, AccountYear.bytPeriodNO " & _
                 " FROM AccountYear WHERE AccountYear.intYear= " & CInt(strTmpYear)
    Set recYear = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recYear.EOF Then
        ltxtYear.Text = strTmpYear
        UpdMonth.Max = recYear!bytPeriodNO
    End If
    recYear.Close
    Set recYear = Nothing
    RefshSalaryList strErr
End Sub

'msgSalarySubject列交换(调整粘贴ltxtDebtor的位置）
Private Sub mclsSalarySubjectGrid_AfterColChange(lngSourCol As Long, lngDestCol As Long)
    Dim intCol As Integer
    Dim blnTmp As Boolean
    
    blnTmp = ltxtDebtor.Visible
    ltxtDebtor.Visible = False
    With msgSalarySubject
        intCol = GetColNO(msgSalarySubject, "借方科目")
        mintFlagRow = .Row
        ltxtDebtorSizeSet msgSalarySubject, .Row, intCol     '重设ltxtDebtor的位置
        ltxtDebtor.Text = .TextMatrix(.Row, intCol)
        ltxtDebtor.Visible = blnTmp
    End With
End Sub

'msgSalarySubject列拖动(调整粘贴ltxtDebtor的位置）
Private Sub mclsSalarySubjectGrid_AfterColResize(lngCol As Long)
    Dim intCol As Integer
    Dim intCount As Integer
    Dim dblSum As Double
    Dim blnTmp As Boolean
    
    blnTmp = ltxtDebtor.Visible
    ltxtDebtor.Visible = False
    With msgSalarySubject
        intCol = GetColNO(msgSalarySubject, "借方科目")
        For intCount = 0 To intCol
            dblSum = dblSum + .ColWidth(intCount)
        Next
        If dblSum <= .width Then              '当前修改列宽是否已经超出列表宽
            mintFlagRow = .Row
            ltxtDebtorSizeSet msgSalarySubject, .Row, intCol
            ltxtDebtor.Text = .TextMatrix(.Row, intCol)
            ltxtDebtor.Visible = blnTmp
        Else
            .LeftCol = .LeftCol + 1           '超出( 列表向前滚动一列 )
            mintFlagRow = .Row
            ltxtDebtorSizeSet msgSalarySubject, .Row, intCol
            ltxtDebtor.Text = .TextMatrix(.Row, intCol)
            ltxtDebtor.Visible = blnTmp
        End If
    End With
End Sub

Private Sub mclsMainControl_ChildActive()
    SetHelpID Me.HelpContextID
End Sub

Private Sub msgSalaryItem_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgSalaryItem
        If Button = vbLeftButton Then
            .RowSel = .Row    '不允许选择多项
        End If
    End With
End Sub

Private Sub msgSalaryList_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim strTmp As String
    Dim intCount As Integer
    
    If KeyCode = 32 Then
        With msgSalaryList
            If .Row > 0 Then
                strTmp = Trim(.TextMatrix(.Row, 1))
                For intCount = 1 To .Rows - 1
                    .TextMatrix(intCount, 1) = ""
                Next
                If strTmp = "" Then
                    .TextMatrix(.Row, 1) = "√"
                Else
                    .TextMatrix(.Row, 1) = ""
                End If
                mblnAccountIsChange(0) = True
                On Error Resume Next
                msgSalaryList.SetFocus
                .col = 1
                .ColSel = .Cols - 1
                On Error GoTo 0
            End If
        End With
    End If
End Sub

Private Sub msgsalaryMoney_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgsalaryMoney
        .RowSel = .Row     '不能选择多行
    End With
End Sub

Private Sub msgSalarySubject_DblClick()
    Dim intCol As Integer
    
    With msgSalarySubject
        If .Row > 0 And .Row < .Rows Then
            intCol = GetColNO(msgSalarySubject, "借方科目")
            If .col = intCol Then
                mintFlagRow = .Row
                ltxtDebtorSizeSet msgSalarySubject, .Row, intCol
                ltxtDebtor.Visible = True
                On Error Resume Next
                ltxtDebtor.SetFocus
                ltxtDebtor.Text = .TextMatrix(.Row, intCol)
                If mlngDebitID(.TextMatrix(.Row, 1), 6) > 0 Then
                    ltxtDebtor.SeekId mlngDebitID(.TextMatrix(.Row, 1), 6)
                End If
            End If
        Else
            ltxtDebtor.Visible = False
        End If
    End With
End Sub

Private Sub msgSalarySubject_KeyPress(KeyAscii As Integer)
    Dim intCol As Integer
    
    intCol = GetColNO(msgSalarySubject, "借方科目")
    With msgSalarySubject
        If .Row > 0 And .Row < .Rows And .col = intCol Then
            Select Case KeyAscii
                Case 13
                    If ltxtDebtor.Visible = True Then
                        ltxtDebtor.Visible = False
                    Else
                        mintFlagRow = .Row
                        ltxtDebtorSizeSet msgSalarySubject, .Row, intCol
                        ltxtDebtor.Visible = True
                        ltxtDebtor.SetFocus
                        ltxtDebtor.Text = .TextMatrix(mintFlagRow, intCol)
                        If mlngDebitID(.TextMatrix(.Row, 1), 6) > 0 Then
                            ltxtDebtor.SeekId mlngDebitID(.TextMatrix(.Row, 1), 6)
                        End If
                    End If
                Case 32
                    mintFlagRow = msgSalarySubject.Row
                    ltxtDebtorSizeSet msgSalarySubject, .Row, intCol
                    ltxtDebtor.Text = ltxtDebtor.Text & " "
                    ltxtDebtor.Visible = True
                    ltxtDebtor.SetFocus
                    ltxtDebtor.Text = .TextMatrix(mintFlagRow, intCol)
                Case 48 To 57
                    mintFlagRow = msgSalarySubject.Row
                    ltxtDebtorSizeSet msgSalarySubject, .Row, intCol
                    mblnIsAccountSelect = False
                    ltxtDebtor.Visible = True
                    ltxtDebtor.SetFocus
                    SendKeys Chr(KeyAscii)
                Case Else
                    mintFlagRow = msgSalarySubject.Row
                    ltxtDebtorSizeSet msgSalarySubject, .Row, intCol
                    ltxtDebtor.Visible = True
                    ltxtDebtor.SetFocus
                    ltxtDebtor.PopRefer
                    ltxtDebtor.Text = .TextMatrix(mintFlagRow, intCol)
                    If mlngDebitID(.TextMatrix(.Row, 1), 6) > 0 Then
                        ltxtDebtor.SeekId mlngDebitID(.TextMatrix(.Row, 1), 6)
                    End If
            End Select
        Else
            ltxtDebtor.Visible = False
        End If
    End With
End Sub

'运算符输入
Private Sub cmdAdd_Click(Index As Integer)
    Dim lngStart As Long
    
    lngStart = txtTurn.SelStart
    Select Case Index
    Case 0
        If txtTurn.SelText = "" Then    '判断是否有选择文本
            With txtTurn
                '判断当前光标位置
                If .SelStart < Len(.Text) Then
                    '在当前光标位置加入运算符（在字符中间）
                    .Text = Left(.Text, .SelStart) & " + " & Right(.Text, Len(.Text) - .SelStart)