frmaccountlist.frm

金算盘软件代码

    With sstCustom
        If mclsList(.Tab).ListSet.ShowListSet(intViewID(.Tab)) Then
            blnIsLoad(.Tab) = False
            sstCustom_Click .Tab
        End If
    End With
End Sub

Private Sub mclsMainControl_EditFilter()
    '筛选
Dim blnFlage(5) As Boolean
With sstCustom
    If mclsList(.Tab).ListSet.ListID < 1 Then mclsList(.Tab).ListSet.SaveList
    Filter.ShowFilter mclsList(.Tab).ListSet.ListID, 1, , , , , blnFlage(.Tab)
    If Not blnFlage(.Tab) Then Exit Sub
    mclsList(.Tab).SaveListSet
    mclsList(.Tab).ListSet.ViewId = intViewID(.Tab)
    mclsList(.Tab).FlexGrid.Cols = 0
    Set datCustom(.Tab).Recordset = GetList(.Tab)
    If Not datCustom(.Tab).Recordset.EOF Then datCustom(.Tab).Recordset.MoveLast
    datCustom(.Tab).Recordset.Close
    'Set datCustom(.Tab).Recordset = Nothing
    mclsList(.Tab).SetFlexGrid
    UpdateMenuStatus
    '初始化查找复合列表框
    mclsList(.Tab).InitcboFindKind
    If chkShowAll.Value = 0 Then mclsList(.Tab).DoShowAll False
    
End With
End Sub


Private Sub mclsMainControl_FilePrintSetup()
    Dim MyPrintSet As PrintClass
    Set MyPrintSet = New PrintClass
    With sstCustom
        Select Case .Tab
            Case 0
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 23, " "
            Case 1
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 55, " "
            Case 2
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 56, " "
            Case 3
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 57, " "
            Case 4
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 58, " "
            Case 5
                MyPrintSet.PrintSetUp gclsBase.BaseDB, mclsList(.Tab).FlexGrid, , , , 59, " "
        End Select
        
    End With
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
    Select Case intIndex
        Case 0
            With frmMain
                If Left(.mnuListReportMenu(0).Caption, 3) = "明细帐" Then
                    ShowQuickBook msgDetail, ListID(sstCustom.Tab)
                Else
                    ShowQuickBook msgDay, ListID(sstCustom.Tab)
                End If
            End With
        Case 2
            Report.ShowListReport 93, 143
        Case 3
           'ShowQuickBook msgTotal, ListID(sstCustom.Tab)
           Report.ShowListReport 265, 223
        Case 4
            Report.ShowListReport 267, 225
    End Select
End Sub
Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    mclsList(sstCustom.Tab).HookProc Msg, wParam, lParam, mclsSubClass
End Sub

Private Sub mclsSubClassForm_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    Dim MinMax As MINMAXINFO

    If Msg = WM_GETMINMAXINFO Then
        CopyMemory MinMax, ByVal lParam, Len(MinMax)
        
        MinMax.ptMinTrackSize.x = 430
        MinMax.ptMinTrackSize.y = 250
        
        CopyMemory ByVal lParam, MinMax, Len(MinMax)
        Result = 0
    End If
End Sub

Private Sub msgCustom5_DblClick()
       With msgCustom5
            If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 Then
               mclsMainControl_EditEdit
            End If
       End With
       
End Sub

'单击FLEXGRID停用列,停用或启用当前记录
Private Sub msgCustom5_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim blnCancel As Boolean
    
    With msgCustom5
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgCustom4_DblClick()
   With msgCustom4
        If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 Then
           mclsMainControl_EditEdit
        End If
   End With
   
End Sub

Private Sub msgCustom4_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgCustom4
        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, x, y
        End If
    End With
End Sub

Private Sub msgCustom4_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgCustom4
        If Button = vbLeftButton Then
            If chkShowAll.Value = 1 And .ColSel > 0 And .MouseRow > 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 msgCustom0_DblClick()
    With msgCustom0
            If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 Then
               mclsMainControl_EditEdit
            End If
       End With
End Sub

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

Private Sub msgCustom0_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgCustom0
        If Button = vbLeftButton Then
            If chkShowAll.Value = 1 And .ColSel > 0 And .MouseRow > 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 msgCustom1_DblClick()
    With msgCustom1
            If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 Then
               mclsMainControl_EditEdit
            End If
       End With
End Sub

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

Private Sub msgCustom1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    With msgCustom1
        If Button = vbLeftButton Then
            If chkShowAll.Value = 1 And .ColSel > 0 And .MouseRow > 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 msgCustom2_DblClick()
    With msgCustom2
            If .MouseRow > 0 And .ColSel > 0 And .MouseCol > 1 Then
               mclsMainControl_EditEdit
            End If
    End With
End Sub

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

Private Sub msgCustom2_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
     With msgCustom2
        If Button = vbLeftButton Then
            If chkShowAll.Value = 1 And .ColSel > 0 And .MouseRow > 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 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 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
        Next
        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).Recordset = GetList(.Tab)
            If Not datCustom(.Tab).Recordset.EOF Then datCustom(.Tab).Recordset.MoveLast
            datCustom(.Tab).Recordset.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 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()
    
    frmAccountListCard.EditCard ListID(sstCustom.Tab)
End Sub

'新增卡片
Private Sub mclsMainControl_EditNew()
    frmAccountListCard.AddCard
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngID As Long
    lngID = ListID(sstCustom.Tab)
    'If mIsShowCard Then
'        If lngID = frmDefineCard.getID Then
'            MsgBox "不能删除当前编辑的付款方式！", vbExclamation
'            frmDefineCard.SetFocus
'            Exit Sub
'        End If
    'End If
   If frmAccountCard.DelCard(ListID(sstCustom.Tab)) Then
        UpDatePreFlage
        With mclsList(sstCustom.Tab).FlexGrid
            .RowHeight(.Row) = 0
            .RowData(.Row) = 1
            .Refresh
            
        End With
        mclsList(sstCustom.Tab).SetFlexRow
        
    End If
    UpdateMenuStatus
    If Not frmAccountCard.Visible Then Unload frmAccountCard
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
    CeaseLower
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()