跪求active report的教程文档！

Option ExplicitPrivate Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfnCallback As Long
  lParam As Long
  iImage As Long
End Type'BROWSEINFO.ulFlags values:
Private Const BIF_EDITBOX = &H10
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_USENEWUI = &H40' notification messages
Private Const BFFM_INITIALIZED = &H1' control messages
Private Const BFFM_SETSELECTION = &H466' constants for nFolder parm of SHGetSpecialFolderLocation
Private Const CSIDL_DESKTOP = &H0Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hWndOwner As Long, ByVal nFolder As Long, ppidl As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)Private gmStrPath As String     ' global ;( to pass path to callback funcPrivate Function HRSUCCEEDED(hr As Long) As Boolean
    HRSUCCEEDED = (hr >= 0)
End FunctionPrivate Function HRFAILED(hr As Long) As Boolean
    HRFAILED = (hr < 0)
End Function' simply returns parameter given
Private Function DummyFunc(ByVal param As Long) As Long
    DummyFunc = param
End FunctionPrivate Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
On Error Resume Next
Dim pathstring As String  ' default path

    If uMsg = BFFM_INITIALIZED Then
        pathstring = gmStrPath  ' assign default path
        ' Send a message to the dialog box telling it to select this path.
        ' Note the use of ByVal and the CLng function here.
        SendMessage hwnd, BFFM_SETSELECTION, ByVal CLng(1), ByVal pathstring
    End If    BrowseCallbackProc = 0  ' the function should always return 0
End Function
Public Function hlpBrowseForFolder(hWndOwner As Long, sTitle As String, ByRef sPath As String) As Boolean
    Dim bInf As BROWSEINFO
    Dim hr As Long
    Dim pidl As Long
    Dim sRetPath As String    hlpBrowseForFolder = False

    bInf.hOwner = hWndOwner

    hr = SHGetSpecialFolderLocation(hWndOwner, CSIDL_DESKTOP, bInf.pidlRoot)
    If HRFAILED(hr) Then Exit Function

    bInf.pszDisplayName = Space$(260)
    bInf.lpszTitle = sTitle
    bInf.ulFlags = BIF_EDITBOX + BIF_USENEWUI + BIF_RETURNONLYFSDIRS
    bInf.lpfnCallback = DummyFunc(AddressOf BrowseCallbackProc)

    bInf.lParam = 0
    bInf.iImage = 0
    gmStrPath = sPath

    ' open browse dialog
    pidl = SHBrowseForFolder(bInf)

    If pidl <> 0 Then
        sRetPath = Space$(260)
        hr = SHGetPathFromIDList(pidl, sRetPath)
        If HRSUCCEEDED(hr) Then
            sRetPath = Left$(sRetPath, InStr(sRetPath, vbNullChar) - 1)
            CoTaskMemFree pidl

            sPath = sRetPath
            hlpBrowseForFolder = True
        End If
    End If
    CoTaskMemFree bInf.pidlRoot
End Function
Option ExplicitPublic Pages As PagesPrivate Sub btnAuxFolder_Click()
Dim sFOlder As String
    On Error GoTo ehHTMLFolder

    If Not hlpBrowseForFolder(Me.hwnd, "Select the HTML images folder", sFOlder) Then Exit Sub
    txtAuxFolder = sFOlder
    Exit Sub

ehHTMLFolder:
    MsgBox Str(Err.Number) & " - " & Err.Description, vbOKOnly, "Images Folder Select Error"
End SubPrivate Sub btnBrowse_Click(Index As Integer)
    On Error GoTo ehBrowse

    Select Case Index
    Case 0  ' RTF
        dlg.Filter = "Rich Text Format (*.RTF)|*.rtf"
    Case 1  ' PDF
        dlg.Filter = "Portable Document Format (*.pdf)|*.pdf"
    Case 2  ' HTML
        ' No file name
    Case 3  ' Excel
        dlg.Filter = "Microsoft Excel Document (*.xls)|*.xls"
    Case 4  ' TIF
        dlg.Filter = "Tagged Image Format (*.tif)|*.tif"
    Case 5  ' Text
        dlg.Filter = "Text Document (*.txt)|*.txt"
    End Select    dlg.ShowSave    If dlg.FileName <> "" Then txtFilename(Index).Text = dlg.FileName

    Exit Sub
