frmmultiaccountbook.frm

金算盘软件代码

            If (mintSub = 1 And intCount <= mintMastDealCol(1)) Or _
               (intCount > mintMastDealCol(mintSub - 1) And intCount <= mintMastDealCol(mintSub)) Then
                       blnCombine = True
                       blnIsNum = True
                       If InStr(1, mSubColDesc(intCount - (mclsMultiReportSet.Columns - 1)), "借/货") > 0 Then
                           blnIsNum = False
                       End If
                       If mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1)) = "" Then
                           blnCombine = False
                       Else
                           If intCount < mintMastDealCol(UBound(mintMastDealCol)) Then
                              If Not (mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1)) <> "" And _
                                (mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1) + 1) = mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1)) Or _
                                 mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1) - 1) = mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1)))) Then
                                  blnCombine = False
                              End If
                           Else
                              If (mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1) - 1) = "") Or Not _
                              (mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1) - 1) <> "" And mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1) - 1) = _
                               mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1))) Then
                                  blnCombine = False
                              End If
                           End If
                       End If
                       
                       If intCount = mintMastDealCol(UBound(mintMastDealCol)) Then
                            blnTwoLine = True
                       Else
                            If (mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1) + 1) <> mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1))) _
                            Or ColIsCash(mSubColDesc(intCount - (mclsMultiReportSet.Columns - 1) + 1)) Then
                                blnTwoLine = True
                            Else
                                blnTwoLine = False
                            End If
                       End If
                       If Not blnCombine Then
                           blnCash = ColIsCash(mSubColDesc(intCount - (mclsMultiReportSet.Columns - 1)))
                           If mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1)) <> "" Then
                              SetBookField intCol, mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1)), , , mlngMultiWid(intCount - (mclsMultiReportSet.Columns - 1)) / Screen.TwipsPerPixelX, , blnTwoLine, blnCash, blnIsNum
                           Else
                              SetBookField intCol, mSubColDesc(intCount - (mclsMultiReportSet.Columns - 1)), , , mlngMultiWid(intCount - (mclsMultiReportSet.Columns - 1)) / Screen.TwipsPerPixelX, , blnTwoLine, blnCash, blnIsNum
                           End If
                       Else
                           blnCash = ColIsCash(mSubColDesc(intCount - (mclsMultiReportSet.Columns - 1)))
                           If blnCash Then
                              blnTwoLine = blnCash
                           End If
                           If intCount < mintMastDealCol(UBound(mintMastDealCol)) Then
                              If mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1) + 1) = mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1)) Then
                                 SetBookField intCol, strReplace(mSubColDesc(intCount - (mclsMultiReportSet.Columns - 1)), mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1)), ""), mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1)), , mlngMultiWid(intCount - (mclsMultiReportSet.Columns - 1)) / Screen.TwipsPerPixelX, True, blnTwoLine, blnCash, blnIsNum
                              Else
                                 SetBookField intCol, strReplace(mSubColDesc(intCount - (mclsMultiReportSet.Columns - 1)), mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1)), ""), , , mlngMultiWid(intCount - (mclsMultiReportSet.Columns - 1)) / Screen.TwipsPerPixelX, , blnTwoLine, blnCash, blnIsNum
                              End If
                           Else
                              SetBookField intCol, strReplace(mSubColDesc(intCount - (mclsMultiReportSet.Columns - 1)), mSubColCombine(intCount - (mclsMultiReportSet.Columns - 1)), ""), , , mlngMultiWid(intCount - (mclsMultiReportSet.Columns - 1)) / Screen.TwipsPerPixelX, , blnTwoLine, blnCash, blnIsNum
                           End If
                       End If
                       intCol = intCol + 1
               End If
        Next intCount
        '** END OF IF 2 **
        End If
    End If
    '** END OF IF 有分析栏目
    End If
End Sub

'子栏目标题设置
Private Sub MultiColSet(ByVal Desc As Variant, ByVal Combine As String, intCol As Integer, ByVal intLast As Integer, Optional AlwaysCombine As Boolean = False)
  Dim intCount As Integer
  Dim blnTwoLine As Boolean, blnCash As Boolean
  
    For intCount = 1 To intLast
          If intCount = intLast Then
               blnTwoLine = True
          Else
               If ColIsCash(Desc(intCount + 1)) Then
                  blnTwoLine = True
               Else
                  blnTwoLine = False
               End If
          End If
          blnCash = ColIsCash(Desc(intCount))
          If blnCash Then
               blnTwoLine = True
          End If
          If intCount < intLast Or AlwaysCombine Then
             SetBookField intCol, Desc(intCount), Combine, , 100, True, blnTwoLine, blnCash
          Else
             If intLast = 1 Then
                SetBookField intCol, Combine, , , 100, , blnTwoLine, blnCash
             Else
                SetBookField intCol, Desc(intCount), , , 100, , blnTwoLine, blnCash
             End If
          End If
          If Combine = "余额" Then
                If mBanlanceDesc(intCount) = "金额" Then
                    mintAmountBanCol = intCol + 1
                End If
                If mBanlanceDesc(intCount) = "数量" Then
                    mintQuantityBanCol = intCol + 1
                End If
                If mBanlanceDesc(intCount) = "原币" Then
                    mintCurrencyBanCol = intCol + 1
                End If
          End If
          intCol = intCol + 1
    Next intCount
End Sub

