comtest.frm

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

VERSION 5.00
Begin VB.Form ComTest 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Com组件测试"
   ClientHeight    =   3075
   ClientLeft      =   45
   ClientTop       =   450
   ClientWidth     =   4680
   Icon            =   "ComTest.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3075
   ScaleWidth      =   4680
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command2 
      Caption         =   "读取存储"
      Height          =   495
      Left            =   1800
      TabIndex        =   1
      Top             =   1920
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "组件测试"
      Height          =   495
      Left            =   1800
      TabIndex        =   0
      Top             =   1320
      Width           =   1215
   End
End
Attribute VB_Name = "ComTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Command1_Click()
 Dim RptObj As Object
 Dim iLoop As Integer
 Dim EntryObj As Object
 Dim MsgInfo As String
 Set RptObj = CreateObject("StdRptBase.Rpt")
 With RptObj
  .NewBill
  .Js_RptID = 1
  .Js_GroupID = 1
  .Js_RptName = "月销售成本"
  .Js_RptDesc = "公司月销售成本公司领导查看"
  .Js_RptCallName = "Sp_XiaoShou"
  .Js_RptWidth = 2400
  .Js_RptHeight = 1200
  .Js_RightID = 1
  .Js_UserID = 1
  .Js_Date = "2004-09-12"
  .Js_Time = "12:12:23"
 End With
 For iLoop = 1 To 3
  Set EntryObj = CreateObject("StdRptBase.HeaderFooter")
  With EntryObj
   .Js_HeaderFooterID = iLoop
   .Js_RptID = RptObj.Js_RptID
   .Js_hfTypeID = 1
   .Js_hfText = "测试报表"
   .Js_hfFontName = "宋体"
   .Js_hfFontSize = 18
   .Js_hfFontBold = 1
   .Js_hfFontItalic = 0
   .Js_hfFontUnderline = 0
   .Js_HeaderFooterOrderID = iLoop
  End With
  RptObj.hBill.Add EntryObj
  Set EntryObj = Nothing
 Next
 For iLoop = 1 To 4
  Set EntryObj = CreateObject("StdRptBase.Title")
  With EntryObj
   .Js_TitleID = iLoop
   .Js_RptID = RptObj.Js_RptID
   .Js_SRow = 1
   .Js_ERow = 1
   .Js_SCol = 1
   .Js_ECol = 1
   .Js_Text = "序号"
  End With
  RptObj.tBill.Add EntryObj
  Set EntryObj = Nothing
 Next
 For iLoop = 1 To 2
  Set EntryObj = CreateObject("StdRptBase.FieldControl")
  With EntryObj
   .Js_FieldControlID = iLoop
   .Js_RptID = RptObj.Js_RptID
   .Js_FieldName = "字段" & iLoop
   .Js_FieldDsecID = 1
   .Js_FieldDsec = "序号" & iLoop
   .Js_FieldLen = 2
   .Js_FieldWidth = 1200
   .Js_FieldAlign = 1
   .Js_FieldShowSign = 1
   .Js_RightID = 1
   .Js_FieldOrderID = iLoop
   .Js_FieldOrderSign = 0
  End With
  RptObj.fBill.Add EntryObj
  Set EntryObj = Nothing
 Next
 For iLoop = 1 To 3
  Set EntryObj = CreateObject("StdRptBase.Filt")
  With EntryObj
   .Js_FiltID = iLoop
   .Js_RptID = RptObj.Js_RptID
   .Js_FieldControlID = 1
   .Js_LinkSign = 1
   .Js_Desc = "销售月份"
   .Js_OrderID = iLoop
  End With
  RptObj.lBill.Add EntryObj
  Set EntryObj = Nothing
 Next
 If RptObj.Save(MsgInfo) = False Then
  MsgBox MsgInfo, vbCritical
 Else
  MsgBox MsgInfo, vbInformation
 End If
 Set RptObj = Nothing
End Sub

Private Sub Command2_Click()
 Dim ProObj As Object
 Set ProObj = CreateObject("StdRptBase.StdRptBaseCls")
' If ProObj.UserImport(MsgInfo) = True Then
'  MsgBox MsgInfo, vbInformation
' Else
'  MsgBox MsgInfo, vbCritical
' End If '//("NewFieldControl")getDigit
 MsgBox ProObj.getSystemIP
 Set ProObj = Nothing
End Sub