frmvoucherlist.frm

金算盘软件代码

'                If CLng(.TextMatrix(intTop, 0)) = lngVoucherID_Cancel Then
'                    If .Rows = intTop + 1 Then '要删除的行是GRID 的最末一行
'                        If intTop = 1 Then     '要删除的行是GRID 的最后一行
'                            mclsMainControl_ToolRefresh
'                            Exit Sub
'                        End If
'                        .RemoveItem (intTop)
'                        Exit Do
'                    Else
'                        .RemoveItem (intTop)
'                    End If
'
'                Else
'                    Exit Do
'                End If
'            Loop
'        End If
'    End With
    
End Sub

'作废
Private Sub mclsMainControl_EditInActive()
    Dim lngVoucherID As Long
    Dim CancelID As Long
    Dim theRow As Long
    Dim strFlag As String
    Dim i As Long
    
    
    If grdList.TextMatrix(grdList.Row, 1) = "√" Then Exit Sub
    If gclsBase.PeriodClosed(gclsBase.BaseDate) Then
       ShowMsg Me.hwnd, "当前会计期间已经结帐，不能再作废凭证！", vbExclamation + MB_SYSTEMMODAL, Me.Caption
       Exit Sub
    End If
    lngVoucherID = GetlngVoucherID()
    If lngVoucherID = -1 Then Exit Sub
    If Not mclsVoucher.GetAllID(lngVoucherID) Then Exit Sub
    If gclsBase.OperatorID <> mclsVoucher.oldlngOperatorID Then
        cMsgBox "不能作废由他人制作的凭证！"
        Exit Sub
    End If
    
    '在非全部显示模式下，作废某条记录后，应将该记录隐去
    With grdList
        If Me.chkShowAll.Value = 0 Then
            If Not mclsVoucher.DeleteVoucher(lngVoucherID, False, strVoucher, , , True) Then Exit Sub
            '在非全部显示模式下，记录只可能进行“作废”操作，因为已作废的记录不可能显示出来
             '作废/取消不成功，退出
            '从本行开始往上、往下找到所有ID相同的行,并隐去
            
            i = .Row
            Do While i > 0
                If CLng(.TextMatrix(i, 0)) = lngVoucherID Then
                    .TextMatrix(i, 1) = "√"
                    .RowHeight(i) = 0
                    i = i - 1
                Else
                    Exit Do
                End If
            Loop
            
            i = .Row
            Do While i <= .Rows - 1
                If CLng(.TextMatrix(i, 0)) = lngVoucherID Then
                    .TextMatrix(i, 1) = "√"
                    .RowHeight(i) = 0
                    i = i + 1
                Else
                    Exit Do
                End If
            Loop
            mclsList.SetFlexRow
        Else '作废栏显示时，应显示作废与否的标志
            If Not mclsVoucher.DeleteVoucher(lngVoucherID, False, strVoucher, , , True) Then Exit Sub
            If mclsVoucher.IsVoid Then '操作前为作废状态
                strFlag = ""
            Else
                strFlag = "√"
            End If
            mclsVoucher.SetVoucherItem "作废", strFlag, .Row, lngVoucherID
        End If
    End With
    mclsMainControl_ToolRefresh
End Sub

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

Private Sub mclsMainControl_EditColumn()
    If mclsList.ListSet.ShowListSet(intViewID) Then
        grdList.Redraw = False
        grdList.FixedCols = 0
        grdList.Cols = 0
        '
'        Set datGrid.Recordset =
            GetList
'        If Not datGrid.Recordset.EOF Then datGrid.Recordset.MoveLast
'        datGrid.Recordset.Close
        mclsList.SetFlexGrid
        
        UpdateMenuStatus
        '初始化查找复合列表框
        mclsList.InitcboFindKind
        If chkShowAll.Value = 0 Then mclsList.DoShowAll False
        grdList.Redraw = True
    End If
    With grdList
        If .Rows > 1 Then
            .Row = 1
            .col = 1
            .ColSel = .Cols - 1
        End If
    End With
    
End Sub