ehBrowse:
    MsgBox Str(Err.Number) & " - " & Err.Description, vbOKOnly, "Error browsing for filename"
End SubPrivate Sub btnCancel_Click()
    Unload Me
End SubPrivate Sub btnHTMLFolder_Click()
Dim sFOlder As String
    On Error GoTo ehHTMLFolder
    If Not hlpBrowseForFolder(Me.hwnd, "Select the HTML pages folder", sFOlder) Then Exit Sub
    txtHTMLFolder.Text = sFOlder
    Exit Sub

ehHTMLFolder:
    MsgBox Str(Err.Number) & " - " & Err.Description, vbOKOnly, "HTML Folder Select Error"
End Sub

Private Sub btnOK_Click()
    On Error GoTo ehExport    If Pages Is Nothing Then Exit Sub
    If cboExportFormat.ListIndex < 0 Then Exit Sub
    If txtFilename(cboExportFormat.ListIndex) = "" Then Exit Sub

    Select Case cboExportFormat.ListIndex
    Case 0  ' RTF
        Dim rtf As ARExportRTF
        Set rtf = New ARExportRTF
        rtf.FileName = txtFilename(cboExportFormat.ListIndex).Text
        rtf.Export Pages
        Set rtf = Nothing
    Case 1  ' PDF
        Dim lFont As Long
        Dim sFonts As String
        sFonts = ""

        Dim pdf As ARExportPDF
        Set pdf = New ARExportPDF

        pdf.FileName = txtFilename(cboExportFormat.ListIndex).Text
        pdf.AcrobatVersion = cboAcrobatVersion.ListIndex

        Select Case cboPDFJPGQuality.ListIndex
        Case 0: pdf.JPGQuality = 25
        Case 1: pdf.JPGQuality = 50
        Case 2: pdf.JPGQuality = 75
        Case 3: pdf.JPGQuality = 100    ' No Compression
        End Select

        ' Create a semi-color delimited string of the fonts
        ' that shouldn't be embedded in the PDF file
        For lFont = 0 To lstPDFFonts.ListCount - 1
            If lstPDFFonts.Selected(lFont) Then
                sFonts = sFonts & lstPDFFonts.List(lFont) & ";"
            End If
        Next
        pdf.SemiDelimitedNeverEmbedFonts = sFonts
        pdf.Export Pages
        Set pdf = Nothing
    Case 2  ' HTML
        Dim html As HTMLexport
        Set html = New HTMLexport

        html.FileNamePrefix = txtFilename(cboExportFormat.ListIndex).Text
        If txtHTMLFolder.Text = "" Then
            html.HTMLOutputPath = App.Path
        Else
            html.HTMLOutputPath = txtHTMLFolder.Text
        End If

        If txtAuxFolder.Text = "" Then
            html.AuxOutputPath = App.Path
        Else
            html.AuxOutputPath = txtAuxFolder.Text
        End If

        If txtHTMLCharset.Text = "" Then
            ' Set default value
        Else
            html.CharacterSet = txtHTMLCharset.Text
        End If

        html.Title = txtHTMLTitle.Text
        html.HTMLVersion = cboHTMLVersion.ListIndex
        html.TableOfContents = cboTOCFormat.ListIndex
        html.CreateCSSFile = (chkCreateCSS.Value = 1)
        html.CreateFramesetPage = (chkCreateFrameset.Value = 1)
        html.MHTOutput = (chkMHTArchive.Value = 1)
        html.MultiPageOutput = (chkSinglePage.Value = 0)
        html.Export Pages
        Set html = Nothing
    Case 3  ' XLS
        Dim xls As ARExportExcel
        Set xls = New ARExportExcel
        xls.FileName = txtFilename(3).Text
        Select Case cboXLSVersion.ListIndex
        Case 0: xls.Version = 2
        Case 1: xls.Version = 3
        Case 2: xls.Version = 4
        Case 3: xls.Version = 5
        Case 4: xls.Version = 7
        Case 5: xls.Version = 8
        End Select
        xls.AutoRowHeight = (chkXLSAutoRowHeight.Value = 1)
        xls.BorderSpace = Val(txtXLSBorderSpace.Text)
        xls.DoubleBoundaries = (chkXLSDoubleBoundaries.Value = 1)
        xls.GenPagebreaks = (chkXLSGenPageBreaks.Value = 1)
        xls.MinColumnWidth = Val(txtXLSMinColWidth.Text)
        xls.MinRowHeight = Val(txtXLSMinRowHeight.Text)
        xls.MultiSheet = (chkXLSMultisheet.Value = 1)
        xls.ShowMarginSpace = (chkXLSShowMarginSpace.Value = 1)
        xls.TrimEmptySpace = (chkXLSTrimEmptySpace.Value = 1)
        xls.Export Pages
        Set xls = Nothing
    Case 4  ' TIF
        Dim tif As TIFFExport
        Set tif = New TIFFExport

        tif.FileName = txtFilename(4).Text
        tif.Export Pages
        Set tif = Nothing
    Case 5  ' TXT
        Dim txt As ARExportText
        Set txt = New ARExportText
        txt.FileName = txtFilename(5).Text
        txt.TextDelimiter = txtTXTTextDelimiter.Text
        txt.SuppressEmptyLines = (chkTXTSupressEmptyLines.Value = 1)
        txt.Unicode = (chkTXTUnicode.Value = 1)
        txt.Export Pages
        Set txt = Nothing
    End Select
    Unload Me
    Exit Sub
