frmagereport.frm

金算盘软件代码

         QueryType       =   0
         Prompt          =   3
         Appearance      =   1
         QueryTimeout    =   30
         RowsetSize      =   100
         LoginTimeout    =   15
         KeysetSize      =   0
         MaxRows         =   0
         ErrorThreshold  =   -1
         BatchSize       =   15
         BackColor       =   -2147483643
         ForeColor       =   -2147483640
         Enabled         =   -1  'True
         ReadOnly        =   0   'False
         Appearance      =   -1  'True
         DataSourceName  =   ""
         RecordSource    =   ""
         UserName        =   ""
         Password        =   ""
         Connect         =   ""
         LogMessages     =   ""
         Caption         =   "MSRDC1"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin MSFlexGridLib.MSFlexGrid msgAccount 
         Bindings        =   "frmAgeReport.frx":04BA
         Height          =   3990
         Left            =   1365
         TabIndex        =   1
         Top             =   2100
         Width           =   495
         _ExtentX        =   873
         _ExtentY        =   7038
         _Version        =   393216
         Rows            =   10
         Cols            =   10
         FixedCols       =   0
         BackColor       =   -2147483639
         ForeColor       =   -2147483630
         BackColorFixed  =   -2147483639
         BackColorBkg    =   -2147483628
         GridColorFixed  =   12632256
         TextStyleFixed  =   4
         GridLinesFixed  =   1
         AllowUserResizing=   1
         Appearance      =   0
      End
      Begin VB.Label LblTitle 
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   15.75
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   315
         Left            =   3360
         TabIndex        =   2
         Top             =   180
         Width           =   195
      End
   End
   Begin GACALENDARLibCtl.Calendar GacEndDate 
      Height          =   300
      Left            =   6408
      OleObjectBlob   =   "frmAgeReport.frx":04CE
      TabIndex        =   30
      Top             =   468
      Width           =   1488
   End
   Begin VB.Label lblEndDate 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "截止日期(&3)"
      ForeColor       =   &H80000008&
      Height          =   180
      Left            =   5328
      TabIndex        =   31
      Top             =   576
      Width           =   1008
   End
   Begin VB.Label lblAnaDate 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      Caption         =   "分析日期(&2)"
      ForeColor       =   &H80000008&
      Height          =   180
      Left            =   2628
      TabIndex        =   33
      Top             =   552
      Width           =   1008
   End
   Begin VB.Label LblCurrencys 
      Caption         =   "币种(&1)"
      Height          =   180
      Left            =   216
      TabIndex        =   32
      Top             =   540
      Width           =   696
   End
   Begin VB.Label LblShadow 
      BackColor       =   &H80000010&
      Caption         =   "Label1"
      Height          =   1770
      Left            =   3675
      TabIndex        =   3
      Top             =   2100
      Width           =   1245
   End
End
Attribute VB_Name = "frmAgeReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************************************
'*************          帐龄分析结果显示窗体代码                            ***************
'作者： 周成坤
'时间： 1998-07-03
'
'接口： 1.Public Sub ShowAcntBook(ByVal lngReportId As Long, ByVal lngReportViewID, Optional
'                                   clsAgeSet As Age = Nothing)
'   功能：      对已保存帐龄分析报表或刚由查询向导生成的帐龄分析报表进行显示
'   参数说明：  lngReportId     :   报表ID号
'               lngReportViewID :   报表对应视图ID号
'               clsAgeSet       :   帐龄分析类模块，当其为空时，则根据报表ID和视图ID显示已保
'                                   存在Report表中的报表；不为空，则根据其属性显示报表
'*******************************************************************************************

Option Explicit
 
Const lngFormWidth As Long = 8500                               '窗体最小宽度
Const lngFormHeight As Long = 5370                              '窗体最小高度
Private ZoomIndex As Integer
Private PaperWidth As Long
Private PaperHeight As Long

Private mintPageRows As Integer                                 '一页的最大行数
Private mlngPageWidth As Long                                   '一页的最大宽度