Private Sub mclsMainControl_EditFilter()
    Dim blnFlage As Boolean
    
   '执行过滤
    If mclsList.ListSet.ListID < 1 Then
       mclsList.ListSet.SaveList
       DefaultCurrentDate mclsList.ListSet.ListID, 9975
    End If
    Filter.ShowFilter mclsList.ListSet.ListID, 1, , , , , blnFlage
    If Not blnFlage Then Exit Sub
    grdList.Redraw = False

    mclsList.SaveListSet
    mclsList.ListSet.ViewId = intViewID
    'grdList.Cols = 0
    grdList.FixedCols = 0
    mblnIsFilter = True
'    Set datGrid.Recordset =
        GetList
'    If Not datGrid.Recordset.EOF Then datGrid.Recordset.MoveLast
'    datGrid.Recordset.Close
    mblnIsFilter = False
    mclsList.SetFlexGrid
    UpdateMenuStatus
    blnFilter = True '执行过滤后，设置第一行为高亮行
'    mclsMainControl_ToolRefresh
    With grdList
        If .Rows > 1 Then
            .Row = 1
            .col = 1
            .ColSel = .Cols - 1
        End If
    End With
    
    '初始化查找复合列表框
    mclsList.InitcboFindKind
    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
    grdList.Redraw = True
End Sub



'刷新
Private Sub mclsMainControl_ToolRefresh()
     Dim i As Integer
    Dim strOldText As String
    Dim strOldSort As String
    Dim intOldRow As Integer

    With grdList
         strOldSort = cboFindKind.Text
         strOldText = .TextMatrix(.Row, mclsList.SortCol)
         intOldRow = .Row
         mclsList.SaveListColWidth
         
         Me.MousePointer = vbHourglass
         
         .Redraw = False
          '刷新列表记录
        '.Cols = 0
        .FixedCols = 0
'         Set datGrid.Recordset =
            GetList
'         If Not datGrid.Recordset.EOF Then datGrid.Recordset.MoveLast
'         datGrid.Recordset.Close
         mclsList.SetFlexGrid
         cboFindKind.Text = strOldSort
         .Redraw = False
         If .Rows > 1 Then
            txtfind.Text = strOldText
         End If
'         FormatGrid Me
         
'         FormatNumber
         If chkShowAll.Value = 0 Then mclsList.DoShowAll False
         
         If .Rows > 1 And intOldRow < .Rows And intOldRow <> 0 Then
            .Row = intOldRow
            .col = 0
            .ColSel = .Cols - 1
         ElseIf .Rows > 1 Then  ' (intOldRow > .Rows Or intOldRow = 0) And .Rows > 1 Then
            .col = 0
            .ColSel = .Cols - 1
            .Row = 1
         End If
         
         mclsList.SetFlexRow
         UpdateMenuStatus
         .Redraw = True
    End With
    Me.MousePointer = vbDefault
End Sub

'打印
Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    
'    mblnPrint = True
    HookPaint True
    Set myPrintclass = New PrintClass
    mclsList.ReGetColCaption
    myPrintclass.PrintList gclsBase.BaseDB, mclsList.FlexGrid, 50, Me.Caption & Chr(1) & Trim(gclsBase.BaseName) & Chr(1) & gclsBase.OperatorName    '记帐凭证
    mclsList.AddReGetColCaption
    Set myPrintclass = Nothing
'    mblnPrint = False
    mclsList.DoForm = False
End Sub



'
' 报表菜单
'
Private Sub MakeListReportMenu()
    Dim intCnt As Integer
  
    With frmMain
        For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
            Unload .mnuListReportMenu(intCnt)
        Next
        
        .mnuListReportMenu(0).Caption = "科目汇总表(&A)"
        .mnuListReportMenu(0).Enabled = True
        .mnuListReportMenu(0).Visible = True
        .mnuListReportMenu(0).Checked = False
        
        Load .mnuListReportMenu(1)
        .mnuListReportMenu(1).Caption = "凭证汇总表(&V)"
        .mnuListReportMenu(1).Enabled = True
        .mnuListReportMenu(1).Visible = True
        .mnuListReportMenu(1).Checked = False