Private Function ColIsCash(ColCaption) As Boolean
    If InStr(1, ColCaption, "金额") > 0 Then
        ColIsCash = True
    End If
    If InStr(1, ColCaption, "原币") > 0 Then
        ColIsCash = True
    End If
    If InStr(1, ColCaption, "本币") > 0 Then
        ColIsCash = True
    End If
End Function

Private Sub ABook_ColumnResize(col As Integer)
  Dim lngWid As Long
  Dim intCol As Integer
  Dim intOldPage As Integer
    
    On Error GoTo ErrHandle
    If col = -1 Then
       mclsFset.GPaperBorder(6) = ABook.GutterLineWidth
    End If
    If mintSub = 1 Then
        If col + 2 <= mclsMultiReportSet.Columns Then
            mclsMultiReportSet.ColumnWidth(col + 2) = ABook.width(col) * Screen.TwipsPerPixelX
        Else
            mlngMultiWid(col + 2 - mclsMultiReportSet.Columns) = ABook.width(col) * Screen.TwipsPerPixelX
        End If
    Else
        Dim intCount As Integer
        For intCount = 1 To mintSub - 1
            intCol = mintMastDealCol(intCount) + 1 - (mclsMultiReportSet.FixColumns - 1)
        Next intCount
        If mclsMultiReportSet.Columns <= mintMastDealCol(mintSub - 1) Then
          intCol = col + 2
        Else
          intCol = intCol + col + 1
        End If
        If intCol <= mclsMultiReportSet.Columns Then
            mclsMultiReportSet.ColumnWidth(intCol) = ABook.width(col) * Screen.TwipsPerPixelX
        Else
            mlngMultiWid(mintMastDealCol(mintSub - 1) + col - mclsMultiReportSet.Columns - 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
        OneToMore
        GetPages
        mintNowPage = 1
        If intOldPage <= mintPages Then
           mintNowPage = intOldPage
           SetData intOldPage
        Else
           SetData
        End If
        InitScrollbar
    Else
        If UBound(mintMastDealCol) > 1 And mintSub <> UBound(mintMastDealCol) Then
            OneToMore
            GetPages
            mintNowPage = 1
            If intOldPage <= mintPages Then
               mintNowPage = intOldPage
               SetData intOldPage
            Else
               SetData
            End If
            InitScrollbar
        End If
    End If
    
    mblnChanged = True
ErrHandle:
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 mclsMultiReportSet.ReportType = msgTotal Then
        mclsMultiReportSet.ReportType = msgDetail
        cmbType.ReferRow = mclsMultiReportSet.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 = Val(GetNoXString(grdAcntBook.TextMatrix(intBegin, 0), 1, "/"))
        ID = CDbl(GetNoXString(grdAcntBook.TextMatrix(intBegin, 0), 2, "/"))
        BillPublic.ShowBill 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 > mclsMultiReportSet.HeadFields Then
       Exit Sub
    End If
    mclsMultiReportSet.HeadLeft(Index) = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
    mclsMultiReportSet.HeadTop(Index) = ABook.FCTop(Index) * Screen.TwipsPerPixelY
    mclsMultiReportSet.HeadHeight(Index) = ABook.FCHeight(Index) * Screen.TwipsPerPixelY
    mclsMultiReportSet.HeadWidth(Index) = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
    
    If Not mblnAlign Then
       mclsMultiReportSet.HeadAlign(Index) = 255
    End If
    
    If ABook.FCPlace = 1 Then
       mclsMultiReportSet.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 = mclsMultiReportSet.GridTop
       ABook.Refresh
       Exit Sub
    End If

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

Private Sub cmbDate_Choose()
    Dim D1 As Date
    Dim D2 As Date
    If cmbDate.Text = "自定义" And Not mblnDateChange Then
         mstrOldDate = detBegin.Text
    End If
    mblnDateChange = False
    If cmbDate.Text = "所有" Then
        detBegin.Value = Format(gclsBase.BeginDate, "YYYY-MM-DD")
        detEnd.Value = Format(gclsBase.EndDate, "YYYY-MM-DD")
    Else
        If cmbDate.Text = "自定义" Then
            On Error Resume Next
            detBegin.SetFocus
            Exit Sub
        Else
            gclsBase.GetBeginAndEndDate cmbDate.Text, gclsBase.BaseDate, D1, D2
            detBegin.Text = Format(D1, "YYYY-MM-DD")
            detEnd.Text = Format(D2, "YYYY-MM-DD")
            If Format(D1, "YYYY-MM-DD") < Format(gclsBase.BeginDate, "YYYY-MM-DD") Then
                detBegin.Value = Format(gclsBase.BeginDate, "YYYY-MM-DD")
                If Format(detEnd.Value, "YYYY-MM-DD") < Format(gclsBase.BeginDate, "YYYY-MM-DD") Then
                   detEnd.Value = Format(gclsBase.BaseDate, "YYYY-MM-DD")
                End If
                cmbDate.Text = "自定义"
            End If
        End If
    End If
    mblnDateChange = True
    If mblnRefresh And mblnLoad And Not mblnFirstLoad Then
       MsgForm.PleaseWait
    End If
    ReGetHeadCond
    If mblnRefresh Then
       RefreshData GetOtherCond
    End If
    If Not mblnFirstLoad Then
       Unload MsgForm
    End If
End Sub

Private Sub cmbDate_LostFocus()
   If Not (Me.ActiveControl Is detBegin Or Me.ActiveControl Is detEnd) Then