Private mlngPages As Long                                       '总页数=mlngColExpands * mlngRowExpands
Private mlngColExpands As Long                                  '原始一页横向扩展出来的总页数(可能<>总列宽\mlngPageWidth+1)
Private mlngRowExpands As Long                                  '原始一页纵向扩展出来的总页数=记录数\mlngPageRows+1
Private mlngColStart() As Long                                  '每页的开始列
Private mlngColEnd() As Long                                    '每页的结束列
Private mlngRowStart() As Long                                  '每页记录的开始位置
Private mlngRowEnd() As Long                                    '每页记录的结束位置
Private mlngEndRowTop() As Long                                 '每页最后一行记录单元的顶端位置
Private mlngCurPage As Long                                     '当前页
Private mstrHF(6) As String

Private mblnHaveHead As Boolean                                 '是否需要标题
Private WithEvents ABook As ReportBook                          '列表报表对象
Attribute ABook.VB_VarHelpID = -1
Private mblnIsHaveData As Boolean                               '是否已有记录数据
Private mbResizeing As Boolean      '移动标志
Private mintCurContents As Integer  '当前目录
Private mlngLeftMargin As Long
'********************************************

Const lngPeriodWidth As Long = 1800                             '区间字段宽度
Const lngPeriodPercent As Long = 1200                            '百分比字段宽度
'Const lngSumColWidth As Long = 2000                             '合计字段宽度

Dim mFont As StdFont

Dim blnDisplayPercent As Boolean                                '是否显示百分比
Dim blnDisplayRowSum As Boolean                                 '是否显示合计
Dim blnDisplayColSum As Boolean
Dim blnIsNewDisplay As Boolean

Dim mcurSumData() As Currency                                    '行合计值
Dim mblnRowHaveData() As Boolean                                 '该行有数据
Dim mcurSumAll As Currency                                       '总合计值
Dim mbytColType() As Byte                     '列属性:0 普通字段,1 区间字段, 2 百分比字段，3 合计字段
Dim mbolColGrouped() As Boolean               '列是否分组汇总
Dim mintPos() As Long 'Integer                      '分组汇总行所在的行号
Dim mintGroupCols As Integer                    '分组列总数
Dim mlngColor(4) As Long

Const lngTailHeight As Long = 350
Const lngTitleHeight As Long = 450                              '表头高度
Const lngTitleTop As Long = 350                                 '表头顶部位置
Const lngAccountTop As Long = 800                               '表体顶部位置
Const mlngBackColor As Long = vbCyan

Private WithEvents mclsMainControl As MainControl                '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private mclsFset As ClsFormatset
'Private WithEvents mclsHook As Hook

Private mclsAgeSet As Age                                       '帐龄分析表设置对象
Private mclsFormCond As FormCond
Private mrstTemp As rdoResultset
Private mRecordNumber As Long 'Integer                                '所显示报表的记录数
Private mblnOrient As Boolean

Dim mstrStartDate As String
Dim mdatEndDate As Date
Dim mblnHaveData As Boolean
Dim mblnOnlyTitleChanged As Boolean
Dim mstrGraphics() As String                        '图形分析数组
Dim mintFCIndex As Integer
Dim mblnFCMouseUp As Boolean
Dim mblnFormLoad As Boolean
Private mTitleFont As StdFont
Private mHeadFont As StdFont
Private mblnChanged As Boolean                      '帐表结构改变标志
Private mblnFatalErr As Boolean                     '致命错误标志
Private mAutoRefresh As Boolean                     '是否自动刷新
'1999-12-17
Private mvarPeriodPerWidth() As Integer      '因帐龄区间增加的列数
Private Sub InitPeriodWidth()
    Dim strSql As String
    Dim Index As Integer
    Dim rs As rdoResultset
    ReDim Preserve mvarPeriodPerWidth(mclsAgeSet.PeriodNumber * IIf(mclsAgeSet.IsGrouped, 2, 1) + 1)
    strSql = "Select * from ReportSpecialColumn where ReportSpecialColumn.lngreportid = " & mclsAgeSet.AgeReportID & _
                    " Order by intColumndNo"
    Set rs = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With rs
        If Not .EOF Then .MoveLast
        
        If .EOF = True Or UBound(mvarPeriodPerWidth) + 1 <> .RowCount Then
            For Index = 0 To UBound(mvarPeriodPerWidth)
                If mclsAgeSet.IsGrouped Then
                    mvarPeriodPerWidth(Index) = IIf((Index Mod 2) = 0, lngPeriodWidth, lngPeriodPercent)
                Else
                    mvarPeriodPerWidth(Index) = IIf(Index = UBound(mvarPeriodPerWidth), lngPeriodPercent, lngPeriodWidth)
                End If
            Next
        Else
            .MoveFirst
            For Index = 0 To UBound(mvarPeriodPerWidth)
                mvarPeriodPerWidth(Index) = !lngColumndWidth
                .MoveNext
            Next
        End If
        .Close
    End With
