Imports System.Windows.Forms Imports FastReport Public Class frmcrreporting Dim ds As DataSet Dim auswertungnr As Integer Dim dms As New Utils.MyDocMgmt Dim auswertung As New TKB.Auswertung.clsAuswertung Dim rptfilename As String Dim printparam As Boolean = True Dim StandardAuswertung As Boolean = True Dim Design As Boolean = False Sub New(ByRef ds As DataSet, ByVal Auswertungnr As Integer, ByRef auswertung As TKB.Auswertung.clsAuswertung, ByVal printparam As Boolean, ByVal Design As Boolean) InitializeComponent() Me.ds = ds Me.auswertungnr = Auswertungnr Me.auswertung = auswertung Me.printparam = printparam Me.StandardAuswertung = True Me.Design = Design End Sub Sub New(ByRef ds As DataSet, ByVal Auswertungnr As Integer) InitializeComponent() Me.ds = ds Me.auswertungnr = Auswertungnr Me.StandardAuswertung = False End Sub Sub New(ByRef ds As DataSet, ByVal Auswertungnr As Integer, ByVal Design As Boolean) InitializeComponent() Me.ds = ds Me.auswertungnr = Auswertungnr Me.auswertung.Get_Auswertung(Auswertungnr) Me.printparam = False Me.StandardAuswertung = True Me.Design = Design End Sub Public Sub DesignReport() Me.Cursor = Cursors.WaitCursor Application.DoEvents() rptfilename = dms.Get_RptDatei(Me.auswertungnr) Dim i As Integer ds.Tables(0).TableName = "Daten" For i = 1 To ds.Tables.Count - 1 ds.Tables(i).TableName = "Daten_" + Trim(Str(i)) Next Dim report As New Report Try If rptfilename <> "" Then report.Load(rptfilename) report.RegisterData(ds) report.GetDataSource("Daten").Enabled = True Try report.SetParameterValue("Titel1", auswertung.TitelZeile1) report.SetParameterValue("Titel2", auswertung.TitelZeile2) Catch End Try Try If Me.printparam Then i = 0 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 report.SetParameterValue("Parameters", s) End If Catch End Try Cursor = Cursors.Default report.Preview = Me.PreviewControl1 report.Design() report.Dispose() Me.Close() Catch ex As Exception MsgBox(ex.Message) End Try End Sub Public Sub DisplayReport() Me.Cursor = Cursors.WaitCursor Application.DoEvents() rptfilename = dms.Get_RptDatei(Me.auswertungnr) Dim i As Integer ds.Tables(0).TableName = "Daten" For i = 1 To ds.Tables.Count - 1 ds.Tables(i).TableName = "Daten_" + Trim(Str(i)) Next Dim report As New Report Try If rptfilename <> "" Then report.Load(rptfilename) report.RegisterData(ds) report.GetDataSource("Daten").Enabled = True Try report.SetParameterValue("Titel1", auswertung.TitelZeile1) report.SetParameterValue("Titel2", auswertung.TitelZeile2) Catch End Try Try If Me.printparam Then i = 0 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 report.SetParameterValue("Parameters", s) End If Catch End Try Cursor = Cursors.Default report.Preview = Me.PreviewControl1 report.Show() Catch ex As Exception MsgBox(ex.Message) End Try End Sub Public Function Export_To_PDF() As String Me.Cursor = Cursors.WaitCursor Application.DoEvents() rptfilename = dms.Get_RptDatei(Me.auswertungnr) Dim i As Integer ds.Tables(0).TableName = "Daten" For i = 1 To ds.Tables.Count - 1 ds.Tables(i).TableName = "Daten_" + Trim(Str(i)) Next Dim report As New Report Try If rptfilename <> "" Then report.Load(rptfilename) report.RegisterData(ds) report.GetDataSource("Daten").Enabled = True Try report.SetParameterValue("Titel1", auswertung.TitelZeile1) report.SetParameterValue("Titel2", auswertung.TitelZeile2) Catch End Try Try If Me.printparam Then i = 0 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 report.SetParameterValue("Parameters", s) End If Catch End Try Cursor = Cursors.Default report.Prepare(True) Dim e As New FastReport.Export.Pdf.PDFExport e.EmbeddingFonts = False Dim fn As String = Globals.TmpFilepath + "\" + Guid.NewGuid.ToString + ".pdf" report.Export(e, fn) Return fn Catch ex As Exception MsgBox(ex.Message) End Try 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 Private Sub frmcrreporting_Load(sender As Object, e As EventArgs) Handles MyBase.Load End Sub End Class