frmmain.frm

本系统是一个报表分析查询系统

 With meSel
  .MaxCol = frmRptTitle.GetCols(0) - 1
  .MaxRow = frmRptTitle.GetRows(0) - 1
  '//
  For iLoop = 2 To .MaxRow
   For jLoop = 1 To .MaxCol
    '//判断单元格是否已经在合并区域
    CellRange = frmRptTitle.GetMergeRange(jLoop, iLoop, .sRan.sCol, .sRan.sRow, .sRan.eCol, .sRan.eRow)
    .CurValue = frmRptTitle.GetCellString2(jLoop, iLoop, 0)
    If Trim(.CurValue) <> "" Then
     Set entryObj = CreateObject("StdRptBase.Title")
     With entryObj
      '//计算标题内码
      If FInterID = 0 Then
       .Js_TitleID = meObj.BaseInfo.getItemID(11) '//内码不存在：计算标题的起始内码
       FInterID = .Js_TitleID
      Else
       FInterID = FInterID + 1
       .Js_TitleID = FInterID '//内码存在：原来的内码加一
      End If
      
      '//报表标题内码
      .Js_RptID = objRpt.Js_RptID '//关联报表内码
      
      '//报表标题正文
      .Js_Text = meSel.CurValue
      If CellRange = 1 Then
       '//开始列
       .Js_SCol = meSel.sRan.sCol
       .Js_SRow = meSel.sRan.sRow
       .Js_ECol = meSel.sRan.eCol
       .Js_ERow = meSel.sRan.eRow
      Else
       '//此单元格没有在合并区域
       .Js_SCol = jLoop
       .Js_SRow = iLoop
       .Js_ECol = jLoop
       .Js_ERow = iLoop
      End If
     End With
     objRpt.tBill.Add entryObj
     Set entryObj = Nothing
    End If
   Next
  Next
 End With
 MsgInfo = "标题数据打包成功"
 SaveGetTitle = True
 Exit Function
ErrHandle:
 MsgInfo = "标题数据打包错误：" & Err.Description
 SaveGetTitle = False
 ' For iLoop = 1 To objRpt.tBill.Count
 '  MsgBox objRpt.tBill.Item(iLoop).Js_Text
 ' Next
 '//标题数据打包完成
End Function

