frmaccountlist.frm

金算盘软件代码

    UseCode Message.msgAccount, ListID(sstCustom.Tab)
End Sub

'搜索
Private Sub mclsMainControl_EditSearch()
    frmTreeFind.ShowFind
End Sub

'刷新
Private Sub mclsMainControl_ToolRefresh()
    Me.MousePointer = vbHourglass
    ToolRefresh sstCustom.Tab
    Me.MousePointer = vbDefault
End Sub

Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    Select Case sstCustom.Tab
        Case 0
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustom.Tab).FlexGrid, 23, Me.Caption
        Case 1
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustom.Tab).FlexGrid, 55, Me.Caption
        Case 2
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustom.Tab).FlexGrid, 56, Me.Caption
        Case 3
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustom.Tab).FlexGrid, 57, Me.Caption
        Case 4
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustom.Tab).FlexGrid, 58, Me.Caption
        Case 5
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustom.Tab).FlexGrid, 59, Me.Caption
    End Select
End Sub

Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Select Case intIndex
        Case 0:
            mclsMainControl_EditEdit
        Case 1:
            mclsMainControl_EditNew
        Case 2:
            mclsMainControl_EditDel
        Case 4:
            mclsMainControl_EditInActive
        Case 5:
            mclsMainControl_EditShowAll
        Case 7:
            mclsMainControl_EditUse
        Case 8:
            mclsMainControl_EditSearch
        Case 10:
            '期初余额定
            frmAccountInit.Show
        Case 12
            mclsMainControl_EditFilter
        Case 13:
            mclsMainControl_EditColumn
        Case 15:
            mclsMainControl_ToolRefresh
        Case 16:
            mclsMainControl_FilePrint
    End Select
End Sub

'
' 编辑菜单
'
Private Sub MakeListEditMenu()
       Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        
        Utility.CloneMenu .mnuEditEdit, .mnuListEditMenu(0)
        .mnuListEditMenu(0).Caption = "修改(&E)"
        
        Load .mnuListEditMenu(1)
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(1)
        .mnuListEditMenu(1).Caption = "新增(&N)"
        Load .mnuListEditMenu(2)
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2)
        .mnuListEditMenu(2).Caption = "删除(&D)"
        Load .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3)
        
        Load .mnuListEditMenu(4)
        Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(4)
        .mnuListEditMenu(4).Caption = "停用(&H)"
        Load .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(5)
        .mnuListEditMenu(5).Caption = "全部显示(&W)"
        Load .mnuListEditMenu(6)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(6)
        
        Load .mnuListEditMenu(7)
        Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(7)
        '.mnuListEditMenu(7).Caption = "引用"
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditSearch, .mnuListEditMenu(8)
        .mnuListEditMenu(8).Caption = "搜索(&S)"
        
        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9)
        
        Load .mnuListEditMenu(10)
        .mnuListEditMenu(10).Caption = "期初余额(&A)"
        
        Load .mnuListEditMenu(11)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(11)
        
        Load .mnuListEditMenu(12)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(12)
        .mnuListEditMenu(12).Caption = "筛选(&F)"
        Load .mnuListEditMenu(13)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(13)
        .mnuListEditMenu(13).Caption = "栏目设置(&M)"
        
        Load .mnuListEditMenu(14)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(14)
        
        Load .mnuListEditMenu(15)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(15)
        Load .mnuListEditMenu(16)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(16)
    End With
    Dim blnIsNotEmpty As Boolean
    With mclsList(sstCustom.Tab).FlexGrid
        If .Rows > 1 Then
            blnIsNotEmpty = True
            
        Else
            blnIsNotEmpty = False
        End If
    End With
    With frmMain
        .mnuListEditMenu(10).Enabled = blnIsNotEmpty
    End With
End Sub
'
' 报表菜单
'
Private Sub MakeListReportMenu(Optional ByVal strAccount As String = "")
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
            Unload .mnuListReportMenu(intCnt)
        Next
        
        .mnuListReportMenu(0).Caption = "明细帐：" & Trim(strAccount) & "(&A)"
        
        Load .mnuListReportMenu(1)
        Utility.CloneMenu .mnuEditBar2, .mnuListReportMenu(1)
        
        Load .mnuListReportMenu(2)
        .mnuListReportMenu(2).Caption = "科目表一览表(&S)"
        
        Load .mnuListReportMenu(3)
        .mnuListReportMenu(3).Caption = "科目汇总表(&C)"
        
        Load .mnuListReportMenu(4)
        .mnuListReportMenu(4).Caption = "试算平衡表(&B)"
    End With
End Sub

