frmquotabook.frm

金算盘软件代码

         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label LblList 
      AutoSize        =   -1  'True
      Caption         =   "部门(&1)"
      Height          =   180
      Index           =   0
      Left            =   360
      TabIndex        =   5
      Top             =   510
      Visible         =   0   'False
      Width           =   630
   End
   Begin MSForms.CommandButton CmdPaper 
      Height          =   345
      Left            =   3930
      TabIndex        =   20
      Top             =   6000
      Width           =   1215
      Caption         =   "纸张"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
   Begin MSForms.CommandButton CmdZoom 
      Height          =   345
      Left            =   2700
      TabIndex        =   19
      Top             =   6000
      Width           =   1215
      Caption         =   "缩放"
      PicturePosition =   196613
      Size            =   "2143;609"
      FontName        =   "宋体"
      FontHeight      =   180
      FontCharSet     =   134
      FontPitchAndFamily=   34
      ParagraphAlign  =   3
   End
End
Attribute VB_Name = "frmQuotaBook"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'配款表查询(真实报表：综合)
'
' 作者：邓强
' 功能：根据用户选择列表项目组织数据显示（真实纸页效果）
' 时间：98.7.17
'
' 公共过程:
' ResponseMessage   响应消息,刷新纪录
' ShowAcntBook      显示报表
'
' 相关报表对象子过程 :
'？？？ SetGridTitle           设置标题                   /////已作废
' ？？？SetBookField       设置栏目                   /////已作废
' SetCell            设置单元数据
' SetFreeCell        设置自由单元数据'
'SetColumnInfo       设置列信息
'SetRowInfo           设置行信息
'setDataFont        设置数据区字体
'GetGridTop         获得数据区Top位置
'SetGridTop         设置数据区Top位置
'GetGridheight      获得数据区高度
'GetGridWidth       获得数据区宽度
'setMaxRow          设置最大显示行
'setMaxCol          设置最大显示列
'GetDefRowheight    获得缺省行高
'SetDefRowheight    设置缺省行高
'GetDefColWidth     获得缺省列宽
'SetDefColWidth     设置缺省列宽
'GetRowHeight       获得指定行高
'GetColumnWidth     获得指定列宽
'SetFixRow          设置标题行数
'SetTableLeftMargin 设置左边距