'//装载数据到报表
Private Sub loadData()
 Dim MsgInfo As String
 Dim iLoop As Integer
 Dim hCount As Integer
 Dim fCount As Integer
 Dim enObj As Object
 Dim ldObj As Object
 Dim styID As Long
 Dim jLoop As Integer
 Dim tlMin As Integer
 Dim tlMax As Integer
 Dim vTl As Variant
 Dim ColsCols As Integer
 Dim ColsRows As Integer
 
 hCount = 1
 fCount = 9
 
 Set ldObj = CreateObject("StdRptBase.Rpt")
 Call ldObj.NewBill
 If ldObj.Load(eRptID, MsgInfo) = False Then
  MsgBox MsgInfo, vbCritical + vbOKOnly, meObj.BaseInfo.getMsgInfo
  Exit Sub
 End If
 '//
 With ldObj
  '===*填充基本参数*===
  '//报表内码
  objRpt.Js_RptID = .Js_RptID
  
  '//报表组信息
  frmParam.SetCellString 2, 2, 0, meObj.BaseInfo.getItemName(10, .Js_GroupID)
  objRpt.Js_GroupID = .Js_GroupID
  objRpt.Js_GroupName = frmParam.GetCellString2(2, 2, 0)
  
  '//报表名称
  frmParam.SetCellString 2, 3, 0, .Js_RptName
  objRpt.Js_RptName = .Js_RptName
  
  '//报表描述
  frmParam.SetCellString 2, 9, 0, .Js_RptDesc
  objRpt.Js_RptDesc = .Js_RptDesc
  
  '//报表过程
  frmParam.SetCellString 2, 8, 0, .Js_RptCallName
  objRpt.Js_RptCallName = .Js_RptCallName
  
  '//报表宽度
  objRpt.Js_RptWidth = .Js_RptWidth
  
  '//报表高度
  objRpt.Js_RptHeight = .Js_RptHeight
  
  '//访问权限
  frmParam.SetCellString 2, 4, 0, meObj.BaseInfo.getItemName(8, .Js_RightID)
  objRpt.Js_RightID = .Js_RightID
  objRpt.Js_RightName = frmParam.GetCellString2(2, 4, 0)
  
  '//搜速权限
  frmParam.SetCellString 2, 5, 0, meObj.BaseInfo.getItemName(8, .Js_FiltrateRightID)
  objRpt.Js_FiltrateRightID = .Js_FiltrateRightID
  objRpt.Js_FiltrateRightName = frmParam.GetCellString2(2, 5, 0)
  
  '//导出权限
  frmParam.SetCellString 2, 6, 0, meObj.BaseInfo.getItemName(8, .Js_ExportRightID)
  objRpt.Js_ExportRightID = .Js_ExportRightID
  objRpt.Js_ExportRightName = frmParam.GetCellString2(2, 6, 0)
  
  '//打印权限
  frmParam.SetCellString 2, 7, 0, meObj.BaseInfo.getItemName(8, .Js_PrintRightID)
  objRpt.Js_PrintRightID = .Js_PrintRightID
  objRpt.Js_PrintRightName = frmParam.GetCellString2(2, 7, 0)
  
  '//添加用户
  objRpt.Js_UserID = .Js_UserID
  
  '//添加日期
  objRpt.Js_Date = .Js_Date
  
  '//添加时间
  objRpt.Js_Time = .Js_Time
  
  '===*页眉业脚信息===
  If objRpt.hBill.Count > 0 Then
   For iLoop = objRpt.hBill.Coun To 1 Step -1
    objRpt.hBill.Remove iLoop
   Next
  End If
  
  '//拷贝数据
  If .hBill.Count > 0 Then
   For iLoop = 1 To .hBill.Count
    styID = 0
    '//还原数据
    Set enObj = CreateObject("StdRptBase.HeaderFooter")
    enObj.Js_HeaderFooterID = .hBill.Item(iLoop).Js_HeaderFooterID
    enObj.Js_RptID = .hBill.Item(iLoop).Js_RptID
    enObj.Js_hfTypeID = .hBill.Item(iLoop).Js_hfTypeID
    enObj.Js_hfText = .hBill.Item(iLoop).Js_hfText
    enObj.Js_hfFontName = .hBill.Item(iLoop).Js_hfFontName
    enObj.Js_hfFontSize = .hBill.Item(iLoop).Js_hfFontSize
    enObj.Js_hfFontBold = .hBill.Item(iLoop).Js_hfFontBold
    enObj.Js_hfFontItalic = .hBill.Item(iLoop).Js_hfFontItalic
    enObj.Js_hfFontUnderline = .hBill.Item(iLoop).Js_hfFontUnderline
    enObj.Js_HeaderFooterOrderID = .hBill.Item(iLoop).Js_HeaderFooterOrderID
    objRpt.hBill.Add enObj
    Set enObj = Nothing
    
    '//还原表格
     Select Case .hBill.Item(iLoop).Js_hfTypeID
      Case 1
       frmHeadFooterText.SetCellString 1, hCount, 0, .hBill.Item(iLoop).Js_hfText
       frmHeadFooterText.SetCellFont 1, hCount, 0, frmHeadFooterText.FindFontIndex(.hBill.Item(iLoop).Js_hfFontName, 1)
       frmHeadFooterText.SetCellFontSize 1, hCount, 0, .hBill.Item(iLoop).Js_hfFontSize
       frmHeadFooterText.SetRowHeight 1, frmHeadFooterText.GetRowBestHeight(hCount), hCount, 0
       If .hBill.Item(iLoop).Js_hfFontBold = 1 Then
        styID = 2
       End If
       If .hBill.Item(iLoop).Js_hfFontItalic = 1 Then
        styID = styID + 4
       End If
       If .hBill.Item(iLoop).Js_hfFontUnderline = 1 Then
        styID = styID + 8
       End If
       frmHeadFooterText.SetCellFontStyle 1, hCount, 0, styID
       hCount = hCount + 1
      Case 2
       frmHeadFooterText.SetCellString 1, fCount, 0, .hBill.Item(iLoop).Js_hfText
       frmHeadFooterText.SetCellFont 1, fCount, 0, frmHeadFooterText.FindFontIndex(.hBill.Item(iLoop).Js_hfFontName, 1)
       frmHeadFooterText.SetCellFontSize 1, fCount, 0, .hBill.Item(iLoop).Js_hfFontSize
       frmHeadFooterText.SetRowHeight 1, frmHeadFooterText.GetRowBestHeight(fCount), fCount, 0
       If .hBill.Item(iLoop).Js_hfFontBold = 1 Then
        styID = 2
       End If
       If .hBill.Item(iLoop).Js_hfFontItalic = 1 Then
        styID = styID + 4
       End If
       If .hBill.Item(iLoop).Js_hfFontUnderline = 1 Then
        styID = styID + 8
       End If
       frmHeadFooterText.SetCellFontStyle 1, fCount, 0, styID
       fCount = fCount + 1
     End Select
   Next
  End If
  
  '//===*字段控制表*===
  If objRpt.fBill.Count > 0 Then
   For iLoop = objRpt.fBill.Coun To 1 Step -1
    objRpt.fBill.Remove iLoop
   Next
  End If
  
  '//拷贝数据
  If .fBill.Count > 0 Then
   '//初始化表格
   frmTable.TabEnabled(2) = True
   vTl = Split(TitleStr, "|")
   tlMin = LBound(vTl)
   tlMax = UBound(vTl)
   ColsCols = tlMax + 2
   ColsRows = .fBill.Count + 2
   '//
   frmCols.ShowTopLabel 0, 0
   frmCols.ShowSideLabel 0, 0
   frmCols.ShowSheetLabel 0, 0
   frmCols.SetSelectMode 0, 1
   frmCols.ShowPageBreak 0
   '//滚动栏信息
   frmCols.ShowHScroll 1, 0
   frmCols.ShowVScroll 0, 0
   frmCols.AllowSizeColInGrid = True
   frmCols.AllowSizeRowInGrid = True
   '//页面信息
   frmCols.PrintSetPaper 9
   frmCols.PrintSetOrient 1
   frmCols.PrintSetAlign 1, 1
   frmCols.PrintSetMargin 10, 0.5, 10, 0.5
   frmCols.WndBkColor = RGB(&HFF, &HFF, &HFF)
   frmCols.SetCols ColsCols, 0
   frmCols.SetRows ColsRows, 0
   '//打印标题
   For iLoop = tlMin To tlMax
    frmCols.SetColWidth 1, 100, iLoop + 1, 0
    frmCols.SetCellFont iLoop + 1, 1, 0, frmCols.FindFontIndex("黑体", 1)
    frmCols.SetCellFontSize iLoop + 1, 1, 0, 11
    frmCols.SetCellAlign iLoop + 1, 1, 0, 4 + 32
    frmCols.SetCellFontStyle iLoop + 1, 1, 0, 2
    frmCols.SetCellInput iLoop + 1, 1, 0, 5
    frmCols.SetCellString iLoop + 1, 1, 0, vTl(iLoop)
    frmCols.SetCellBackColor iLoop + 1, 1, 0, frmCols.FindColorIndex(RGB(&HED, &HF5, &HFE), 1)
   Next
   '//
   For iLoop = 1 To .fBill.Count
    Set enObj = CreateObject("StdRptBase.FieldControl")
    enObj.Js_FieldControlID = .fBill.Item(iLoop).Js_FieldControlID
    enObj.Js_RptID = .fBill.Item(iLoop).Js_RptID
    enObj.Js_FieldName = .fBill.Item(iLoop).Js_FieldName
    enObj.Js_FieldDsecID = .fBill.Item(iLoop).Js_FieldDsecID
    enObj.Js_FieldDsec = .fBill.Item(iLoop).Js_FieldDsec
    enObj.Js_FieldLen = .fBill.Item(iLoop).Js_FieldLen
    enObj.Js_FieldWidth = .fBill.Item(iLoop).Js_FieldWidth
    enObj.Js_FieldAlign = .fBill.Item(iLoop).Js_FieldAlign
    enObj.Js_FieldShowSign = .fBill.Item(iLoop).Js_FieldShowSign
    enObj.Js_RightID = .fBill.Item(iLoop).Js_RightID
    enObj.Js_FieldOrderID = .fBill.Item(iLoop).Js_FieldOrderID
    enObj.Js_FieldOrderSign = .fBill.Item(iLoop).Js_FieldOrderSign
    objRpt.fBill.Add enObj
    Set enObj = Nothing
    '//开始还原数据.字段名称
    frmCols.SetCellString 1, iLoop + 1, 0, .fBill.Item(iLoop).Js_FieldName
    frmCols.SetCellInput 1, iLoop + 1, 0, 5
    frmCols.SetCellBackColor 1, iLoop + 1, 0, frmCols.FindColorIndex(RGB(&HFF, &HFF, &HCC), 1)
    
    '//字段类型
    frmCols.SetCellString 2, iLoop + 1, 0, fID2fName(.fBill.Item(iLoop).Js_FieldDsecID)
    frmCols.SetCellInput 2, iLoop + 1, 0, 5
    frmCols.SetCellBackColor 2, iLoop + 1, 0, frmCols.FindColorIndex(RGB(&HFF, &HFF, &HCC), 1)
    frmCols.SetCellDouble 11, iLoop + 1, 0, .fBill.Item(iLoop).Js_FieldDsecID
    
    '//字段长度
    frmCols.SetCellInput 3, iLoop + 1, 0, 3
    frmCols.SetCellDigital 3, iLoop + 1, 0, 0
    frmCols.SetCellDouble 3, iLoop + 1, 0, .fBill.Item(iLoop).Js_FieldLen
    
    '//小数位数
    Select Case .fBill.Item(iLoop).Js_FieldDsecID
     Case 3, 4, 5, 6, 11, 17, 20, 128, 131, 204
      frmCols.SetCellDouble 4, iLoop + 1, 0, .fBill.Item(iLoop).Js_FieldOrderSign
      frmCols.SetSpinCellEx 4, iLoop + 1, 0, 1, 20, 1, 2
     Case Else
      frmCols.SetCellInput 4, iLoop + 1, 0, 5
      frmCols.SetCellString 4, iLoop + 1, 0, ""
      frmCols.SetCellBackColor 4, iLoop + 1, 0, frmCols.FindColorIndex(RGB(&HFF, &HFF, &HCC), 1)
    End Select
   
    '//标题宽度
    frmCols.SetCellInput 5, iLoop + 1, 0, 3
    frmCols.SetCellDouble 5, iLoop + 1, 0, .fBill.Item(iLoop).Js_FieldWidth
    frmCols.SetCellDigital 5, iLoop + 1, 0, 0
    
    '//对齐方式
    frmCols.SetCellString 6, iLoop + 1, 0, getCellAlignCn(.fBill.Item(iLoop).Js_FieldAlign)
    frmCols.SetDroplistCell 6, iLoop + 1, 0, AlignDesc, 4
    
    '//是否显示
    frmCols.SetCellString 7, iLoop + 1, 0, getShowSignCn(.fBill.Item(iLoop).Js_FieldShowSign)
    frmCols.SetDroplistCell 7, iLoop + 1, 0, ShowSign, 4
    
    '//访问权限
    frmCols.SetCellInput 8, iLoop + 1, 0, 5
    frmCols.SetCellString 8, iLoop + 1, 0, meObj.BaseInfo.getItemName(8, .fBill.Item(iLoop).Js_RightID)
    frmCols.SetCellBackColor 8, iLoop + 1, 0, frmCols.FindColorIndex(RGB(&HFF, &HFF, &H99), 1)
    frmCols.SetCellDouble 10, iLoop + 1, 0, .fBill.Item(iLoop).Js_RightID
    
    '//描述
    frmCols.SetCellString 9, iLoop + 1, 0, .fBill.Item(iLoop).Js_FieldDsec
   Next
   frmCols.SetColHidden 10, 11
   frmCols.DrawGridLine 1, 1, ColsCols, ColsRows, 0, 2, -1
  End If
  
  '//===*快速搜速条件*===
  If objRpt.lBill.Count > 0 Then
   For iLoop = objRpt.lBill.Coun To 1 Step -1
    objRpt.lBill.Remove iLoop
   Next
  End If
  Call EditProInfo(Trim(frmParam.GetCellString2(2, 8, 0)))
  
  If meFnd.Count > 0 Then
   frmTable.TabEnabled(3) = True
  End If
  
  vTl = Split(FilStr, "|")
  tlMin = LBound(vTl)
  tlMax = UBound(vTl)
  ColsCols = tlMax + 2
  ColsRows = meFnd.Count + 2
  
  '//
  frmFind.ShowTopLabel 0, 0
  frmFind.ShowSideLabel 0, 0
  frmFind.ShowSheetLabel 0, 0
  frmFind.SetSelectMode 0, 1
  frmFind.ShowPageBreak 0
  '//滚动栏信息
  frmFind.ShowHScroll 0, 0
  frmFind.ShowVScroll 0, 0
  frmFind.AllowSizeColInGrid = True
  frmFind.AllowSizeRowInGrid = True
  '//页面信息
  frmFind.PrintSetPaper 9
  frmFind.PrintSetOrient 1
  frmFind.PrintSetAlign 1, 1
  frmFind.PrintSetMargin 10, 0.5, 10, 0.5
  frmFind.WndBkColor = RGB(&HFF, &HFF, &HFF)
  '
  frmFind.SetCols ColsCols, 0
  frmFind.SetRows ColsRows, 0
  
  '//打印标题
  For iLoop = tlMin To tlMax
   frmFind.SetColWidth 1, 100, iLoop + 1, 0
   frmFind.SetCellFont iLoop + 1, 1, 0, frmFind.FindFontIndex("黑体", 1)
   frmFind.SetCellFontSize iLoop + 1, 1, 0, 11
   frmFind.SetCellAlign iLoop + 1, 1, 0, 4 + 32
   frmFind.SetCellFontStyle iLoop + 1, 1, 0, 2
   frmFind.SetCellInput iLoop + 1, 1, 0, 5
   frmFind.SetCellString iLoop + 1, 1, 0, vTl(iLoop)
   frmFind.SetCellBackColor iLoop + 1, 1, 0, frmFind.FindColorIndex(RGB(&HED, &HF5, &HFE), 1)
  Next
  
  For iLoop = 1 To meFnd.Count
   '//显示字段名称
   frmFind.SetCellString 2, iLoop + 1, 0, meFnd.Item(iLoop).pName
   frmFind.SetCellInput 2, iLoop + 1, 0, 5
   frmFind.SetCellBackColor 2, iLoop + 1, 0, frmFind.FindColorIndex(RGB(&HFF, &HFF, &HCC), 1)

   frmFind.SetCellString 3, iLoop + 1, 0, meFnd.Item(iLoop).pType
   frmFind.SetCellInput 3, iLoop + 1, 0, 5
   frmFind.SetCellBackColor 3, iLoop + 1, 0, frmFind.FindColorIndex(RGB(&HFF, &HFF, &HCC), 1)
