form2.frm

一个很好用的报表控件

            cboZoom.Text = "51%"
        Case "2"  'Whole Page
            cboZoom.Text = "52%"
        Case Else
            For indx = 0 To cboZoom.ListCount
                If strZoomLevel = Left(cboZoom.List(indx), Len(strZoomLevel)) Then
                    cboZoom.Text = cboZoom.List(indx)
                    Exit Sub
                End If
            Next indx
    End Select
End Sub
Private Sub CRViewer1_ZoomLevelChanged(ByVal ZoomLevel As Integer)
mSetZoomLevelOnControl CStr(ZoomLevel)
End Sub
' *************************************************************
' Get the current page of the viewer when the viewer has finished
' generating the page
'
Private Function migetCurrentPage() As Integer
    While CRViewer1.IsBusy
        DoEvents
    Wend
    migetCurrentPage = CRViewer1.GetCurrentPageNumber
End Function
Private Sub Form_Load()
On Error GoTo Form_Load_err
    Screen.MousePointer = vbHourglass
    Call mCreateToolbar
    ' Set the report source
    CRViewer1.ReportSource = Report
    CRViewer1.ViewReport
    StatusBar.SimpleText = Report.ReportTitle
    txtCurPage = migetCurrentPage
    Call Form_Resize
    Screen.MousePointer = vbDefault
    Exit Sub
' Let the user know about any errors that might have occurred.
Form_Load_err:
    MsgBox "Error: " + CStr(Err) + Chr(10) + Chr(13) + _
            Error(Err), , "Form Load"
End Sub
' *************************************************************
' Load zoom percentages into combo box
'
Private Sub mInsertZoomPercentages()
    cboZoom.Clear
    With cboZoom
        .AddItem "400%", 0
        .AddItem "300%", 1
        .AddItem "200%", 2
        .AddItem "150%", 3
        .AddItem "100%", 4
        .AddItem "75%", 5
        .AddItem "50%", 6
        .AddItem "25%", 7
        .AddItem "Page Width", 8
        .AddItem "Whole Page", 9
    End With
    cboZoom.Text = cboZoom.List(4)  ' Set list to 100%
End Sub
Private Sub Form_Resize()
    Dim iTop As Integer
    Dim iAdjustment As Integer
    If Toolbar.Visible Then
        iTop = Toolbar.Height
        iAdjustment = Toolbar.Height + StatusBar.Height
    Else
        iTop = 0
        iAdjustment = StatusBar.Height
    End If
    Debug.Assert Me.Height > iAdjustment
    CRViewer1.Top = iTop
    CRViewer1.Left = 0
    CRViewer1.Height = Me.Height - iAdjustment
    CRViewer1.Width = Me.Width
End Sub
' *************************************************************
' Create the toolbar with all the appropriate icons.
'
Private Sub mCreateToolbar()
    Dim setButton As Button
    Dim ImageList As ListImage
    Dim strIconPath As String
    On Error GoTo mCreateToolbar_err
    ' Set path to icon directory
    strIconPath = App.Path + "\icons\"
    ' Set icon sizing and create list
    ImgLst.ImageHeight = 16
    ImgLst.ImageWidth = 16
    With ImgLst.ListImages
        Set ImageList = .Add(, "close", LoadPicture(strIconPath + "w95mbx01.ico"))
        Set ImageList = .Add(, "print", LoadPicture(strIconPath + "printfld.ico"))
        Set ImageList = .Add(, "refresh", LoadPicture(strIconPath + "refresh.ico"))
        Set ImageList = .Add(, "search", LoadPicture(strIconPath + "binoculr.ico"))
        Set ImageList = .Add(, "firstpage", LoadPicture(strIconPath + "arw03lt.ico"))
        Set ImageList = .Add(, "prevpage", LoadPicture(strIconPath + "arw04lt.ico"))
        Set ImageList = .Add(, "nextpage", LoadPicture(strIconPath + "arw04rt.ico"))
        Set ImageList = .Add(, "lastpage", LoadPicture(strIconPath + "arw03rt.ico"))
        Set ImageList = .Add(, "grouptree", LoadPicture(strIconPath + "graph14.ico"))
    End With
    ' Bind toolbar to imagelist and set buttons on toolbar which require icons
    Set Toolbar.ImageList = ImgLst
    Toolbar.ButtonHeight = ImgLst.ImageHeight
    Toolbar.ButtonWidth = ImgLst.ImageWidth
    ' Set an icon for each button on the toolbar
    Set setButton = Toolbar.Buttons(CLOSE_BUT)
        setButton.Image = "close"
        setButton.ToolTipText = "Close Current View"
    Set setButton = Toolbar.Buttons(FIRSTPAGE_BUT)
        setButton.Image = "firstpage"
        setButton.ToolTipText = "Go to First Page"
    Set setButton = Toolbar.Buttons(PREVPAGE_BUT)
        setButton.Image = "prevpage"
        setButton.ToolTipText = "Go to Previous Page"
    Set setButton = Toolbar.Buttons(NEXTPAGE_BUT)
        setButton.Image = "nextpage"
        setButton.ToolTipText = "Go to Next Page"
    Set setButton = Toolbar.Buttons(LASTPAGE_BUT)
        setButton.Image = "lastpage"
        setButton.ToolTipText = "Go to Last Page"
    Set setButton = Toolbar.Buttons(PRINT_BUT)
        setButton.Image = "print"
        setButton.ToolTipText = "Print Report"
    Set setButton = Toolbar.Buttons(REFRESH_BUT)
        setButton.Image = "refresh"
        setButton.ToolTipText = "Refresh"
    Set setButton = Toolbar.Buttons(SEARCH_BUT)
        setButton.Image = "search"
        setButton.ToolTipText = "Search Text"
    Set setButton = Toolbar.Buttons(GROUPTREE_BUT)
        setButton.Image = "grouptree"
        setButton.ToolTipText = "Toggle Group Tree"
        If CRViewer1.DisplayGroupTree Then
            setButton.Value = tbrPressed
        Else
            setButton.Value = tbrUnpressed
        End If
        mInsertZoomPercentages 'insert zoom percentages into combo box
    Exit Sub
