frmstandardreport.frm

金算盘软件代码

Private Sub cmdHide_Click()
    mblnHaveHead = Not mblnHaveHead
    If mblnHaveHead Then
        cmdHide.Caption = "隐藏标题(&H)"
    Else
        cmdHide.Caption = "显示标题(&I)"
    End If
    Form_Resize
End Sub

'处理只有汇总数据的显示
Private Sub DealOnlySum(blnShowSum As Boolean)
    Dim intRow As Integer
    If blnShowSum Then
    msgAccount.Redraw = False
      Do While intRow < msgAccount.Rows
       If msgAccount.TextMatrix(intRow, 0) = "#" Then
         If intRow = 0 Then
         msgAccount.RowHeight(0) = 0
         intRow = intRow + 1
         Else
         msgAccount.RemoveItem intRow
         End If
       Else
       intRow = intRow + 1
       End If
      Loop
    msgAccount.Redraw = True
    End If
End Sub
'处理分组汇总的显示
Private Sub DealGroupSum()
   Dim intRow As Integer, intGroupCount As Integer
   Dim intStart As Integer, intEnd As Integer
   Dim intGroupLoc As Integer, intGroupMethod As Integer
   Dim strName As String, strGroupName As String
   Dim blnIsEnd As Boolean
   msgAccount.Redraw = False
   mintAddTail = 0
   For intGroupCount = 0 To mclsStandard.GroupColumns - 1
     intGroupLoc = mclsStandard.ColumnGroupLoc(intGroupCount * 5 + 1)
     intGroupMethod = mclsStandard.ColumnGroup(intGroupLoc)
     If intGroupMethod = 0 Then
     '表合计
        MeAddSumRow 0, msgAccount.Rows - 2, intGroupCount, intGroupLoc + 1, "合计"
     Else
     '其他分组方式
     blnIsEnd = False
     Select Case mclsStandard.ColumnFieldType(intGroupLoc)
     Case "String", "Code"        '字符串类型
       intRow = 0
       intStart = 0
       strName = msgAccount.TextMatrix(0, intGroupLoc + 1)
       strGroupName = "按" & Left(strName, intGroupMethod) & "合计"
       Do Until msgAccount.TextMatrix(intRow, 0) = "~"
       If msgAccount.TextMatrix(intRow, 0) = "#" Then
         If Left(strName, intGroupMethod) <> Left(msgAccount.TextMatrix(intRow, intGroupLoc + 1), _
                intGroupMethod) Then
         intEnd = intRow - 1
         MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
         Do While msgAccount.TextMatrix(intRow, 0) <> "#" Or msgAccount.TextMatrix(intRow, 0) = "~"
         intRow = intRow + 1
         Loop
         intStart = intRow
         strName = msgAccount.TextMatrix(intRow, intGroupLoc + 1)
         strGroupName = "按" & Left(strName, intGroupMethod) & "合计"
         ElseIf msgAccount.TextMatrix(intRow + mintAddTail + 1, 0) = "~" Then
          intEnd = intRow
          MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
          Exit Do
         Else
         intRow = intRow + 1
         End If
       Else
       intRow = intRow + 1
       End If
       Loop
     Case "Period"             '日期类型
       intRow = 0
       intStart = 0
       strName = msgAccount.TextMatrix(0, intGroupLoc + 1)
       If strName <> "" Then
        Do While intRow < msgAccount.Rows
        If msgAccount.TextMatrix(intRow, 0) = "#" Then
          Select Case intGroupMethod
          Case 1
             strGroupName = "" & Year(strName) & "年合计"
             If Year(strName) <> Year(msgAccount.TextMatrix(intRow, intGroupLoc + 1)) Then
             intEnd = intRow - 1
             MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
             Do While msgAccount.TextMatrix(intRow, 0) <> "#" Or msgAccount.TextMatrix(intRow, 0) = "~"
             intRow = intRow + 1
             Loop
             intStart = intRow
             strName = msgAccount.TextMatrix(intRow, intGroupLoc + 1)
             strGroupName = "" & Year(strName) & "年合计"
             ElseIf msgAccount.TextMatrix(intRow + mintAddTail + 1, 0) = "~" Then
              intEnd = intRow
              MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
              Exit Do
             Else
             intRow = intRow + 1
             End If
          Case 2
             strGroupName = "" & DatePart("q", strName) & "季度合计"
             If DatePart("q", strName) <> DatePart("q", msgAccount.TextMatrix(intRow, intGroupLoc + 1)) Then
             intEnd = intRow - 1
             MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
             Do While msgAccount.TextMatrix(intRow, 0) <> "#" Or msgAccount.TextMatrix(intRow, 0) = "~"
             intRow = intRow + 1
             Loop
             intStart = intRow
             strName = msgAccount.TextMatrix(intRow, intGroupLoc + 1)
             strGroupName = "" & DatePart("q", strName) & "季度合计"
             ElseIf msgAccount.TextMatrix(intRow + mintAddTail + 1, 0) = "~" Then
              intEnd = intRow
              MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
              Exit Do
             Else
             intRow = intRow + 1
             End If
          Case 3
             strGroupName = "" & DatePart("m", strName) & "月合计"
             If DatePart("m", strName) <> DatePart("m", msgAccount.TextMatrix(intRow, intGroupLoc + 1)) Then
             intEnd = intRow - 1
             MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
             Do While msgAccount.TextMatrix(intRow, 0) <> "#" Or msgAccount.TextMatrix(intRow, 0) = "~"
             intRow = intRow + 1
             Loop
             intStart = intRow
             strName = msgAccount.TextMatrix(intRow, intGroupLoc + 1)
             strGroupName = "" & DatePart("m", strName) & "月合计"
             ElseIf msgAccount.TextMatrix(intRow + mintAddTail + 1, 0) = "~" Then
              intEnd = intRow
              MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
              Exit Do
             Else
             intRow = intRow + 1
             End If
          Case 4
             strGroupName = "第" & DatePart("ww", strName) & "周合计"
             If DatePart("ww", strName) <> DatePart("ww", msgAccount.TextMatrix(intRow, intGroupLoc + 1)) Then
             intEnd = intRow - 1
             MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
             Do While msgAccount.TextMatrix(intRow, 0) <> "#" Or msgAccount.TextMatrix(intRow, 0) = "~"
             intRow = intRow + 1
             Loop
             intStart = intRow
             strName = msgAccount.TextMatrix(intRow, intGroupLoc + 1)
             strGroupName = "第" & DatePart("ww", strName) & "周合计"
             ElseIf msgAccount.TextMatrix(intRow + mintAddTail + 1, 0) = "~" Then
              intEnd = intRow
              MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
              Exit Do
             Else
             intRow = intRow + 1
             End If
          Case 5
             strGroupName = "" & DatePart("d", strName) & "日合计"
             If DatePart("d", strName) <> DatePart("d", msgAccount.TextMatrix(intRow, intGroupLoc + 1)) Then
             intEnd = intRow - 1
             MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
             Do While msgAccount.TextMatrix(intRow, 0) <> "#" Or msgAccount.TextMatrix(intRow, 0) = "~"
             intRow = intRow + 1
             Loop
             intStart = intRow
             strName = msgAccount.TextMatrix(intRow, intGroupLoc + 1)
             strGroupName = "" & DatePart("d", strName) & "日合计"
             ElseIf msgAccount.TextMatrix(intRow + mintAddTail + 1, 0) = "~" Then
              intEnd = intRow
              MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
              Exit Do
             Else
             intRow = intRow + 1
             End If
          Case Else
          End Select
       Else
       intRow = intRow + 1
       End If
       Loop
       Else     '日期为空时,不处理(因为DataPart("q","")会出错)
          MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, "合计"
       End If
     Case Else                     '数字类型
       intRow = 0
       intStart = 0
       strName = msgAccount.TextMatrix(0, intGroupLoc + 1)
       strGroupName = "从" & Int(CDbl(Val(strName)) / intGroupMethod) * intGroupMethod & "到" & _
                   Int(CDbl(Val(strName)) / intGroupMethod + 1) * intGroupMethod & "合计"
       Do While intRow < msgAccount.Rows
       If msgAccount.TextMatrix(intRow, 0) = "#" Then
         If Int(CDbl(Val(strName)) / intGroupMethod) <> Int(CDbl(Val(msgAccount.TextMatrix(intRow, intGroupLoc + 1))) _
               / intGroupMethod) Then
         intEnd = intRow - 1
         MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
         Do While msgAccount.TextMatrix(intRow, 0) <> "#" Or msgAccount.TextMatrix(intRow, 0) = "~"
         intRow = intRow + 1
         Loop
         intStart = intRow
         strName = msgAccount.TextMatrix(intRow, intGroupLoc + 1)
         strGroupName = "从" & Int(CDbl(Val(strName)) / intGroupMethod) * intGroupMethod & "到" & _
                   Int(CDbl(Val(strName)) / intGroupMethod + 1) * intGroupMethod & "合计"
         ElseIf msgAccount.TextMatrix(intRow + mintAddTail + 1, 0) = "~" Then
          intEnd = intRow
          MeAddSumRow intStart, intEnd, intGroupCount, intGroupLoc + 1, strGroupName
          Exit Do
         Else
         intRow = intRow + 1
         End If
       Else
       intRow = intRow + 1
       End If
       Loop
       
     End Select
     End If
   Next intGroupCount
   msgAccount.Redraw = True
