frmacountbook.frm

金算盘软件代码

                                            End If
                                            If intCol = mintQuantityBanCol Then
                                                SetDirect intNowRow, Format(CDbl(.TextMatrix(intNowRow, intCol)), strQuantityFormat), intNowRow, intCol
                                            End If
                                        Else
                                            SetDirect intNowRow, 0
                                        End If

                                        If ((bytQA And 1) <> 0) And ((bytQA And 2) <> 0) Then
                                            If mintPriceBanCol > 0 Then
                                                '数量从库存计量单位转换为最小计量单位后计算单价
                                                If Trim(.TextMatrix(intRow, mintQuantityBanCol)) <> "" And Trim(.TextMatrix(intRow, mintAmountBanCol)) <> "" And Trim(.TextMatrix(intRow, mintAmountBanCol)) <> "0" Then
                                                   If CDbl(.TextMatrix(intRow, mintQuantityBanCol)) * CDbl(.TextMatrix(intRow, mintAmountBanCol)) > 0 Then
                                                      If mclsReportSet.ViewId = 5 Then
                                                         .TextMatrix(intRow, mintPriceBanCol) = .TextMatrix(intRow, mintAmountBanCol) / .TextMatrix(intRow, mintQuantityBanCol)
                                                      Else
                                                         .TextMatrix(intRow, mintPriceBanCol) = Abs(mdblFactor * Abs(.TextMatrix(intRow, mintAmountBanCol)) / (Int(Abs(.TextMatrix(intRow, mintQuantityBanCol))) * mdblFactor + (Abs(.TextMatrix(intRow, mintQuantityBanCol)) - Int(Abs(.TextMatrix(intRow, mintQuantityBanCol)))) * 10 ^ Len(Trim(str(mdblFactor - 1)))))
                                                      End If
                                                   Else
                                                      .TextMatrix(intRow, mintPriceBanCol) = ""
                                                   End If
                                                Else
                                                   .TextMatrix(intRow, mintPriceBanCol) = ""
                                                End If
                                            End If
                                            bytQA = 0
                                        End If
                                        
                                        If CDbl(.TextMatrix(intNowRow, intCol)) = 0 Then
                                             .TextMatrix(intNowRow, intCol) = ""
                                        End If
                                    End If
                                Next intCol
                       End If
                       If intRow Mod 100 = 0 Then
                          Debug.Print intRow & ":", Time
                       End If
                       intRow = intRow + 1
                  '** END OF IF 1 **
                  End If

                  '按年分页
                  If intYear <> mintYear And intYear <> 0 And mintYear <> 0 Then
                      Dim i As Integer, j As Integer, k As Integer

                      If intRow > .Rows - 1 Then
                          intRow = .Rows - 1
                          If mclsReportSet.ReportType = msgDay Then
                             AddDayTotal
                             intRow = intRow + 1
                          End If
                          AddPeriodEnd intRow, True
                          intRow = intRow + 2
                          intOldLastRow = intRow + 1
                      Else
                          intOldLastRow = intRow
                      End If
                      
                      'intOldLastRow = intRow

                      If mintAmountBanCol > 0 Then
                         If IsNumeric(.TextMatrix(intRow - 1, mintAmountBanCol)) Then
                            mlngAmountBalance = CDbl(.TextMatrix(intRow - 1, mintAmountBanCol))
                         Else
                            mlngAmountBalance = 0
                         End If
                      End If
                      If mintQuantityBanCol > 0 Then
                         If IsNumeric(.TextMatrix(intRow - 1, mintQuantityBanCol)) Then
                            mlngQuantityBalance = CDbl(.TextMatrix(intRow - 1, mintQuantityBanCol))
                         Else
                            mlngQuantityBalance = 0
                         End If
                      End If
                      If mintCurrencyBanCol > 0 Then
                         If IsNumeric(.TextMatrix(intRow - 1, mintCurrencyBanCol)) Then
                            mlngCurrencyBalance = CDbl(.TextMatrix(intRow - 1, mintCurrencyBanCol))
                         Else
                            mlngCurrencyBalance = 0
                         End If
                      End If

                      k = 0
                      If mclsReportSet.ReportType = msgTotal Then
                          For i = 0 To intRow
                             If .RowData(i) <> 0 Then
                                k = k + 1
                             End If
                          Next i
                      End If

                      If (intRow Mod intBookRows <> 0 And mclsReportSet.ReportType <> msgTotal) _
                         Or (mclsReportSet.ReportType = msgTotal And (k Mod intBookRows <> 0)) Then

                            j = intBookRows - (intRow Mod intBookRows)
                            If mclsReportSet.ReportType = msgTotal Then
                                j = intBookRows - (k Mod intBookRows)
                                For i = 1 To j
                                    .AddItem "", intRow + i - 1
                                    .RowData(intRow + i - 1) = 2
                                    .TextMatrix(intRow + i - 1, 0) = 0
                                Next i
                            Else
                                For i = 1 To j
                                    .AddItem "", intRow + i - 1
                                    .TextMatrix(intRow + i - 1, 0) = 0
                                Next i
                            End If
                            InitTotalColumn
                            intRow = intRow + j
                      End If
                      mintYear = intYear
                      AddBeginBanlance intRow
                  End If
                  mintYear = intYear
              End If
              
              If RowVisible Then
                  intCount = intCount + 1
              End If
              If mclsReportSet.ReportType = msgTotal Or blnAll Then
                 intEndRow = grdAcntBook.Rows
              End If
           Loop
           mintMastDealRow = intRow
       Else
           Exit Sub
       End If
       .Redraw = True
   End With
   If Not IsFirst Then
      GetPages False
   End If