' Handle toolbar errors
mCreateToolbar_err:
    MsgBox "Error: " + CStr(Err) + Chr(10) + Chr(13) + _
            Error(Err), , "Creating Toolbar"
End Sub
Private Sub mnuCRToolbar_Click()
CRViewer1.DisplayToolbar = Not CRViewer1.DisplayToolbar
    mnuCRToolbar.Checked = Not mnuCRToolbar.Checked
End Sub
Private Sub mnuCustomToolbar_Click()
Toolbar.Visible = Not Toolbar.Visible
    mnuCustomToolbar.Checked = Not mnuCustomToolbar.Checked
    Call Form_Resize
End Sub
Private Sub mnuDisplayGroupTree_Click()
CRViewer1.DisplayGroupTree = Not CRViewer1.DisplayGroupTree
    mnuDisplayGroupTree.Checked = Not mnuDisplayGroupTree.Checked
End Sub
' *************************************************************
' Checks active view to see if it is the top index view.  If the
' view is the top view (1) then the close view button on toolbar
' is disabled.
'
Private Sub mCheckActiveView()
    If CRViewer1.ActiveViewIndex = TOP_VIEW Then mEnableCloseButton False
End Sub
Private Sub Toolbar_ButtonClick(ByVal Button As ComctlLib.Button)
 Select Case Button.Index
    Case CLOSE_BUT
        ' Closes active view
        If CRViewer1.ActiveViewIndex > 1 Then
            CRViewer1.CloseView (CRViewer1.ActiveViewIndex)
        End If
        mCheckActiveView
    Case FIRSTPAGE_BUT
        CRViewer1.ShowFirstPage
        txtCurPage = migetCurrentPage
    Case PREVPAGE_BUT
        CRViewer1.ShowPreviousPage
        txtCurPage = migetCurrentPage
    Case NEXTPAGE_BUT
        CRViewer1.ShowNextPage
        txtCurPage = migetCurrentPage
    Case LASTPAGE_BUT
        CRViewer1.ShowLastPage
        txtCurPage = migetCurrentPage
    Case PRINT_BUT
        CRViewer1.PrintReport
    Case REFRESH_BUT
        CRViewer1.Refresh
    Case SEARCH_BUT
        Call mSearchForText
    Case GROUPTREE_BUT
        CRViewer1.DisplayGroupTree = Not CRViewer1.DisplayGroupTree
        Call mSetGroupTree
    End Select
End Sub
' *************************************************************
' Search for text in the report
'
Private Sub mSearchForText()
    If cboSearch.Text = "" Then
        MsgBox "Search Text not specified", vbOKOnly, "Search Text"
    Else
        CRViewer1.SearchForText (cboSearch.Text)
    End If
End Sub
' *************************************************************
' Set the GroupTree button to be the same as the "Display Group Tree"
' option in the viewer
'
Private Sub mSetGroupTree()
    Dim GroupTreeButton As Button
    Set GroupTreeButton = Toolbar.Buttons(GROUPTREE_BUT)
    If CRViewer1.DisplayGroupTree Then
        GroupTreeButton.Value = tbrPressed
    Else
        GroupTreeButton.Value = tbrUnpressed
    End If
    
    Set GroupTreeButton = Nothing
End Sub
' *************************************************************
' Return a string that the viewer can use to set the zoom-in value
'
Private Function mstrGetZoomPercentage() As String
    Dim ipercentpos As String
    ipercentpos = InStr(1, cboZoom.Text, "%")
    If ipercentpos <> 0 Then
        mstrGetZoomPercentage = Left(cboZoom.Text, ipercentpos - 1) ' Returns a numeric string
    ElseIf cboZoom.Text = "Page Width" Then
        mstrGetZoomPercentage = "1"
    ElseIf cboZoom.Text = "Whole Page" Then
        mstrGetZoomPercentage = "2"
    End If
End Function