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.
244 lines
9.8 KiB
244 lines
9.8 KiB
Imports CrystalDecisions.CrystalReports.Engine
|
|
Imports CrystalDecisions.Shared
|
|
Imports CrystalDecisions.Windows.Forms
|
|
Imports CrystalDecisions.ReportSource
|
|
Imports System.Windows.Forms
|
|
|
|
Public Class frmcrreporting
|
|
|
|
Dim ds As DataTable
|
|
Dim auswertungnr As Integer
|
|
Dim dms As New TKB.VV.Utils.MyDocMgmt
|
|
Dim auswertung As New TKB.Auswertung.clsAuswertung
|
|
Dim rptfilename As String
|
|
Dim printparam As Boolean = True
|
|
Dim StandardAuswertung As Boolean = True
|
|
Dim CurrentUser As String = ""
|
|
|
|
Sub New(ByRef ds As DataTable, ByVal Auswertungnr As Integer, ByRef auswertung As TKB.Auswertung.clsAuswertung, ByVal printparam As Boolean, Optional currentuser As String = "")
|
|
InitializeComponent()
|
|
Me.ds = ds
|
|
Me.auswertungnr = Auswertungnr
|
|
Me.auswertung = auswertung
|
|
Me.printparam = printparam
|
|
Me.StandardAuswertung = True
|
|
Me.CurrentUser = currentuser
|
|
End Sub
|
|
Sub New(ByRef ds As DataTable, ByVal Auswertungnr As Integer)
|
|
InitializeComponent()
|
|
Me.ds = ds
|
|
Me.auswertungnr = Auswertungnr
|
|
Me.StandardAuswertung = False
|
|
End Sub
|
|
Private Sub frmcrreporting_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
|
|
Me.Cursor = Cursors.WaitCursor
|
|
Application.DoEvents()
|
|
rptfilename = dms.Get_RptDatei(Me.auswertungnr)
|
|
|
|
Dim cr As New ReportDocument
|
|
cr.Load(rptfilename)
|
|
If Me.StandardAuswertung = True Then
|
|
|
|
Try
|
|
Dim crformulas As CrystalDecisions.CrystalReports.Engine.FormulaFieldDefinitions
|
|
crformulas = cr.DataDefinition.FormulaFields
|
|
If Me.printparam Then
|
|
|
|
Dim i As Integer
|
|
Dim s As String = ""
|
|
|
|
For i = 1 To Me.auswertung.ParamCollection.Count
|
|
If s <> "" Then s = s + "|"
|
|
s = s + Me.auswertung.ParamCollection.Item(i).ToString
|
|
Next
|
|
If Me.CurrentUser <> "" Then
|
|
s = s + "|Benutzer-ID = " + Me.CurrentUser.ToString
|
|
End If
|
|
Try
|
|
crformulas.Item("Param1").Text = "'" & s & "'"
|
|
Catch ex As Exception
|
|
|
|
End Try
|
|
End If
|
|
Try
|
|
crformulas.Item("Titel1").Text = "'" & Me.auswertung.TitelZeile1 & "'"
|
|
Catch ex As Exception
|
|
End Try
|
|
Try
|
|
|
|
crformulas.Item("Titel2").Text = "'" & Me.auswertung.TitelZeile2 & "'"
|
|
Catch ex As Exception
|
|
End Try
|
|
Catch
|
|
End Try
|
|
|
|
'Dim myTextObjectOnReport As CrystalDecisions.CrystalReports.Engine.TextObject
|
|
'Try
|
|
' myTextObjectOnReport = CType(cr.ReportDefinition.ReportObjects.Item("txtheader11"), CrystalDecisions.CrystalReports.Engine.TextObject)
|
|
' myTextObjectOnReport.Text = Me.auswertung.TitelZeile1
|
|
'Catch
|
|
'End Try
|
|
'Try
|
|
' myTextObjectOnReport = CType(cr.ReportDefinition.ReportObjects.Item("txtheader12"), CrystalDecisions.CrystalReports.Engine.TextObject)
|
|
' myTextObjectOnReport.Text = Me.auswertung.TitelZeile2
|
|
'Catch
|
|
'End Try
|
|
'Try
|
|
' myTextObjectOnReport = CType(cr.ReportDefinition.ReportObjects.Item("txtheader21"), CrystalDecisions.CrystalReports.Engine.TextObject)
|
|
' myTextObjectOnReport.Text = Me.auswertung.TitelZeile1
|
|
'Catch
|
|
'End Try
|
|
'End Try
|
|
|
|
' Try
|
|
' myTextObjectOnReport = CType(cr.ReportDefinition.ReportObjects.Item("txtheader22"), CrystalDecisions.CrystalReports.Engine.TextObject)
|
|
' myTextObjectOnReport.Text = Me.auswertung.TitelZeile2
|
|
' Catch
|
|
' End Try
|
|
' If Me.printparam Then
|
|
' Dim i As Integer
|
|
' For i = 1 To Me.auswertung.ParamCollection.Count
|
|
|
|
' Try
|
|
' myTextObjectOnReport = CType(cr.ReportDefinition.ReportObjects.Item("param1" & Trim(Str(i))), CrystalDecisions.CrystalReports.Engine.TextObject)
|
|
' myTextObjectOnReport.Text = Me.auswertung.ParamCollection.Item(i).ToString
|
|
' Catch
|
|
' End Try
|
|
' Try
|
|
' myTextObjectOnReport = CType(cr.ReportDefinition.ReportObjects.Item("param2" & Trim(Str(i))), CrystalDecisions.CrystalReports.Engine.TextObject)
|
|
' myTextObjectOnReport.Text = Me.auswertung.ParamCollection.Item(i).ToString
|
|
' Catch
|
|
' End Try
|
|
' Next
|
|
' Try
|
|
' Dim crformulas As CrystalDecisions.CrystalReports.Engine.FormulaFieldDefinitions
|
|
|
|
' 'myTextObjectOnReport = CType(cr.ReportDefinition.ReportObjects.Item("fullparam1"), CrystalDecisions.CrystalReports.Engine.TextObject)
|
|
' 'myTextObjectOnReport.Text = Me.auswertung.FullParam
|
|
' Catch ex As Exception
|
|
' End Try
|
|
' Try
|
|
' myTextObjectOnReport = CType(cr.ReportDefinition.ReportObjects.Item("fullparam2"), CrystalDecisions.CrystalReports.Engine.TextObject)
|
|
' myTextObjectOnReport.Text = Me.auswertung.FullParam
|
|
' Catch ex As Exception
|
|
' End Try
|
|
' End If
|
|
'Catch ex As Exception
|
|
'End Try
|
|
cr.SetDataSource(ds)
|
|
'20091005 - SubReport-Connection
|
|
DBConnection_SubReports(cr)
|
|
|
|
Dim paramfield As ParameterField
|
|
Dim newValue As New CrystalDecisions.Shared.ParameterDiscreteValue()
|
|
|
|
For Each paramfield In cr.ParameterFields
|
|
Try
|
|
If paramfield.Name.Substring(0, 1) = "@" Then
|
|
paramfield.CurrentValues.Clear()
|
|
newValue.Value = ""
|
|
paramfield.CurrentValues.Add(newValue)
|
|
End If
|
|
Catch
|
|
End Try
|
|
Next
|
|
|
|
CrystalReportViewer1.ShowRefreshButton = False
|
|
CrystalReportViewer1.ShowCloseButton = False
|
|
CrystalReportViewer1.ShowGroupTreeButton = False
|
|
|
|
CrystalReportViewer1.ReportSource = cr
|
|
|
|
Me.Cursor = Cursors.Default
|
|
Application.DoEvents()
|
|
Else
|
|
cr.SetDataSource(ds)
|
|
'20091005 - SubReport-Connection
|
|
DBConnection_SubReports(cr)
|
|
CrystalReportViewer1.ShowRefreshButton = False
|
|
CrystalReportViewer1.ShowCloseButton = False
|
|
CrystalReportViewer1.ShowGroupTreeButton = False
|
|
CrystalReportViewer1.ReportSource = cr
|
|
Me.Cursor = Cursors.Default
|
|
Application.DoEvents()
|
|
End If
|
|
|
|
End Sub
|
|
|
|
Private Sub DBConnection_SubReports(ByRef cr As ReportDocument)
|
|
If cr.Subreports.Count < 1 Then Exit Sub
|
|
|
|
Dim filename As String = Application.StartupPath + "\" + Me.auswertung.Auswertung.sConnectionstring_Subreport.Value
|
|
Dim ofile As System.IO.File
|
|
Dim oread As System.IO.StreamReader
|
|
Dim CoInfo As SqlClient.SqlConnection
|
|
|
|
|
|
oread = ofile.OpenText(filename)
|
|
sConnectionString = oread.ReadLine
|
|
sConnectionString = Crypto.DecryptText(sConnectionString, "HutterundMueller")
|
|
sConnectionString = Microsoft.VisualBasic.Left(sConnectionString, Len(sConnectionString) - 1)
|
|
|
|
Dim split() As String = sConnectionString.Split(";")
|
|
|
|
Dim servername As String = split(0)
|
|
Dim dbname As String = split(1)
|
|
Dim userid As String = split(5)
|
|
Dim password As String = split(6)
|
|
split = servername.Split("=")
|
|
servername = split(1)
|
|
split = dbname.Split("=")
|
|
dbname = split(1)
|
|
split = userid.Split("=")
|
|
userid = split(1)
|
|
split = password.Split("=")
|
|
password = split(1)
|
|
|
|
Dim Lo As New TableLogOnInfos()
|
|
For Each subreport As ReportDocument In cr.Subreports
|
|
Dim subreportdoc As ReportDocument = subreport
|
|
Dim logonInfo As New TableLogOnInfo()
|
|
For Each d As CrystalDecisions.CrystalReports.Engine.Table In subreportdoc.Database.Tables
|
|
logonInfo = d.LogOnInfo
|
|
logonInfo.ConnectionInfo.ServerName = servername
|
|
logonInfo.ConnectionInfo.DatabaseName = dbname
|
|
logonInfo.ConnectionInfo.UserID = userid
|
|
logonInfo.ConnectionInfo.Password = password
|
|
d.ApplyLogOnInfo(logonInfo)
|
|
Next
|
|
Next
|
|
|
|
End Sub
|
|
|
|
Private Function TranslateStringToCRFormula(ByVal VBString As String) As String
|
|
|
|
Dim Returnstring As String = "'"
|
|
|
|
'Split the string at every LF
|
|
For Each SubString As String In VBString.Split(Chr(10))
|
|
|
|
SubString = SubString.Replace("'", "' & Chr(39) & '")
|
|
|
|
'Trim all the CR / LF characters
|
|
SubString = SubString.Trim(vbCrLf.ToCharArray)
|
|
|
|
'Form your string to the compatible CR Formula format. Chr(10) &nd Chr(13) should be inserted as a string, not as values!!
|
|
Returnstring = Returnstring & "' & Chr(10) & Chr(13) & '" & SubString
|
|
|
|
Next
|
|
|
|
Returnstring = Returnstring & "'"
|
|
|
|
Return Returnstring
|
|
|
|
End Function
|
|
|
|
|
|
Private Sub BeendenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BeendenToolStripMenuItem.Click
|
|
Me.Close()
|
|
End Sub
|
|
|
|
Private Sub TSBtnQuit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TSBtnQuit.Click
|
|
Me.Close()
|
|
End Sub
|
|
End Class |