End Sub

Private Sub ABook_ColumnResize(col As Integer)
  Dim intCol As Integer
  Dim lngWid As Long
  Dim intOldPage As Integer
  
    On Error Resume Next
    If col = -1 Then
       mclsFset.GPaperBorder(6) = ABook.GutterLineWidth
    End If
    If mintSub = 1 Then
       mclsReportSet.ColumnWidth(col + 2) = ABook.width(col) * Screen.TwipsPerPixelX
    Else
       If col <= mclsReportSet.FixColumns - 2 Then
          mclsReportSet.ColumnWidth(col + 2) = ABook.width(col) * Screen.TwipsPerPixelX
       Else
          mclsReportSet.ColumnWidth(mintMastDealCol(mintSub - 1) + col - (mclsReportSet.FixColumns - 2)) = ABook.width(col) * Screen.TwipsPerPixelX
       End If
    End If
    intOldPage = mintNowPage
    lngWid = 0
    For intCol = 0 To ABook.MaxCols - 1
        lngWid = lngWid + ABook.width(intCol)
    Next intCol
    If lngWid > ABook.ColCount Then
        GetPages
        If intOldPage <= mintPages Then
           mintNowPage = intOldPage
           SetData intOldPage
        Else
           SetData
        End If
        InitScrollbar
    Else
        If UBound(mintMastDealCol) > 1 And mintSub <> UBound(mintMastDealCol) Then
            GetPages
            If intOldPage <= mintPages Then
               mintNowPage = intOldPage
               SetData intOldPage
            Else
               SetData
            End If
            InitScrollbar
        End If
    End If
    mblnChanged = True
End Sub

Private Sub ABook_DbClick(Row As Integer)
  Dim intBegin As Integer
  Dim TypeID As Integer, ID As Long
  
    On Error GoTo ErrHandle
    If mclsReportSet.ReportType = msgTotal Then
        mclsReportSet.ReportType = msgDetail
        cmbType.ReferRow = mclsReportSet.ReportType - 1
    Else
        If mintNowPage > UBound(mintMastDealCol) Then
            If mintNowPage Mod UBound(mintMastDealCol) = 0 Then
              intBegin = mintPageRows * (mintNowPage \ UBound(mintMastDealCol) - 1)
            Else
              intBegin = mintPageRows * (mintNowPage \ UBound(mintMastDealCol))
            End If
        Else
            intBegin = 0
        End If
        intBegin = intBegin + Row
        If grdAcntBook.RowData(intBegin) <> 0 Then
            Exit Sub
        End If
        TypeID = CDbl(GetNoXString(grdAcntBook.TextMatrix(intBegin, 0), 1, "/"))
        ID = CDbl(GetNoXString(grdAcntBook.TextMatrix(intBegin, 0), 2, "/"))
        BillPublic.ShowBill1 TypeID, ID
    End If
ErrHandle:
End Sub

Private Sub ABook_FCMouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        mintFCIndex = Index
        '装载自由单元弹出菜单资源
        If ABook.IsMultiSel Then       '如果表头栏目多选
           Report.FreeCellFatSet
           PopupMenu frmMain.mnuListActivity
        End If
    End If
End Sub

Private Sub ABook_FreeCellChanged(Index As Integer)
    If Index > mclsReportSet.HeadFields Then
       Exit Sub
    End If
    mclsReportSet.HeadLeft(Index) = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
    mclsReportSet.HeadTop(Index) = ABook.FCTop(Index) * Screen.TwipsPerPixelY
    mclsReportSet.HeadHeight(Index) = ABook.FCHeight(Index) * Screen.TwipsPerPixelY
    mclsReportSet.HeadWidth(Index) = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
    If Not mblnAlign Then
       mclsReportSet.HeadAlign(Index) = 255
    End If
    If ABook.FCPlace = 1 Then
       mclsReportSet.HeadAlign(Index) = ABook.FCAlignment(Index)
    End If
    mblnChanged = True
End Sub

Private Sub ABook_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        CallReportPopMenu
        PopupMenu frmMain.mnuListReport
    End If
End Sub

Private Sub ABook_RowKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CurRow As Integer)
    If KeyCode = vbKeyReturn Then
       ABook_DbClick CurRow
    End If
End Sub

Private Sub ABook_RowScroll(ByVal Distance As Long)
    Dim lngValue As Long
    lngValue = VScroll.Value + Distance
    If lngValue > VScroll.Max Then
        VScroll.Value = VScroll.Max
    ElseIf lngValue < VScroll.Min Then
        VScroll.Value = VScroll.Min
    Else
        VScroll.Value = lngValue
    End If
End Sub

Private Sub ABook_TableTopChanged(top As Integer)
    If ABook.MaxRows = 0 Then
       Utility.ShowMsg Me.hwnd, "帐册不能移出纸外!", vbInformation + vbOKOnly, App.title
       ABook.GridTop = mclsReportSet.GridTop
       ABook.Refresh
       Exit Sub
    End If

    mclsReportSet.GridTop = ABook.GridTop
    GetDefaultSet
    RefreshData GetOtherCond
End Sub

Private Sub cmbDate_Choose()
    Dim D1 As Date
    Dim D2 As Date
    
    If cmbDate.Text = "自定