accountlist.frm

金算盘软件代码

            If chkShowall.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
            UpdateMenuStatus
        End If
    End With
End Sub

Private Sub msgCustom3_DblClick()
    With msgCustom3
     If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 And frmMain.mnuEditEdit.Enabled Then
        mclsMainControl_EditEdit
     End If
    End With
End Sub

Private Sub msgCustom3_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim blnCancel As Boolean
    With msgCustom3
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgCustom3_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
     With msgCustom3
        If Button = vbLeftButton Then
            If chkShowall.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
            UpdateMenuStatus
        End If
  End With
End Sub

Private Sub sstCustom_Click(PreviousTab As Integer)
    Dim i As Integer
    Dim blnOldShowAll As Boolean
    With sstCustom
        For i = 0 To 5
            Set mclsList(i).Again = Nothing
            mclsList(i).FlexGrid.TabStop = False
        Next
        
'        If blnIsLoad(.Tab) Then mclsList(.Tab).SaveListSet
        mclsList(.Tab).FlexGrid.TabStop = True
        Set mclsList(.Tab).Again = cmdAgain
        mclsList(.Tab).FlexNoChange = True
        mclsList(.Tab).FindNoChange = True
       blnOldShowAll = mclsList(sstCustom.Tab).ShowAll
      
         '改变钩子对象的作用窗体
        mclsSubClass.hwnd = mclsList(.Tab).FlexGrid.hwnd
        If Not blnIsLoad(.Tab) Then
            mclsList(.Tab).FlexGrid.Redraw = False
            '得到列表记录集
            mclsList(.Tab).ListSet.ViewId = intViewID(.Tab)
            mclsList(.Tab).InitFlexGrid
            Set datCustom(.Tab).Resultset = GetList(.Tab)
            If datCustom(.Tab).Resultset Is Nothing Then
                Unload Me
                Exit Sub
            End If
            If Not datCustom(.Tab).Resultset.EOF Then datCustom(.Tab).Resultset.MoveLast
            datCustom(.Tab).Resultset.Close
           ' Set datCustom(.Tab).Recordset = Nothing
            mclsList(.Tab).SetFlexGrid
           
            '初始化查找复合列表框
            mclsList(.Tab).InitcboFindKind
            '重画窗体
             mclsList(.Tab).FlexGrid.Redraw = False
           ' RedrawForm
            '定位到第一行
            With mclsList(.Tab).FlexGrid
                If .Rows > 1 Then
                    mclsList(sstCustom.Tab).FlexNoChange = False
                    .Row = 1
                    mclsList(sstCustom.Tab).FlexNoChange = True
                End If
                .col = 0
                .ColSel = .Cols - 1
            End With
            
           ' mclsList(.Tab).DoShowAll False
            mclsList(.Tab).DoShowAll blnOldShowAll
            '重画列表线
           ' mclsList(.Tab).gridLineRefresh
            
            UpdateMenuStatus
            blnIsLoad(.Tab) = True
            mclsList(.Tab).FlexGrid.Redraw = True
        Else
            '恢复查找复合列表项
            mblnComboxNoClick = True
            mclsList(.Tab).InitcboFindKind
            mblnComboxNoClick = False
            '恢复查找内容
            If mclsList(.Tab).FlexGrid.Rows > 1 And mclsList(.Tab).FlexGrid.ColSel > 0 Then
                txtFind.Text = mclsList(.Tab).FlexGrid.TextMatrix(mclsList(.Tab).FlexGrid.Row, mclsList(.Tab).SortCol)
            Else
                txtFind.Text = ""
            End If
            UpdateMenuStatus
        End If
        '恢复“全部显示”复选框
        mblnCheckNoChange = True
        chkShowall.Value = IIf(mclsList(.Tab).ShowAll, 1, 0)
        mblnCheckNoChange = False
'
        RedrawForm
        mclsList(.Tab).FlexNoChange = False
        mclsList(.Tab).FindNoChange = False
    End With
End Sub

'
'查找内容 TextBox 控件
'
Private Sub txtFind_Change()
    mclsList(sstCustom.Tab).TextFind txtFind.Text
End Sub

'双击FLEXGRID调用卡片
Private Sub msgPaymentMethod_DblClick()
    With mclsList(sstCustom.Tab).FlexGrid
    If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 Then
        mclsMainControl_EditEdit
    End If
    End With
End Sub

'恢复“停用”列光标
Private Sub msgCustom5_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   With msgCustom5
        If Button = vbLeftButton Then
            If chkShowall.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If x > .ColPos(1) And x < .ColPos(2) Then
                    .MousePointer = flexHourglass
                    mclsMainControl_EditInActive
                    .MousePointer = flexDefault
                End If
            End If
            UpdateMenuStatus
        End If
  End With
  
End Sub
'
'响应主控对象事件
'

'编辑卡片
Private Sub mclsMainControl_EditEdit()
    'intWinFormState = Me.WindowState
    Dim lngID As Long
    lngID = ListID(sstCustom.Tab)
    Me.Enabled = False
    If lngID > 0 Then
        If CheckIDUsed("Account", "lngAccountID", lngID) Then
