You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

315 lines
14 KiB

'Option Strict On
'Option Explicit On
Imports CrystalDecisions.CrystalReports.Engine
Imports CrystalDecisions.Shared
Imports System.Data
Imports System.Data.SqlTypes
Imports System.Data.SqlClient
Imports System.ComponentModel
Imports UtilityLibrary.Win32
Public Class frmReportViewer
Inherits System.Windows.Forms.Form
#Region " Vom Windows Form Designer generierter Code "
Public Sub New()
MyBase.New()
' Dieser Aufruf ist für den Windows Form-Designer erforderlich.
InitializeComponent()
' Initialisierungen nach dem Aufruf InitializeComponent() hinzufügen
End Sub
' Die Form überschreibt den Löschvorgang der Basisklasse, um Komponenten zu bereinigen.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
' Für Windows Form-Designer erforderlich
Private components As System.ComponentModel.IContainer
'HINWEIS: Die folgende Prozedur ist für den Windows Form-Designer erforderlich
'Sie kann mit dem Windows Form-Designer modifiziert werden.
'Verwenden Sie nicht den Code-Editor zur Bearbeitung.
Friend WithEvents ToolBar1 As System.Windows.Forms.ToolBar
Friend WithEvents ImageList1 As System.Windows.Forms.ImageList
Friend WithEvents mnuClose As System.Windows.Forms.ToolBarButton
Friend WithEvents crviewer As CrystalDecisions.Windows.Forms.CrystalReportViewer
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container()
Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(frmReportViewer))
Me.ToolBar1 = New System.Windows.Forms.ToolBar()
Me.mnuClose = New System.Windows.Forms.ToolBarButton()
Me.ImageList1 = New System.Windows.Forms.ImageList(Me.components)
Me.crviewer = New CrystalDecisions.Windows.Forms.CrystalReportViewer()
Me.SuspendLayout()
'
'ToolBar1
'
Me.ToolBar1.Buttons.AddRange(New System.Windows.Forms.ToolBarButton() {Me.mnuClose})
Me.ToolBar1.DropDownArrows = True
Me.ToolBar1.ImageList = Me.ImageList1
Me.ToolBar1.Name = "ToolBar1"
Me.ToolBar1.ShowToolTips = True
Me.ToolBar1.Size = New System.Drawing.Size(816, 25)
Me.ToolBar1.TabIndex = 0
'
'mnuClose
'
Me.mnuClose.ImageIndex = 4
Me.mnuClose.ToolTipText = "Schliessen"
'
'ImageList1
'
Me.ImageList1.ColorDepth = System.Windows.Forms.ColorDepth.Depth8Bit
Me.ImageList1.ImageSize = New System.Drawing.Size(16, 16)
Me.ImageList1.ImageStream = CType(resources.GetObject("ImageList1.ImageStream"), System.Windows.Forms.ImageListStreamer)
Me.ImageList1.TransparentColor = System.Drawing.Color.Transparent
'
'crviewer
'
Me.crviewer.ActiveViewIndex = -1
Me.crviewer.Dock = System.Windows.Forms.DockStyle.Fill
Me.crviewer.Location = New System.Drawing.Point(0, 25)
Me.crviewer.Name = "crviewer"
Me.crviewer.ReportSource = "C:\EDOKA\EDOKA\Report\Reports\MetaDataReport.rpt"
Me.crviewer.ShowCloseButton = False
Me.crviewer.ShowGroupTreeButton = False
Me.crviewer.ShowRefreshButton = False
Me.crviewer.Size = New System.Drawing.Size(816, 500)
Me.crviewer.TabIndex = 1
'
'frmReportViewer
'
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.ClientSize = New System.Drawing.Size(816, 525)
Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.crviewer, Me.ToolBar1})
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.Name = "frmReportViewer"
Me.Text = "Report-Viewer"
Me.WindowState = System.Windows.Forms.FormWindowState.Maximized
Me.ResumeLayout(False)
End Sub
#End Region
#Region " Declaration "
Dim i As Integer
Dim s As String
Dim tbCurrent As CrystalDecisions.CrystalReports.Engine.Table
Dim tliCurrent As CrystalDecisions.Shared.TableLogOnInfo
Dim m_sWindowTitel As String
Dim rpt As New ReportDocument()
Dim crParameterValues As ParameterValues
Dim crParameterDiscreteValue As ParameterDiscreteValue
Dim crParameterFieldDefinitions As ParameterFieldDefinitions
Dim crParameterFieldDefinition As ParameterFieldDefinition
#End Region
#Region " Property "
Property WindowTitel() As String
Get
Return m_sWindowTitel
End Get
Set(ByVal Value As String)
m_sWindowTitel = Value
End Set
End Property
#End Region
Private Sub frmReportViewer_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
#Region " Reporting "
Public Function show_reportWithParameter(ByVal ReportName As String, ByVal param As String) As Boolean
'===============================================================================
'Desc : Anziegen des gewählten report
'Input : Reportname
'Kriterium : Der Report muss im Verzeichenis welches in der Tabelle Applikation
' hinterlegt ist, vorhanden sein
'Erstellt : bud 25.05.2005
'Geaendert :
'===============================================================================
Dim sReportpath As String
If m_sWindowTitel <> "" Then
Me.Text = m_sWindowTitel
End If
Try
sReportpath = CType(Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("pfad_temporaer_dokumente"), String)
If Microsoft.VisualBasic.Right(sReportpath, 1) <> "\" Then
sReportpath = sReportpath & "\"
End If
'=============================================
'Fileprüfung
'=============================================
If FileExist(sReportpath, ReportName) = True Then
rpt.Load(sReportpath & ReportName)
Me.Cursor = System.Windows.Forms.Cursors.WaitCursor
'***************************************************
'***************************************************
Dim intCounter As Integer
intCounter = rpt.DataDefinition.ParameterFields.Count
If intCounter = 1 Then
If InStr(rpt.DataDefinition.ParameterFields(0).ParameterFieldName, ".", CompareMethod.Text) > 0 Then
intCounter = 0
End If
End If
Dim strParValPair() As String
Dim strVal() As String
Dim index As Integer
Dim paraValue As New CrystalDecisions.Shared.ParameterDiscreteValue()
Dim currValue As CrystalDecisions.Shared.ParameterValues
Dim ConInfo As New CrystalDecisions.Shared.TableLogOnInfo()
Dim mySubReportObject As CrystalDecisions.CrystalReports.Engine.SubreportObject
Dim mySubRepDoc As New CrystalDecisions.CrystalReports.Engine.ReportDocument()
Dim intCounter1 As Integer
If intCounter > 0 And Trim(param) <> "" Then
strParValPair = param.Split(CType("&", Char))
'For i = 0 To intCounter - 1
' If rpt.DataDefinition.ParameterFields(i).Name = "@MANr" Then
' strVal = strParValPair(0).Split(CType("=", Char))
' paraValue.Value = strVal(1)
' currValue = rpt.DataDefinition.ParameterFields(strVal(0)).CurrentValues
' currValue.Add(paraValue)
' rpt.DataDefinition.ParameterFields(i).ApplyCurrentValues(currValue)
' End If
' If rpt.DataDefinition.ParameterFields(i).Name = "@MetDataOption" Then
' strVal = strParValPair(1).Split(CType("=", Char))
' paraValue.Value = strVal(1)
' currValue = rpt.DataDefinition.ParameterFields(strVal(0)).CurrentValues
' currValue.Add(paraValue)
' rpt.DataDefinition.ParameterFields(i).ApplyCurrentValues(currValue)
' End If
' If rpt.DataDefinition.ParameterFields(i).Name = "@OfficeDokID" Then
' strVal = strParValPair(2).Split(CType("=", Char))
' paraValue.Value = strVal(1)
' currValue = rpt.DataDefinition.ParameterFields(strVal(0)).CurrentValues
' currValue.Add(paraValue)
' rpt.DataDefinition.ParameterFields(i).ApplyCurrentValues(currValue)
' End If
'Next
For index = 0 To UBound(strParValPair)
If InStr(strParValPair(index), "=") > 0 Then
strVal = strParValPair(index).Split(CType("=", Char))
paraValue.Value = strVal(1)
currValue = rpt.DataDefinition.ParameterFields(strVal(0)).CurrentValues
currValue.Add(paraValue)
rpt.DataDefinition.ParameterFields(strVal(0)).ApplyCurrentValues(currValue)
End If
Next
End If
ConInfo.ConnectionInfo.UserID = CType(Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("user_report"), String)
ConInfo.ConnectionInfo.Password = CType(Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("passwort_report"), String)
ConInfo.ConnectionInfo.ServerName = CType(Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("report_server"), String)
ConInfo.ConnectionInfo.DatabaseName = CType(Globals.Applikationsdaten.Rows(Globals.AppldataRow).Item("report_db"), String)
For intCounter = 0 To rpt.Database.Tables.Count - 1
rpt.Database.Tables(intCounter).ApplyLogOnInfo(ConInfo)
Next
For index = 0 To rpt.ReportDefinition.Sections.Count - 1
For intCounter = 0 To rpt.ReportDefinition.Sections(index).ReportObjects.Count - 1
With rpt.ReportDefinition.Sections(index)
If .ReportObjects(intCounter).Kind = CrystalDecisions.Shared.ReportObjectKind.SubreportObject Then
mySubReportObject = CType(.ReportObjects(intCounter), CrystalDecisions.CrystalReports.Engine.SubreportObject)
mySubRepDoc = mySubReportObject.OpenSubreport(mySubReportObject.SubreportName)
For intCounter1 = 0 To mySubRepDoc.Database.Tables.Count - 1
mySubRepDoc.Database.Tables(intCounter1).ApplyLogOnInfo(ConInfo)
mySubRepDoc.Database.Tables(intCounter1).ApplyLogOnInfo(ConInfo)
Next
End If
End With
Next
Next
Dim crReportDocument As ReportDocument 'Untyped report object
Me.crviewer.ReportSource = rpt
Me.crviewer.Zoom(2)
Me.Cursor = System.Windows.Forms.Cursors.Default
show_reportWithParameter = True
Exit Function
End If
Catch Exp As LoadSaveReportException
show_reportWithParameter = False
Me.Cursor = System.Windows.Forms.Cursors.Default
Catch Exp As Exception
show_reportWithParameter = False
Me.Cursor = System.Windows.Forms.Cursors.Default
End Try
End Function
#End Region
#Region " Extras "
Private Function FileExist(ByVal FilePath As String, ByVal FileName As String) As Boolean
'===============================================================================
'Ermittelt ob eine Datei vorhanden ist.
'Input : Verzeichnis
'Output: True/False
'Erstellt : koe 20.10.2003
'Geaendert :
'===============================================================================
Try
If Microsoft.VisualBasic.Right(FilePath, 1) <> "\" Then
FilePath = FilePath + "\"
End If
If System.IO.Directory.Exists(FilePath) Then
If System.IO.File.Exists(FilePath & FileName) Then
FileExist = True
Else
MyMsg.show_standardmessage_ReplaceText(210, MsgBoxStyle.Exclamation, FilePath & " " & FileName, "") 'Datei #1 nicht gefunden!
FileExist = False
End If
Else
MyMsg.show_standardmessage_ReplaceText(210, MsgBoxStyle.Exclamation, FilePath, "") '"Verzeichnis " & FilePath & " nicht gefunden!
FileExist = False
End If
Catch ex As Exception
MessageBox.Show(ex.Message, "Reportdatei", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
FileExist = False
End Try
End Function
#End Region
#Region " Menue Funktionen "
Private Sub ToolBar1_ButtonClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.ToolBarButtonClickEventArgs) Handles ToolBar1.ButtonClick
Me.Close()
End Sub
#End Region
End Class