'''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Const lngFormWidth As Long = 8300                               '窗体最小宽度
Const lngFormHeight As Long = 5000                              '窗体最小高度

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

Private mlngPages As Integer                                    '总页数=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 mstrHF(6) As String
Private mlngCurPage As Integer                                     '当前页
Private mintCurContents As Integer  '当前目录
Private mbResizeing As Boolean      '移动标志
Private ZoomIndex As Integer
Private PaperWidth As Long
Private PaperHeight As Long
Private mblnOrient  As Boolean      '纵向打印

Private mclsFset As ClsFormatset
Private mclsCell As FreeCellSet                                 '自由单元对象
Private WithEvents mclsMainControl As MainControl               '主控对象
Attribute mclsMainControl.VB_VarHelpID = -1
Private mclsQuota As QuotaSet                                   '配款表设置对象
Private mclsFormCond As FormCond                                '配款表条件对象
Private WithEvents ABook As ReportBook                          '配款表报表对象
Attribute ABook.VB_VarHelpID = -1
Private mblnLoaded As Boolean                                   '是否是装载窗体
Private mintFCIndex As Integer                                  '自由单元索引(右键响应)
Private mblnChanged As Boolean                                  '是否改变报表设置
Private mblnFatalErr As Boolean                                 '致命错误

Private mstrCellQueryCond As String                             '报表查询中文一般条件
Private mstrCellExtraCond As String                             '报表查询中文特殊条件
Private mstrNormalCond As String                                '报表查询一般条件
Private mstrExtraCond As String                                 '报表查询特殊条件
Private mstrListCond As String                                  '列表框条件
Private mstrDateCond As String                                  '日期条件
Private mstrLevelCond As String                                 '报表编码层次条件
Private mstrWizardCond As String                                '报表向导条件
Private mintLevelType As Integer                                '报表编码层次汇总类型
Private mblnSaving As Boolean                                   '报表正在保存
Private mblnAutoRefresh As Boolean                              '是否自动刷新
Private mblnRefresh As Boolean                                  '是否表头变化引起的刷新

Private mlngCellTop As Long                                     '新增自由单元TOP
Private mlngCellLeft As Long                                    '新增自由单元TOP
Private mbytCellType As Byte                                    '新增自由单元类型
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                             *         公共过程              *
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 响应消息,刷新纪录
Public Sub ResponseMessage()
    Dim vntMessage As Variant
'    For Each vntMessage In mclsMainControl.Messages
'        Select Case vntMessage
'            '    单位                 部门                   科目                摘要
'            Case Message.msgCustomer, Message.msgDepartment, Message.msgAccount, Message.msgRemark
'                 RefreshData                                         '刷新纪录
'            Case Else
'        End Select
'    Next
'    mclsMainControl.Messages.Clear
End Sub
'显示报表
Public Sub ShowAcntBook(ByVal lngReportID As Long, ByVal ViewId As Long, Optional clsReportSet As QuotaSet = Nothing, _
        Optional clsFormCond As FormCond)
    Dim blnLoad  As Boolean
    Dim edtErrReturn As ErrDealType

    #If conDebug = 0 Then
       On Error GoTo ErrHandle
    #End If
    
    Set ABook = New ReportBook
    ABook.SetWin PicPaper.hwnd
    If ABook.IsInitSuccessed = 0 Then
        Unload Me
        Unload MsgForm
        Exit Sub
    End If
    ABook.Version = Report.VersionInfo
    mblnLoaded = False
    mblnChanged = False
    mblnFatalErr = False
    
    If clsReportSet Is Nothing Then
        Set mclsQuota = New QuotaSet
        Set mclsFormCond = New FormCond
        mclsFormCond.InitCondArr lngReportID, ViewId, 2, 64, "日期"
        blnLoad = mclsQuota.GetReportSet(lngReportID)
        If blnLoad = False Then
            Unload MsgForm
            Unload Me
            Exit Sub
        End If
    '显示才由向导生成的帐表
    Else
        Set mclsQuota = clsReportSet
        Set mclsFormCond = clsFormCond
    End If
    
    Set mclsCell = New FreeCellSet
    mclsCell.ReportID = lngReportID
    mclsCell.ReportName = mclsQuota.ReportName
    mclsCell.LoadFreeCell
    
    Set mclsFset = New ClsFormatset
    mclsFset.InitPropertyByDataBase 10, mclsQuota.ReportID
    GetDefaultSet
    
    '设置GRID的TOP
    If mclsQuota.GridTop = 0 Then
        SetGridTop 90
    Else
        SetGridTop mclsQuota.GridTop / Screen.TwipsPerPixelY
    End If
    
    mlngCurPage = 1
    InitHeadList
    mclsQuota.SetSQL
    mblnAutoRefresh = True
    RefreshData                                                      '涮新数据
    
    If mblnFatalErr Then
        Unload MsgForm
        Exit Sub
    End If
    ABook.FCLocked = 1
    StandardReport.AddHelpID Me, mclsQuota.GroupNo                   '加帮助ID
    Set mclsMainControl = gclsSys.MainControls.Add(Me)               '加入主控
    Utility.LoadFormSetting Me
    mblnLoaded = True
    Set clsReportSet = Nothing
    Set clsFormCond = Nothing
    Me.Show
        Exit Sub
ErrHandle:
    edtErrReturn = Errors.ErrorsDeal
    
    If edtErrReturn = edtResume Then
         Resume
    Else
         On Error Resume Next
         Unload MsgForm
         Unload Me
    End If
End Sub

Private Sub ABook_ColumnResize(col As Integer, ByVal width As Integer, bCancel As Integer)
Dim intStart As Integer
    If col <> -1 Then
        If width >= ABook.ColCount Then
            Utility.ShowMsg Me.hwnd, "列太宽!", vbOKOnly + vbInformation, App.title
            bCancel = 1
            Exit Sub
        End If
        intStart = mlngColStart(mlngCurPage - 1)
        mclsQuota.ColumnWidth(intStart + col) = IIf(width > 0, width * Screen.TwipsPerPixelX, 0)
        msgAccount.ColWidth(intStart + col) = mclsQuota.ColumnWidth(intStart + col)
        bCancel = 0
    End If
    If DispartPage Then                                   '分页
        SetData                                        '填充数据
    End If
    mblnChanged = True
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                          *          控件事件处理              *
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Sub ABook_FCMouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim blnHead As Boolean

    If Button = vbRightButton Then
        mintFCIndex = Index
        If ABook.IsMultiSel Then       '如果表头栏目多选
            Report.FreeCellFatSet
        Else
            blnHead = ABook.Postion(Index) - 1
            If Index <= mclsQuota.ListColumns + 1 Then
            Else
                StandardReport.CallFreeCellMenu blnHead
                PopupMenu frmMain.mnuListActivity
            End If
        End If
    End If
End Sub

Private Sub ABook_FreeCellChanged(Index As Integer)
Dim intLoc As Integer, intAlign As Integer

    If ABook.FCPlace = 1 Then
        intAlign = ABook.FCAlignment(Index)
    Else
        intAlign = 255
    End If
    With mclsQuota
        If Index = 0 Then
            .TitleHeight = ABook.FCHeight(Index) * Screen.TwipsPerPixelX
            .TitleWidth = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
            .TitleLeft = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
            .TitleTop = ABook.FCTop(Index) * Screen.TwipsPerPixelX
            .TitleAlign = intAlign
        ElseIf Index = 1 Then
            .CondHeight = ABook.FCHeight(Index) * Screen.TwipsPerPixelX
            .CondWidth = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
            .CondLeft = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
            .CondTop = ABook.FCTop(Index) * Screen.TwipsPerPixelX
            .CondAlign = intAlign
        ElseIf Index < .ListColumns + 2 Then
            '表头列表框栏目
            intLoc = .ColumnListLoc(Index - 2)
            .ColumnHeight(intLoc) = ABook.FCHeight(Index) * Screen.TwipsPerPixelX
            .ColumnWidth(intLoc) = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
            .ColumnLeft(intLoc) = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
            .ColumnTop(intLoc) = ABook.FCTop(Index) * Screen.TwipsPerPixelX
            .ColumnAlign(intLoc) = intAlign
        Else
        '处理报表标题
            mclsCell.FindLoc Index, intLoc
            mclsCell.CellHeight(intLoc) = ABook.FCHeight(Index) * Screen.TwipsPerPixelX
            mclsCell.CellWidth(intLoc) = ABook.FCWidth(Index) * Screen.TwipsPerPixelX
            mclsCell.CellLeft(intLoc) = ABook.FCLeft(Index) * Screen.TwipsPerPixelX
            mclsCell.CellTop(intLoc) = ABook.FCTop(Index) * Screen.TwipsPerPixelX
            mclsCell.CellAlign(intLoc) = intAlign
        End If
        mblnChanged = True
    End With
End Sub

Private Sub ReGetCellChanged()
Dim Index As Integer
    For Index = 0 To mclsCell.FreeCells + mclsQuota.ListColumns + 1
        ABook_FreeCellChanged Index
    Next Index
End Sub