Private Function GetNameStr(msgCommon As MSFlexGrid, strCompare As String) As String
    Dim strDepEmp As String
    Dim i As Integer
    If msgCommon.Row > 0 And msgCommon.ColSel > 0 Then
       With msgCommon
            .Redraw = False
            For i = 1 To .Cols - 1
                If .TextMatrix(0, i) = strCompare Then
                   strDepEmp = .TextMatrix(.Row, i)
                   Exit For
                End If
            Next
            .Redraw = True
       End With
    Else
        strDepEmp = ""
    End If
    GetNameStr = strDepEmp
End Function
Private Sub ToolRefresh(intTab As Integer)
    Dim i As Integer
    Dim strOldText As String
    Dim strOldSort As String
    strOldSort = cboFindKind.Text
    strOldText = mclsList(intTab).FlexGrid.TextMatrix(mclsList(intTab).FlexGrid.Row, mclsList(intTab).SortCol)
    mclsList(intTab).SaveListColWidth
    mclsList(intTab).FlexGrid.Redraw = False
    '刷新列表记录
    mclsList(intTab).FlexGrid.Cols = 0
    Set datCustom(intTab).Recordset = GetList(intTab)
    If Not datCustom(intTab).Recordset.EOF Then datCustom(intTab).Recordset.MoveLast
    datCustom(intTab).Recordset.Close
    'Set datCustom(intTab).Recordset = Nothing
    '设置FlexGrid列表
    mclsList(intTab).SetFlexGrid
    
    '恢复以前排序列
    cboFindKind.Text = strOldSort
    mclsList(intTab).FlexGrid.Redraw = False
    If mclsList(intTab).FlexGrid.Rows > 1 Then
        txtFind.Text = strOldText
    End If
    If chkShowAll.Value = 0 Then mclsList(intTab).DoShowAll False
    '更新菜单状态
    UpdateMenuStatus
    mclsList(intTab).FlexGrid.Redraw = True
    
    
    
  ' 发出付款方式消息
    
  
End Sub

Private Sub txtFind_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim intSelLen As Integer
    If KeyCode = 8 Then
        intSelLen = txtFind.SelLength
        If txtFind.SelStart > 0 Then txtFind.SelStart = txtFind.SelStart - 1
        txtFind.SelLength = intSelLen + 1
    End If
End Sub
Private Sub CeaseLower()
    Dim Flage As String
    Dim Code As String
    Dim strOldSortCol As String
    Dim strOldSortText As String
    Dim intSortCol As Integer
    Dim blnreStore As Boolean
    Dim intResponse As String
    Dim blnRemark As Boolean
    Dim intOldRow As Integer
    blnreStore = False
    
    With mclsList(sstCustom.Tab).FlexGrid
'        .Redraw = False
        strOldSortCol = cboFindKind.Text
        strOldSortText = .TextMatrix(.Row, mclsList(sstCustom.Tab).SortCol)
        intOldRow = .Row
        blnRemark = ListIsInActive(sstCustom.Tab)
        For intSortCol = 2 To .FixedCols - 1
            If .TextMatrix(0, intSortCol) = "科目编码" Then
                Code = .TextMatrix(.Row, intSortCol)
                Exit For
            End If
        Next intSortCol
        If mclsList(sstCustom.Tab).ListSet.ColumnOrderType(intSortCol - 1) <> 1 Then
            cboFindKind.Text = "科目编码" '排序
            txtFind.Text = Code
            blnreStore = True
        End If
        
        Dim intNewRow As Integer
        If UpdateIsActive(sstCustom.Tab, Code, Not blnRemark) Then
            If chkShowAll.Value Then
                If .TextMatrix(.Row, 1) = "" Then
                    .TextMatrix(.Row, 1) = "√"
                Else
                    .TextMatrix(.Row, 1) = ""
                End If
            Else
                .TextMatrix(.Row, 1) = "√"
                .RowHeight(.Row) = 0
              '  mclsList.SetFlexRow
            End If
            Flage = .TextMatrix(.Row, 1)
            If Flage <> "" Then
                intNewRow = .Row + 1
                Code = Code & "-"
                Do
                    If intNewRow > .Rows - 1 Then Exit Do
                    If InStr(1, .TextMatrix(intNewRow, intSortCol), Code) = 0 Then
                         Exit Do
                     Else
                        .TextMatrix(intNewRow, 1) = Flage
                        If chkShowAll.Value <> 1 Then .RowHeight(intNewRow) = 0
                         intNewRow = intNewRow + 1
                     End If
                Loop
    
            Else
                Dim i As Integer
                .TextMatrix(.Row, 1) = Flage
                i = 1
                If .Row < .Rows - 1 Then
                    If .TextMatrix(.Row + 1, intSortCol) Like .TextMatrix(.Row, intSortCol) & "-*" Then
                        intResponse = ShowMsg(Me.hwnd, "是否取消所有下级的停用标记", vbYesNo, Me.Caption)
                        If intResponse = vbYes Then
                            Do Until Not .TextMatrix(.Row + i, intSortCol) Like .TextMatrix(.Row, intSortCol) & "-*"
                                .TextMatrix(.Row + i, 1) = Flage
                                If .Row + i = .Rows - 1 Then
                                    Exit Do
                                Else
                                    i = i + 1
                                End If
                            Loop
                        End If
                    End If
                End If
                If CodePrefix(.TextMatrix(.Row, intSortCol)) <> "" Then
                    Do Until CodePrefix(.TextMatrix(.Row, intSortCol)) = ""
                           ' If .RowHeight(.Row) > 0 Then
                            txtFind.Text = CodePrefix(.TextMatrix(.Row, intSortCol))
                            .TextMatrix(.Row, 1) = Flage
                    Loop
                End If
            End If