ehExport:
    MsgBox Str(Err.Number) & " - " & Err.Description, vbOKOnly, "Error Exporting Document"
End SubPrivate Sub cboExportFormat_Click()
    On Error GoTo ehExportFormatClick
    If cboExportFormat.ListIndex < 0 Then Exit Sub

    Dim i As Integer
    For i = 0 To 5
        picOptions(i).Left = -10000
        picOptions(i).Visible = False
    Next
    picOptions(cboExportFormat.ListIndex).Visible = True
    picOptions(cboExportFormat.ListIndex).Left = 1560

    Exit Sub
ehExportFormatClick:
    MsgBox Str(Err.Number) & " - " & Err.Description, vbOKOnly, "Error ExportFormat_Click"
End SubPrivate Sub Form_Load()
Dim lFont As Long

    ' Load PDF Fonts
    ' This routine can be optimized by using API functions to
    ' enumerate fonts
    For lFont = 1 To Screen.FontCount
        lstPDFFonts.AddItem Screen.Fonts(lFont)
    Next

    cboAcrobatVersion.ListIndex = 1 ' 3.x
    cboHTMLVersion.ListIndex = 1    ' DHTML
    cboPDFJPGQuality.ListIndex = 2  ' 75%
    cboTOCFormat.ListIndex = 0  ' None
    cboXLSVersion.ListIndex = 5 ' 8.x
End Sub

MIS报表平台web插件发布，可轻松将MIS报表在网上发布，插件随网络版赠送，详细信息请登录我们的网站www.51grid.com

ftp://218.93.12.179下载,用户名和密码都是:friend
里面的教程里面有我上传的active report2.0专业版手册
(仔细找)

多谢axer(kingrow)老兄！我已经下载了文档！不胜感激！

我怎么在ftp中没找到呀
给我发一份吧
[email protected]

能发给我吗？谢谢！
[email protected]

调试易

跪求active report的教程文档！

解决方案 »