End Sub
'根据得到的起止行和分组序号进行汇总，加到表格里去
'intS:开始行,intE:结束行,intG:第几分组,intGCol:合计列位置,strGName:合计方式
Private Sub MeAddSumRow(intS As Integer, intE As Integer, intG As Integer, intGCol As Integer, strGName As String)
   Dim intSumCount As Integer, intRow As Integer
   Dim intMethod As Integer, intCol As Integer, intCount As Integer
   Dim dblSum As Double
   Dim dblMax As Variant, dblMin As Variant
   If mclsStandard.ColumnSumID(intG * 5 + 1) = 0 Then Exit Sub
   If intE = msgAccount.Rows - 2 Then mintAddTail = mintAddTail + 1
   msgAccount.AddItem "", intE + 1
   For intSumCount = 1 To 5
   If mclsStandard.ColumnSumID(intG * 5 + intSumCount) > 0 Then
     intCol = mclsStandard.ColumnSumLoc(intG * 5 + intSumCount) + 1
     If intCol < 0 Then Exit Sub
     msgAccount.TextMatrix(intE + 1, intGCol) = strGName
     Select Case mclsStandard.ColumnSumMethod(intG * 5 + intSumCount)
     Case 1           '求和
       dblSum = 0
       For intRow = intS To intE
         If msgAccount.TextMatrix(intRow, 0) <> "#" Then
         Else
         dblSum = dblSum + CDbl(IIf(msgAccount.TextMatrix(intRow, intCol) <> "", msgAccount.TextMatrix(intRow, intCol), "0"))
         End If
       Next intRow
       msgAccount.TextMatrix(intE + 1, 0) = "$"
       msgAccount.TextMatrix(intE + 1, intCol) = dblSum
      
     Case 2           '平均
       dblSum = 0
       intCount = 0
       For intRow = intS To intE
         If msgAccount.TextMatrix(intRow, 0) <> "#" Then
         Else
         intCount = intCount + 1
         dblSum = dblSum + CDbl(IIf(msgAccount.TextMatrix(intRow, intCol) <> "", msgAccount.TextMatrix(intRow, intCol), "0"))
         End If
       Next intRow
       msgAccount.TextMatrix(intE + 1, 0) = "$"
       msgAccount.TextMatrix(intE + 1, intCol) = dblSum / intCount
       
     Case 3           '最大值
        dblMax = IIf(msgAccount.TextMatrix(intS, intCol) <> "", msgAccount.TextMatrix(intS, intCol), "0")
       For intRow = intS To intE
         If msgAccount.TextMatrix(intRow, 0) <> "#" Then
         ElseIf dblMax < IIf(msgAccount.TextMatrix(intRow, intCol) <> "", msgAccount.TextMatrix(intRow, intCol), "0") Then
         dblMax = IIf(msgAccount.TextMatrix(intRow, intCol) <> "", msgAccount.TextMatrix(intRow, intCol), "0")
         End If
       Next intRow
       msgAccount.TextMatrix(intE + 1, 0) = "$"
       msgAccount.TextMatrix(intE + 1, intCol) = dblMax
       
     Case 4           '最小值
        dblMin = IIf(msgAccount.TextMatrix(intS, intCol) <> "", msgAccount.TextMatrix(intS, intCol), "0")
       For intRow = intS To intE
         If msgAccount.TextMatrix(intRow, 0) <> "#" Then
         ElseIf dblMin > IIf(msgAccount.TextMatrix(intRow, intCol) <> "", msgAccount.TextMatrix(intRow, intCol), "0") Then
         dblMin = IIf(msgAccount.TextMatrix(intRow, intCol) <> "", msgAccount.TextMatrix(intRow, intCol), "0")
         End If
       Next intRow
       msgAccount.TextMatrix(intE + 1, 0) = "$"
       msgAccount.TextMatrix(intE + 1, intCol) = dblMin
       
     Case 5          '计数
       intCount = 0
       For intRow = intS To intE
         If msgAccount.TextMatrix(intRow, 0) <> "#" Then
         Else
         intCount = intCount + 1
         End If
       Next intRow
       msgAccount.TextMatrix(intE + 1, 0) = "$"
       msgAccount.TextMatrix(intE + 1, intCol) = intCount
       
     Case Else
     End Select
   Else
   Exit For
   End If
   Next intSumCount