End Sub

Private Sub SavePeriodWidth()
    Dim strSql As String
    Dim Index As Integer
    Dim rs As rdoResultset
    strSql = "Delete  from ReportSpecialColumn where ReportSpecialColumn.lngreportid = " & mclsAgeSet.AgeReportID
    gclsBase.ExecSQL strSql
    Set rs = gclsBase.BaseDB.OpenResultset("Select * from ReportSpecialColumn", rdOpenDynamic, 4)
    With rs
        For Index = 0 To UBound(mvarPeriodPerWidth)
            .AddNew
                !lngReportID = mclsAgeSet.AgeReportID
                !intColumndNo = Index
                !lngColumndWidth = mvarPeriodPerWidth(Index)
            .Update
        Next
        .Close
    End With
End Sub


Private Sub ABook_RowHeightChange()
    If DispartPage Then
        SetData
    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 cboAnaDate_Choose()
    
    If blnIsNewDisplay Then
        blnIsNewDisplay = False
        Exit Sub
    End If
    
    If cboAnaDate.Text = "开票日" Then
        mclsAgeSet.AgeStartDate = "strReceiptDate"
    ElseIf cboAnaDate.Text = "到期日" Then
        mclsAgeSet.AgeStartDate = "strDueDate"
    Else
        Exit Sub
    End If
    
    mstrStartDate = cboAnaDate.Text
    
    If Not mAutoRefresh Then Exit Sub
    If mclsAgeSet.GetReportSQL Then
        RefreshData
    End If
End Sub


'调用向导
Private Sub cmdAccSet_Click()
    If Not Report.MyReportExist(mclsAgeSet.AgeReportID) Then
        mblnFatalErr = True
        Unload Me
        Exit Sub
    End If
    blnIsNewDisplay = True
    
    If mclsAgeSet.ShowWizard(mclsAgeSet.AgeReportID, mclsAgeSet.AgeViewID, mclsAgeSet.ParentId, mclsAgeSet.ParentLevel, True, mclsFormCond) Then
        If mclsAgeSet Is Nothing Then Exit Sub
        If mclsAgeSet.IsNewWizard Then
            '设置报表打印ID
            mclsAgeSet.PrintID = StandardReport.GetPrintSetupID(6, mclsAgeSet.AgeReportID)
            gclsSys.SendMessage Me.hWnd, msgReport
            mclsAgeSet.SaveWizard
            mclsAgeSet.IsNewWizard = False
            mblnChanged = False
        Else
            mblnChanged = True
        End If
        InitPeriodWidth
        RefreshData
    End If
    blnIsNewDisplay = False
End Sub


'涮新数据
Public Sub RefreshData()
    Dim strSql As String
    Dim strTmp As String
    Dim i As Long 'Integer
    On Error GoTo ErrHandle
    If Not Report.MyReportExist(mclsAgeSet.AgeReportID) Then
        mblnFatalErr = True
        Unload Me
        Exit Sub
    End If
    mblnFormLoad = False