'            .Redraw = True
            If chkShowAll.Value <> 1 Then mclsList(sstCustom.Tab).SetFlexRow
            
            gclsSys.SendMessage CStr(Me.hwnd), Message.msgAccount
        End If
        '恢复旧的排序
        If blnreStore Then
            cboFindKind.Text = strOldSortCol
            txtFind.Text = strOldSortText
            If chkShowAll.Value = 1 Then
                .Row = intOldRow
                .ColSel = .Cols - 1
            Else
                .Row = intOldRow - 1
                If .Row > 0 Then .ColSel = .Cols - 1
            End If
        End If
'        .Redraw = True
     End With
End Sub

Private Function UpdateIsActive(ByVal intTab As Integer, ByVal strCode As String, ByVal blnIsInActive As Boolean) As Boolean
   Dim Strsql As String
    If blnIsInActive Then
        Strsql = "UPDATE Account SET blnIsInActive = " & blnIsInActive & " WHERE strAccountcode='" & strCode & "' Or straccountCode like '" & strCode & "-*'"
    Else
        Strsql = "UPDATE Account SET blnIsInActive = " & blnIsInActive & " WHERE strAccountcode  in  ('" & strCode
        Do Until CodePrefix(strCode) = ""
            strCode = CodePrefix(strCode)
            Strsql = Strsql & "','" & strCode
        Loop
        Strsql = Strsql & "')"
    End If
    UpdateIsActive = gclsBase.ExecSQL(Strsql)
End Function

Private Function CurrCodeName(ByVal intTab As Integer) As String
    Dim strCode As String
    Dim strName As String
    Dim i As Integer
    With mclsList(sstCustom.Tab).FlexGrid
        If .Row > 0 Then
            For i = 0 To mclsList(sstCustom.Tab).ListSet.FixColumns - 1
                If .TextMatrix(0, 2 + i) = "科目编码" Then
                    strCode = .TextMatrix(.Row, 2 + i)
                ElseIf .TextMatrix(0, i + 2) = "科目名称" Then
                    strName = .TextMatrix(.Row, 2 + i)
                End If
            Next
        End If
    End With
    CurrCodeName = Trim(strCode) & " " & Trim(strName)
End Function
Private Function GetCol(ByVal strColName As String) As Integer
    Dim i As Integer
    With mclsList(sstCustom.Tab).FlexGrid
         For i = 1 To .Cols - 1
             If .TextMatrix(0, i) = strColName Then
                GetCol = i
                Exit For
             End If
         Next
    End With
End Function
Private Function UpDatePreFlage() As Boolean
    Dim i As Integer
    Dim intOldRow As Integer
    Dim intCol
    Dim strOldSort As String
    Dim strOldCol As String
    Dim Strsql As String
    Dim recTemplete As Recordset
    Dim strOldCode As String
    With mclsList(sstCustom.Tab).FlexGrid
        .Redraw = False
        strOldCol = cboFindKind.Text
        strOldSort = txtFind.Text
        intOldRow = .Row
        strOldCode = CodePrefix(.TextMatrix(.Row, GetCol("科目编码")))
        intCol = GetCol("末级标志")
        If intCol > 0 Then
            Strsql = "select blnIsDetail from account where straccountcode='" & strOldCode & "'"
            Set recTemplete = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenForwardOnly)
            If Not recTemplete.EOF Then
                If recTemplete!blnIsDetail Then
                    If mclsList(sstCustom.Tab).ListSet.ColumnOrderType(GetCol("科目编码") - 1) <> 1 Then cboFindKind.Text = "科目编码"
                    txtFind.Text = strOldCode 'CodePrefix(.TextMatrix(.Row, GetCol("科目编码")))
                    .TextMatrix(.Row, intCol) = "是"
                End If
            End If
            recTemplete.Close
        End If
        cboFindKind.Text = strOldCol
        cboFindKind.Text = strOldCol
        txtFind.Text = strOldSort
        .Row = intOldRow
        .Redraw = True
    End With
End Function