'
   '//访问权限
   frmFind.SetCellInput 4, iLoop + 1, 0, 5
   frmFind.SetCellBackColor 4, iLoop + 1, 0, frmFind.FindColorIndex(RGB(&HFF, &HFF, &H99), 1)
   
   frmFind.DrawGridLine 1, 1, ColsCols, ColsRows, 0, 2, -1
  Next
  
  If .lBill.Count > 0 Then
   For iLoop = 1 To .lBill.Count
    Set enObj = CreateObject("StdRptBase.Filt")
    enObj.Js_FiltID = .lBill.Item(iLoop).Js_FiltID
    enObj.Js_RptID = .lBill.Item(iLoop).Js_RptID
    enObj.Js_FieldControlID = .lBill.Item(iLoop).Js_FieldControlID
    enObj.Js_LinkSign = .lBill.Item(iLoop).Js_LinkSign
    enObj.Js_Desc = .lBill.Item(iLoop).Js_Desc
    enObj.Js_OrderID = .lBill.Item(iLoop).Js_OrderID
    objRpt.lBill.Add enObj
    Set enObj = Nothing
    '//
    frmFind.SetCellString 1, .lBill.Item(iLoop).Js_OrderID + 1, 0, .lBill.Item(iLoop).Js_Desc
    frmFind.SetCellDouble 5, .lBill.Item(iLoop).Js_OrderID + 1, 0, .lBill.Item(iLoop).Js_FieldControlID
    frmFind.SetCellString 4, .lBill.Item(iLoop).Js_OrderID + 1, 0, meObj.BaseInfo.getItemName(3, .lBill.Item(iLoop).Js_FieldControlID)
   Next
  End If
  frmFind.SetColHidden 5, 5
  
  
  '//===*报表标题*===
  If objRpt.tBill.Count > 0 Then
   For iLoop = objRpt.tBill.Count To 1 Step -1
    objRpt.tBill.Remove iLoop
   Next
  End If
  Call EditColsInfo(Trim(frmParam.GetCellString2(2, 8, 0)))
  If meTitle.Count > 0 Then
   frmTable.TabEnabled(4) = True
  End If
  ColsCols = meTitle.Count + 1
  ColsRows = MaxTitleRow + 2
  
  '//
  frmRptTitle.ShowTopLabel 0, 0
  frmRptT