Imports MySql Imports MySql.Data.MySqlClient Imports System.Data.OleDb Imports PropertyGridEx Imports System.IO Public Class Form1 Dim sqlfilename As String Dim reportfilename As String Dim ReportCollection As New Collection Dim ParameterColleation As New Collection Private Sub BeendenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles BeendenToolStripMenuItem.Click Me.Close() End Sub Private Sub DatenAktualisierenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DatenAktualisierenToolStripMenuItem.Click Process.Start(My.Settings.Dataconv) End Sub Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load Me.Treereport.Nodes.Clear() Dim s As String FileOpen(1, My.Settings.ReportList, OpenMode.Input) While Not EOF(1) Input(1, s) ReportCollection.Add(New Report(s)) End While FileClose(1) Dim tnparent As New Syncfusion.Windows.Forms.Tools.TreeNodeAdv tnparent.Text = "Auswertungen" tnparent.Tag = -1 Treereport.Nodes.Add(tnparent) Dim i As Integer For i = 1 To ReportCollection.Count Dim xreport As Report = ReportCollection(i) Dim tn As New Syncfusion.Windows.Forms.Tools.TreeNodeAdv tn.Text = xreport.Reportname tnparent.Nodes.Add(tn) Next Me.Treereport.ExpandAll() 'Fill_Parameter() End Sub Sub Fill_Parameter() FileOpen(1, sqlfilename, OpenMode.Input) Dim s As String ParameterColleation.Clear() Try While Not EOF(1) Input(1, s) Try If Microsoft.VisualBasic.Left(s, 1) = "#" Then ParameterColleation.Add(New Reportparameter(s)) End If Catch ex As Exception End Try End While Catch ex As Exception 'MsgBox(ex.Message) Finally FileClose(1) End Try Properties.ShowCustomProperties = True Properties.Item.Clear() Dim defaultvalue As String If ParameterColleation.Count > 0 Then For i As Integer = 1 To ParameterColleation.Count Dim param As Reportparameter = ParameterColleation(i) If param.Parametertype = "Table" Then Dim splitter() As String splitter = param.ParameterDefault.ToString.Split(";") Properties.Item.Add(param.Parameterbezeichnung, splitter(0), False, "Tabellenauswahl", "Tabellenauswahl", True) Properties.Item(Properties.Item.Count - 1).Datasource = splitter Properties.Item(Properties.Item.Count - 1).IsDropdownResizable = False Dim Languages As String() = New String() {"Ja", "Nein"} 'Properties.Item.Add("Array of strings", Languages(0), False, "Databinding", "This is a UITypeEditor that implement a listbox", True) 'Properties.Item(Properties.Item.Count - 1).Datasource = Languages 'Properties.Item(Properties.Item.Count - 1).IsDropdownResizable = True Else Select Case param.ParameterDefault Case "now" Properties.Item.Add(param.Parameterbezeichnung, New Date(Today.Ticks), False, "Parameter", "Datum", True) Case Else defaultvalue = param.ParameterDefault If IsNumeric(defaultvalue) Then Properties.Item.Add(param.Parameterbezeichnung, defaultvalue, False, "Parameter", "Ganzzahl", True) Else Select Case defaultvalue Case "currentyear" Properties.Item.Add(param.Parameterbezeichnung, Year(Now), False, "Parameter", "Jahreszahl", True) Case "lastyear" Properties.Item.Add(param.Parameterbezeichnung, Year(Now) - 1, False, "Parameter", "Jahreszahl", True) Case "firstofcurrentyear" Dim dt As Date = "01.01." + Year(Now).ToString Properties.Item.Add(param.Parameterbezeichnung, New Date(dt.Ticks), False, "Parameter", "Datum", True) Case "lastofcurrentyear" Dim dt As Date = "31.12." + Year(Now).ToString Properties.Item.Add(param.Parameterbezeichnung, New Date(dt.Ticks), False, "Parameter", "Datum", True) Case Else Properties.Item.Add(param.Parameterbezeichnung, defaultvalue, False, "Parameter", "Text", True) End Select End If End Select End If 'Select Case UCase(param.Parametertype) ' Case "DATETIME" ' Properties.Item.Add(param.Parameterbezeichnung, New Date(Today.Ticks), False, "Parameter", "Datum", True) ' Case "INT" ' Properties.Item.Add(param.Parameterbezeichnung, Year(Now), False, "Parameter", "Ganzzahl", True) ' Case Else ' MsgBox(param.Parametertype) 'End Select Next End If With Properties '.ShowCustomProperties = True '.Item.Clear() '.Item.Add("My Integer", 100, False, "Simple properties", "This is an integer", True) '.Item.Add("My Date", New Date(Today.Ticks), False, "Simple properties", "This is point class", True) .Refresh() End With End Sub Sub get_filenames() For i As Integer = 1 To ReportCollection.Count Dim rc As Report = ReportCollection(i) If rc.Reportname = Me.Treereport.SelectedNode.Text Then sqlfilename = My.Settings.SQLDir If Microsoft.VisualBasic.Right(sqlfilename, 1) <> "\" Then sqlfilename = sqlfilename + "\" sqlfilename = sqlfilename + rc.sqlfile reportfilename = My.Settings.ReportDir If Microsoft.VisualBasic.Right(reportfilename, 1) <> "\" Then reportfilename = reportfilename + "\" reportfilename = reportfilename + rc.reportfile End If Next End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click If check_MySQL() Then Cursor = Cursors.WaitCursor Show_Report() Cursor = Cursors.Default Exit Sub Else MsgBox("MySQL konnte nicht gestartet werden.") Exit Sub End If get_filenames() MsgBox(Properties.Item(1).Value) 'Dim cpd As CustomProperty.CustomPropertyDescriptor = TryCast(e.ChangedItem.PropertyDescriptor, CustomProperty.CustomPropertyDescriptor) End Sub Public Function check_MySQL() As Boolean Dim SQLconnect As New MySqlConnection SQLconnect.ConnectionString = My.Settings.mysqlConnectionstring Try SQLconnect.Open() SQLconnect.Close() Return True Catch Start_MySQL() Try SQLconnect.Open() SQLconnect.Close() Return True Catch ex As Exception Return False End Try End Try End Function Public Function Start_MySQL() Process.Start(My.Settings.StartMySQL) Dim dt As DateTime = Now dt = dt.AddSeconds(My.Settings.StartWaitSeconds) While Now < dt Application.DoEvents() End While End Function Public Function Stop_MySQL() Process.Start(My.Settings.StopMySQL) Dim dt As DateTime = Now dt = dt.AddSeconds(My.Settings.StartWaitSeconds) While Now < dt Application.DoEvents() End While End Function Private Sub Treereport_AfterSelect(sender As Object, e As EventArgs) Handles Treereport.AfterSelect Try get_filenames() Fill_Parameter() Catch End Try End Sub Sub Show_Report() Dim SQL As String = "" Dim export_filename As String Dim report As New FastReport.Report If Not File.Exists(reportfilename) Then Dim tmp As String tmp = reportfilename reportfilename = My.Settings.ReportDir If Microsoft.VisualBasic.Right(reportfilename, 1) <> "\" Then reportfilename = reportfilename + "\empty.frx" FileCopy(reportfilename, tmp) reportfilename = tmp End If export_filename = Path.GetFileName(reportfilename) report.Load(reportfilename) If Not File.Exists(sqlfilename) Then MsgBox(sqlfilename + " fehlt.", vbExclamation) Exit Sub End If Dim fs As FileStream = New FileStream(sqlfilename, FileMode.Open) Dim sr As StreamReader = New StreamReader(fs) Dim s As String = "" Do While sr.Peek() >= 0 s = sr.ReadLine If Microsoft.VisualBasic.Left(s, 1) = "#" Then s = "" SQL = SQL + " " + vbCrLf + s Loop sr.Close() fs.Close() For i = 1 To ParameterColleation.Count Dim r As Reportparameter = ParameterColleation(i) Dim pv As String = Properties.Item(i - 1).Value If r.Parametertype = "datetime" Then Dim dt As Date = pv pv = dt.ToString("yyyy-MM-dd") report.SetParameterValue(r.Parameterbezeichnung, dt.ToString("dd.MM.yyyy")) export_filename = pv + "_" + export_filename Else report.SetParameterValue(r.Parameterbezeichnung, Properties.Item(i - 1).Value.ToString) export_filename = pv + "_" + export_filename End If SQL = SQL.Replace(r.Parametername, pv) Next export_filename = My.Settings.ExportPath + export_filename + ".pdf" 'MsgBox(SQL) Dim splitter() As String splitter = SQL.Split("##SQL##") Dim ds As New DataSet Dim SQLconnect As New MySqlConnection SQLconnect.ConnectionString = My.Settings.mysqlConnectionstring SQLconnect.Open() Dim da As New MySqlDataAdapter("", SQLconnect) Dim sqlcmd As New MySqlCommand sqlcmd.Connection = SQLconnect sqlcmd.CommandType = CommandType.Text Dim tblcounter As Integer = 0 If splitter.Length > 1 Then Dim i As Integer For i = 0 To splitter.Length - 1 If splitter(i).ToString.Length > 10 Then sqlcmd.CommandText = splitter(i) da.SelectCommand = sqlcmd tblcounter = tblcounter + 1 da.Fill(ds, "Daten_" + tblcounter.ToString) End If Next Else sqlcmd.CommandText = SQL da.SelectCommand = sqlcmd da.Fill(ds, "Daten") End If sqlcmd.Dispose() SQLconnect.Close() report.RegisterData(ds) If tblcounter > 0 Then Dim i As Integer For i = 1 To tblcounter report.GetDataSource("Daten_" + i.ToString).Enabled = True Next i Else report.GetDataSource("Daten").Enabled = True End If report.Preview = PreviewControl1 report.Prepare() If CheckBox4.Checked Then Dim export As FastReport.Export.Pdf.PDFExport = New FastReport.Export.Pdf.PDFExport() report.Export(export, export_filename) Exit Sub End If If Me.CheckBox1.Checked = False Then report.ShowPrepared() Else report.Design() End If If CheckBox2.Checked Then Dim f As New frmreport report.Preview = f.PreviewControl1 report.ShowPrepared() f.Show() Me.PreviewControl1.Visible = False Else Me.PreviewControl1.Visible = True End If Me.DataGridView1.DataSource = Nothing Me.DataGridView1.DataSource = ds.Tables(0) If CheckBox3.Checked Then Me.DataGridView1.Visible = True Me.PreviewControl1.Visible = False Else Me.DataGridView1.Visible = False Me.PreviewControl1.Visible = True End If ' Me.PreviewControl1.Report = report ' report.Design() ' f.DesignerControl1.Report = report ' f.MdiParent = Parentform ' f.Show() 'End Sub End Sub Private Sub CheckBox3_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox3.CheckedChanged If CheckBox3.Checked Then Me.DataGridView1.Visible = True Me.PreviewControl1.Visible = False Else Me.DataGridView1.Visible = False Me.PreviewControl1.Visible = True End If End Sub Private Sub Properties_Click(sender As Object, e As EventArgs) Handles Properties.Click End Sub Private Sub Properties_KeyDown(sender As Object, e As KeyEventArgs) Handles Properties.KeyUp If e.KeyCode Then Me.Button1_Click(sender, e) End Sub End Class Public Class Report Dim m_reportname As String Property Reportname As String Get Return m_reportname End Get Set(value As String) m_reportname = value End Set End Property Dim m_sqlfile As String Property sqlfile As String Get Return m_sqlfile End Get Set(value As String) m_sqlfile = value End Set End Property Dim m_reportfile As String Property reportfile As String Get Return m_reportfile End Get Set(value As String) m_reportfile = value End Set End Property Sub New(ByVal inputstring As String) Dim splitter() As String splitter = inputstring.Split(";") Me.Reportname = splitter(0) Me.sqlfile = splitter(1) Me.reportfile = splitter(2) End Sub End Class Public Class Reportparameter Dim m_parametername As String Property Parametername As String Get Return m_parametername End Get Set(value As String) m_parametername = value End Set End Property Dim m_Parameterbezeichnung As String Property Parameterbezeichnung As String Get Return m_Parameterbezeichnung End Get Set(value As String) m_Parameterbezeichnung = value End Set End Property Dim m_Parametertype As String Property Parametertype As String Get Return m_Parametertype End Get Set(value As String) m_Parametertype = value End Set End Property Dim m_Parameterdefault As String Property ParameterDefault As String Get Return m_Parameterdefault End Get Set(value As String) m_Parameterdefault = value End Set End Property Sub New(ByVal Inputstring As String) Dim splitter() As String splitter = Inputstring.Split(":") Me.Parametername = splitter(0) Me.Parameterbezeichnung = splitter(1) Me.Parametertype = splitter(2) Try Me.ParameterDefault = splitter(3) Catch Me.ParameterDefault = "" End Try End Sub End Class ''' ''' A Simple Class to test BrowsableAttribute usage ''' ''' _ Public Class MyOwnClass Private iValue As Integer = 0 Private sText As String Public Sub New() End Sub Public Sub New(ByVal Text As String, ByVal Value As Integer) sText = Text iValue = Value End Sub Public Property Value() As Integer Get Return iValue End Get Set(ByVal value As Integer) iValue = value End Set End Property Public Property Text() As String Get Return sText End Get Set(ByVal value As String) sText = value End Set End Property End Class