'            frmAccountListCard.EditCard lngID
            frmAccountCard.EditCard lngID, vbModal
            Set frmAccountCard = Nothing
        Else
            ShowMsg 0, "该会计科目不存在,不能进行修改!", vbExclamation + MB_TASKMODAL, "修改会计科目"
            ToolRefresh sstCustom.Tab
        End If
    End If
    Me.Enabled = True
End Sub

'新增记录卡片
Private Sub mclsMainControl_EditNew()
    intWinFormState = Me.WindowState
'    frmAccountListCard.AddCard , sstCustom.Tab
    frmAccountCard.AddCard , sstCustom.Tab, vbModal
    Set frmAccountCard = Nothing
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngID As Long
    lngID = ListID(sstCustom.Tab)
    If mIsShowCard(0) Then
'        If lngID = frmAccountListCard.getID And lngID > 0 Then
        If lngID = frmAccountCard.getID And lngID > 0 Then
            MsgBox "不能删除当前编辑的会计科目！", vbExclamation
'            frmAccountListCard.Show
'            frmAccountListCard.ZOrder 0
            frmAccountCard.EditCard lngID, vbModal
            Set frmAccountCard = Nothing
            Exit Sub
        End If
    End If
    
'    If frmAccountListCard.DelCard(ListID(sstCustom.Tab)) Then
    If frmAccountCard.DelCard(ListID(sstCustom.Tab), , True) Then
       
        UpDatePreFlage
        With mclsList(sstCustom.Tab).FlexGrid
            .RowHeight(.Row) = 0
            .RowData(.Row) = 1
            .Refresh
            
        End With
        mclsList(sstCustom.Tab).SetFlexRow
        gclsSys.SendMessage Me.hwnd, Message.msgAccount
    End If
    Unload frmAccountCard
    Set frmAccountCard = Nothing
    UpdateMenuStatus
    'If Not frmAccountListCard.Visible Then
'    Unload frmAccountListCard
'    Unload frmAccountCard
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
    CeaseLower
    UpdateMenuStatus
End Sub

'全部显示/显示未停用记录
Private Sub mclsMainControl_EditShowAll()
    frmMain.mnuEditShowAll.Checked = Not frmMain.mnuEditShowAll.Checked
    If chkShowall.Value = 0 Then
        chkShowall.Value = 1
    Else
        chkShowall.Value = 0
    End If
End Sub

'引用编码
Private Sub mclsMainControl_EditUse()
    UseCode Message.msgAccount, ListID(sstCustom.Tab)
    Me.ZOrder 1
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
    mclsList(sstCustom.Tab).ReGetColCaption
    Select Case sstCustom.Tab
        Case 0
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustom.Tab).FlexGrid, 23, "全部科目" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
        Case 1
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustom.Tab).FlexGrid, 55, Mid(sstCustom.TabCaption(1), 1, Len(sstCustom.TabCaption(1)) - 4) & "类科目" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
        Case 2
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustom.Tab).FlexGrid, 56, Mid(sstCustom.TabCaption(2), 1, Len(sstCustom.TabCaption(2)) - 4) & "类科目" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
        Case 3
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustom.Tab).FlexGrid, 57, Mid(sstCustom.TabCaption(3), 1, Len(sstCustom.TabCaption(3)) - 4) & "类科目" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
        Case 4
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustom.Tab).FlexGrid, 58, Mid(sstCustom.TabCaption(4), 1, Len(sstCustom.TabCaption(4)) - 4) & "类科目" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
        Case 5
            myPrintclass.PrintList gclsBase.BaseDB, mclsList(sstCustom.Tab).FlexGrid, 59, Mid(sstCustom.TabCaption(5), 1, Len(sstCustom.TabCaption(5)) - 4) & "类科目" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    End Select
    mclsList(sstCustom.Tab).AddReGetColCaption
    Set myPrintclass = Nothing
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
            frmAccountCopyCard.Show vbModal
            Unload frmAccountCopyCard
            Set frmAccountCopyCard = Nothing
        Case 9:
            mclsMainControl_EditUse
'        Case 10:
'            mclsMainControl_EditSearch
        'Case 10:
            '期初余额定
            'frmAccountInit.Show
        Case 10
            mclsMainControl_EditFilter
        Case 11:
            mclsMainControl_EditColumn
        Case 13:
            mclsMainControl_ToolRefresh
        Case 14:
            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)
        .mnuEditInActive.Checked = False
        Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(4)
        .mnuListEditMenu(4).Caption = "停用(&H)"
        .mnuListEditMenu(4).Visible = True
        
        Load .mnuListEditMenu(5)
'        .mnuEditShowAll.Checked = False
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(5)
        .mnuListEditMenu(5).Caption = "全部显示(&W)"
        .mnuListEditMenu(5).Visible = True
        
        
        
        Load .mnuListEditMenu(6)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(6)
        
        Load .mnuListEditMenu(7)
        .mnuListEditMenu(7).Caption = "科目复制(&K)"
        
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(8)
        .mnuListEdi