home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 May / W2KPRK.iso / apps / crystal / disk18 / Xvb388._ / Xvb388.
Text File  |  1999-08-23  |  7KB  |  193 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "clsXtremeDemo"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11.  
  12. Private m_strFilename As String
  13. Private m_strReportPath
  14.  
  15. Private m_crwApplication As CRPEAuto.Application
  16. Private m_crwReport As CRPEAuto.Report
  17. Private m_crwView As CRPEAuto.View
  18. Private m_crwDatabase As CRPEAuto.Database
  19. Private m_crwDatabaseTable As CRPEAuto.DatabaseTable
  20. Private m_crwSubReport As CRPEAuto.Report
  21.  
  22. Public WithEvents m_crwWindow As CRPEAuto.Window
  23. Attribute m_crwWindow.VB_VarHelpID = -1
  24.  
  25.  
  26. Public Sub CloseWindow()
  27.   If Not m_crwWindow Is Nothing Then
  28.     frmMain.mnuFileClose.Enabled = False
  29.     m_crwWindow.Close
  30.     Set m_crwWindow = Nothing
  31.     Set m_crwView = Nothing
  32.   End If
  33. End Sub
  34.  
  35. Public Sub LaunchReport(strReportName As String)
  36.   On Error GoTo LaunchReport_Error
  37.   
  38.   Screen.MousePointer = vbHourglass
  39.   
  40.   If m_crwApplication Is Nothing Then Set m_crwApplication = CreateObject("Crystal.CRPE.Application")
  41.   
  42.   If m_strReportPath = "" Then
  43.     m_strReportPath = Mid(App.Path, 1, (Len(App.Path) - 23)) & "\reports\xtreme\"
  44.   End If
  45.   
  46.   m_strFilename = m_strReportPath & strReportName & ".rpt"
  47.   While Dir(m_strFilename) = ""
  48.     If MsgBox("Could not open " & m_strFilename & vbCrLf & vbCrLf & _
  49.     "Would you like to browse?", vbYesNo) = vbYes Then
  50.       frmMain.dlgCommonDialog.CancelError = True
  51.       frmMain.dlgCommonDialog.filename = m_strFilename
  52.       frmMain.dlgCommonDialog.Filter = "*.rpt"
  53.       frmMain.dlgCommonDialog.ShowOpen
  54.       m_strFilename = frmMain.dlgCommonDialog.filename
  55.     Else
  56.       GoTo LaunchReport_Error
  57.     End If
  58.   Wend
  59.   
  60.   Screen.MousePointer = vbHourglass
  61.   
  62.   'open the report (but not start it)
  63.   Set m_crwReport = m_crwApplication.OpenReport(m_strFilename)
  64.   
  65.   Set m_crwDatabase = m_crwReport.Database
  66.   For Each m_crwDatabaseTable In m_crwDatabase.Tables
  67.     m_crwDatabaseTable.Location = frmMain.gsDatabase
  68.   Next
  69.   
  70.   Screen.MousePointer = vbNormal
  71.   
  72.   frmOptions.ResetSpecial
  73.   Select Case strReportName
  74.     Case "empprof"
  75.       frmOptions.SetSpecial "Change the 'name' formula to display 'first last' instead of 'last, first'.", "Formula"
  76.     Case "wwsales"
  77.       frmOptions.SetSpecial "Change the graph from pie to bar.", "Graph"
  78.     Case "customer"
  79.       Set m_crwSubReport = m_crwReport.OpenSubreport("orders.rpt")
  80.       Set m_crwDatabase = m_crwSubReport.Database
  81.       For Each m_crwDatabaseTable In m_crwDatabase.Tables
  82.         m_crwDatabaseTable.Location = frmMain.gsDatabase
  83.       Next
  84.       frmOptions.SetSpecial "Change the customer name group sort direction from ascending to descending.", "GroupSortDirection"
  85.     Case "invent"
  86.       frmOptions.SetSpecial "Select only items that need to be ordered.", "RecordSelect"
  87.   End Select
  88.   
  89.   If frmOptions.Display(m_crwReport) = orCancel Then GoTo LaunchReport_Exit
  90.   
  91.   Dim strWindowTitle As String
  92.   If frmOptions.txtWindowTitle.Text = "" Then
  93.     strWindowTitle = m_strFilename
  94.   Else
  95.     strWindowTitle = frmOptions.txtWindowTitle.Text
  96.   End If
  97.   
  98.   Select Case strReportName
  99.     Case "empprof"
  100.       
  101.       If frmOptions.GetSpecial(1) Then
  102.         'Change the 'name' formula to display 'first last' instead of 'last, first'.
  103.         m_crwReport.FormulaFields.Item("name").Text = "{Employee.First Name} + ' ' + {Employee.Last Name}"
  104.       End If
  105.     Case "wwsales"
  106.       If frmOptions.GetSpecial(1) Then
  107.         'get the section with the graph
  108.         Dim crwSection As Section
  109.         Set crwSection = m_crwReport.Sections.Item(3)
  110.         'get the graph on it
  111.         Dim crwGraph As GraphObject
  112.         Set crwGraph = crwSection.ReportObjects.Item(1)
  113.         'change the graph from pie to bar
  114.         crwGraph.DisplayType = crFaked3DSideBySideBarGraph
  115.       End If
  116.     Case "customer"
  117.       If frmOptions.GetSpecial(1) Then
  118.         'get the area with the group on name
  119.         Dim crwArea As Area
  120.         Set crwArea = m_crwReport.Areas.Item(5)
  121.         'get the group area options for it
  122.         Dim crwGrpOpts As GroupAreaOptions
  123.          Set crwGrpOpts = crwArea.GroupOptions
  124.         'change the sort direction
  125.         crwGrpOpts.SortDirection = crDescendingOrder
  126.       End If
  127.     Case "invent"
  128.       If frmOptions.GetSpecial(1) Then
  129.         'add statement to select only items that need to be ordered
  130.         m_crwReport.RecordSelectionFormula = m_crwReport.RecordSelectionFormula & "AND {@status} = 'ORDER'"
  131.       End If
  132.   End Select
  133.   
  134.   If frmOptions.optOutputPreview.Value Then
  135.     'preview the report, get references to the view and window for future use
  136.     Set m_crwView = m_crwReport.Preview(strWindowTitle)
  137.     Set m_crwWindow = m_crwView.Parent
  138.   
  139.   ElseIf frmOptions.optOutputApplication.Value Then
  140.     'preview the report, get references to the view and window for future use
  141.     frmMain.mnuFileClose.Enabled = True
  142.     Set m_crwView = m_crwReport.Preview(strWindowTitle, 0, 0, CInt(frmMain.ScaleWidth / Screen.TwipsPerPixelX), CInt((frmMain.ScaleHeight - frmMain.sbStatusBar.Height) / Screen.TwipsPerPixelY), , frmMain.hwnd)
  143.     Set m_crwWindow = m_crwView.Parent
  144.     
  145.   ElseIf frmOptions.optOutputPrinter.Value Then
  146.     'print the report
  147.     m_crwReport.PrintOut
  148.     
  149.   ElseIf frmOptions.optOutputExportEmailWord.Value Then
  150.     Err.Number = 1
  151.     Err.Source = "XtremeDemo"
  152.     Err.Description = "Sorry, email export not implemented yet.  Please try again later."
  153.     GoTo LaunchReport_Error
  154.     
  155.   ElseIf frmOptions.optOutputExportFileExcel.Value Then
  156.     Err.Number = 1
  157.     Err.Source = "XtremeDemo"
  158.     Err.Description = "Sorry, file export not implemented yet.  Please try again later."
  159.     GoTo LaunchReport_Error
  160.     
  161.   End If
  162.   
  163. LaunchReport_Exit:
  164.   Screen.MousePointer = vbNormal
  165.   Exit Sub
  166.   
  167. LaunchReport_Error:
  168.   m_strFilename = ""
  169.   If Not m_crwReport Is Nothing Then Set m_crwReport = Nothing
  170.   If m_crwApplication Is Nothing Then Err.Description = "Unable to CreateObject(""Crystal.CRPE.Application"")"
  171.   MsgBox Err.Description, vbCritical, Err.Source, Err.HelpFile, Err.HelpContext
  172.   GoTo LaunchReport_Exit
  173. End Sub
  174.  
  175. 'event handler for drill down on detail
  176.  
  177.  
  178. Private Sub m_crwWindow_DrillOnDetail(ByVal FieldValues As Variant, ByVal SelectedFieldIndex As Long, useDefault As Boolean, ByVal ReportName As Variant)
  179.  Dim fldval As CRPEAuto.FieldValue
  180.   Select Case SelectedFieldIndex
  181.   
  182.   Case -1
  183.     ' User clicked on detail, but not on a field
  184.     MsgBox "No field selected", , "Drill Down on Detail Event Captured"
  185.   Case Else
  186.     ' User clicked on detail, and on a valid field
  187.     Set fldval = FieldValues(SelectedFieldIndex)
  188.     MsgBox "Drilled on " & fldval.Name & ", value is: " & fldval.Value, , "Drill Down on Detail Event Captured "
  189.     
  190.   End Select
  191. End Sub
  192.  
  193.