End Sub
'初始化表头、表体的行列值
Private Sub InitGridRowCol()
    
    msgAccount.Redraw = False
    msgTitle.Redraw = False
    msgAccount.AddItem ""
    msgAccount.RowHeight(msgAccount.Rows - 1) = 0
    msgAccount.TextMatrix(msgAccount.Rows - 1, 0) = "~"
'    msgAccount.Cols = mclsStandard.Columns + 1
    msgAccount.FixedCols = mclsStandard.GroupColumns + 1
    msgAccount.ColWidth(0) = 0
    msgTitle.Rows = 2
    msgTitle.Cols = msgAccount.Cols
    msgTitle.FixedCols = msgAccount.FixedCols
    msgTitle.ColWidth(0) = 0
    msgTitle.FixedRows = 1
    msgTitle.RowHeight(0) = lngTitleHeight
    msgTitle.RowHeight(1) = 0
    msgAccount.FixedRows = 0
    msgAccount.Redraw = True
    msgTitle.Redraw = True
End Sub


Private Sub Form_Unload(Cancel As Integer)
    Set mclsStandard = Nothing
    Set mclsFormCond = Nothing
    gclsSys.MainControls.Remove Me
End Sub

Private Sub Form_Resize()
   msgAccount.Redraw = False
   msgTitle.Redraw = False
   
   If Me.WindowState = vbMinimized Then
       Exit Sub
   End If
   If Me.Width < lngFormWidth Then
       Me.Width = lngFormWidth
   End If

   If Me.Height < lngFormHeight Then
       Me.Height = lngFormHeight
   End If
   
   picAccount.Height = Me.Height - 700
   picAccount.Width = Me.Width - 200
   lblShadow.Height = picAccount.Height
   lblShadow.Width = picAccount.Width
   msgAccount.Width = picAccount.Width - 480
   msgTitle.Width = msgAccount.Width
   If mblnHaveHead Then
       msgTitle.top = lngTitleTop
       msgAccount.top = lngAccountTop