'
'         Load .mnuListReportMenu(2)
'        .mnuListReportMenu(2).Caption = "试算平衡表"
'        .mnuListReportMenu(2).Enabled = True
'        .mnuListReportMenu(2).Visible = True
'        .mnuListReportMenu(2).Checked = False
'
    End With
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
    Select Case intIndex
    Case 0:
        mclsMainControl_Report 0
    Case 1:
        mclsMainControl_Report 1
'    Case 2:
'        mclsMainControl_Report 2
    End Select
End Sub

Private Sub mclsMainControl_Report(intReportType As Integer)
    Dim mclsPrintclass As PrintClass
    
    Set mclsPrintclass = New PrintClass
    Select Case intReportType
    Case 0:
         'Report.ShowBalance 1414, 632
         Report.ShowBalance 1783, 680
    Case 1:
         Report.ShowBalance 1483, 680
'    Case 2:
'         Report.ShowBalance 1437, 662
    End Select
    Set mclsPrintclass = Nothing
End Sub

Public Sub RefreshList(theCurrentID As Long)
    Dim i As Long
    '刷新数据
     mclsMainControl_ToolRefresh
    
   '将当前行设置到刷新后的ID=theCurrentID的行
    With grdList
        For i = 1 To .Rows - 1
            If CLng(.TextMatrix(i, 0)) = theCurrentID Then
                theEditRow = i
                GotoRow (i)
                Exit For
            End If
        Next i
    End With
End Sub

'告诉列表：编辑窗口已关闭
Public Sub IAmCLosed()
    mIsShowEdit = False
End Sub

Public Sub HookPaint(Optional ByVal blnPrint As Boolean = False)
    Dim lngVoucherID As Long
    Dim lngRow As Long
    Debug.Print "HookPaintS:" & time
    With grdList
        If .Rows = 1 Then Exit Sub
        If .TopRow = 1 Then
            lngVoucherID = 0
        Else
            If .TopRow > .Rows Then
               .TopRow = .Rows - 1
            End If
            lngRow = CLng(.TopRow - 1) '
            lngVoucherID = CLng(.TextMatrix(lngRow, 0))
        End If
        lngRow = .TopRow
         
'        If grdList.Rows = 1 Then Exit Sub
        
        If blnPrint = True Then
           Do While lngRow < grdList.Rows
              If lngVoucherID <> CLng(.TextMatrix(lngRow, 0)) Then
                 lngVoucherID = CLng(.TextMatrix(lngRow, 0))
              Else
                 If .TextMatrix(lngRow, 2) <> "" Then
                    .TextMatrix(lngRow, 2) = "" '日期
                 End If
                 If .TextMatrix(lngRow, 3) <> "" Then
                    .TextMatrix(lngRow, 3) = "" '凭证号
                 End If
              End If
              lngRow = lngRow + 1
              If lngRow = .Rows Then Exit Do
           Loop
        Else
           Do While .RowIsVisible(lngRow)    'lngRow < grdList.Rows
              If lngVoucherID <> CLng(.TextMatrix(lngRow, 0)) Then
                 lngVoucherID = CLng(.TextMatrix(lngRow, 0))
              Else
                 If .TextMatrix(lngRow, 2) <> "" Then
                    .TextMatrix(lngRow, 2) = "" '日期
                 End If
                 If .TextMatrix(lngRow, 3) <> "" Then
                     .TextMatrix(lngRow, 3) = "" '凭证号
                 End If
              End If
              lngRow = lngRow + 1
              If lngRow = .Rows Then Exit Do
           Loop
        End If
    End With
    If blnFilter And grdList.Rows > 1 Then
        blnFilter = False
'        grdList.SetFocus
        grdList.Row = 1
        grdList.ColSel = grdList.Cols - 1
    End If
    Debug.Print "HookPaintE:" & time
End Sub

Public Function BindingResultSet()
    Me.Hide
     '得到付款条件列表记录集
    GetList
    mclsList.SetFlexGrid
    '初始化查找复合列表框
    mclsList.InitcboFindKind
    mclsList.FlexNoChange = False
    mclsList.FindNoChange = False
    '设置第一行为选定行
    With grdList
        If .Rows > 1 Then grdList.Row = 1
        .col = 0
        .ColSel = .Cols - 1
    End With
    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
    
    UpdateMenuStatus
    Me.Show
    Me.ZOrder 0
End Function