Imports System.IO Imports System.Drawing.Imaging Imports DevExpress.XtraCharts Imports DevExpress.XtraPrinting Imports DevExpress.XtraPrintingLinks Public Class frmDiagrams Private toolbars As List(Of ToolStrip) Private charts As List(Of ChartControl) Private groupCount As Integer Private CHART_TITLE_STRING As String Private Sub frmDiagrams_Load(sender As Object, e As EventArgs) Handles MyBase.Load Dim CHART_ENTITY_SQL, CHART_GROUPS_SQL, CHART_TITLE_SQL As String Dim CHART_ENTITY_DT, CHART_GROUPS_DT As DataTable CHART_TITLE_SQL = String.Format("SELECT NAME FROM TBPMO_FORM WHERE GUID = {0}", CURRENT_ENTITY_ID) CHART_ENTITY_SQL = String.Format("SELECT * FROM TBPMO_CHART_ENTITY WHERE ENTITY_ID = {0}", CURRENT_ENTITY_ID) CHART_GROUPS_SQL = String.Format("SELECT DISTINCT GROUP_ID FROM TBPMO_CHART_ENTITY WHERE ENTITY_ID = {0} ORDER BY GROUP_ID", CURRENT_ENTITY_ID) CHART_TITLE_STRING = MYDB_ECM.GetScalarValue(CHART_TITLE_SQL) CHART_ENTITY_DT = MYDB_ECM.GetDatatable(CHART_ENTITY_SQL) CHART_GROUPS_DT = MYDB_ECM.GetDatatable(CHART_GROUPS_SQL) Dim Groups As DataRowCollection = CHART_GROUPS_DT.Rows groupCount = Groups.Count toolbars = New List(Of ToolStrip) From {ToolStripTopLeft, ToolStripTopRight, ToolStripBottomLeft, ToolStripBottomRight} charts = New List(Of ChartControl) From {ChartTopLeft, ChartTopRight, ChartBottomLeft, ChartBottomRight} If groupCount = 0 Then MsgBox("No Diagrams found") Me.Close() End If Load_Settings() Configure_Chart_Tool_Bars() Configure_Split_Containers(groupCount) If groupCount > 1 Then For Each gRow As DataRow In Groups Dim groupIndex As Integer = Groups.IndexOf(gRow) Dim groupName As String = gRow.Item("GROUP_ID") Dim groupCharts = CHART_ENTITY_DT.Select(String.Format("GROUP_ID = '{0}'", groupName)) Dim chart As ChartControl For Each cRow As DataRow In groupCharts Dim type = cRow.Item("TYPE_CHART") Dim title = cRow.Item("TITLE") Dim guid = cRow.Item("GUID") Dim value = cRow.Item("VALUE") Dim argument = cRow.Item("ARGUMENT") Dim sql = cRow.Item("SQL_COMMAND") Dim DATA_DT As DataTable = MYDB_ECM.GetDatatable(sql) Dim series As Series = Create_Series(title, type) ' Select Current Chart chart = Select_Chart(groupIndex) chart = charts.Item(groupIndex) ' Set DataSource chart.DataSource = DATA_DT ' Set shown Columns for Chart series.ArgumentDataMember = argument series.ValueDataMembers.AddRange(New String() {value}) 'set some options chart.Legend.Visibility = DevExpress.Utils.DefaultBoolean.True ' Show Data chart.Series.Add(series) Next ' End Charts Next 'End Groups Else ' Create Charts For Each row As DataRow In CHART_ENTITY_DT.Rows Dim chart As ChartControl Dim chartIndex As Integer = CHART_ENTITY_DT.Rows.IndexOf(row) Dim type = row.Item("TYPE_CHART") Dim title = row.Item("TITLE") Dim guid = row.Item("GUID") Dim value = row.Item("VALUE") Dim argument = row.Item("ARGUMENT") Dim sql = row.Item("SQL_COMMAND") Dim DATA_DT As DataTable = MYDB_ECM.GetDatatable(sql) ' Create Series based on type Dim series As Series = Create_Series(title, type) ' Select Current Chart chart = Select_Chart(chartIndex) ' Set DataSource chart.DataSource = DATA_DT ' Set shown Columns for Chart series.ArgumentDataMember = argument series.ValueDataMembers.AddRange(New String() {value}) 'set some options chart.Legend.Visibility = DevExpress.Utils.DefaultBoolean.True chart.OptionsPrint.SizeMode = Printing.PrintSizeMode.Stretch ' Show Data chart.Series.Add(series) Next End If End Sub Private Sub frmDiagrams_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing Dim XMLPath As String = Get_Splitter_Layout_Filename() Dim layout As New ClassLayout(XMLPath) Dim settings As New List(Of ClassSetting) settings = Get_Settings(settings) layout.Save(settings) End Sub Private Function Get_Splitter_Layout_Filename() As String Dim Filename As String = String.Format("{0}-Diagram-SplitterLayout.xml", CURRENT_ENTITY_ID) Return System.IO.Path.Combine(Application.UserAppDataPath(), Filename) End Function Private Function Get_Settings(settings As List(Of ClassSetting)) As List(Of ClassSetting) settings.Add(New ClassSetting("SplitterMainDistance", SplitContainerMain.SplitterDistance)) settings.Add(New ClassSetting("SplitterTopDistance", SplitContainerTop.SplitterDistance)) settings.Add(New ClassSetting("SplitterBottomDistance", SplitContainerBottom.SplitterDistance)) Return settings End Function Private Sub Load_Settings() Try ' Load Splitter Settings Dim XMLPath As String = Get_Splitter_Layout_Filename() Dim layout As New ClassLayout(XMLPath) Dim settings As List(Of ClassSetting) settings = layout.Load() ' No Settings found, save current values If settings.Count = 0 Then 'Adjust Width and Height of containers Dim containerW = Me.Width / 2 Dim containerH = Me.Height / 2 SplitContainerTop.SplitterDistance = containerW SplitContainerBottom.SplitterDistance = containerW SplitContainerMain.SplitterDistance = containerH settings = Get_Settings(settings) layout.Save(settings) End If 'Apply Settings For Each setting As ClassSetting In settings If setting._name = "SplitterMainDistance" Then SplitContainerMain.SplitterDistance = setting._value End If If setting._name = "SplitterTopDistance" Then SplitContainerTop.SplitterDistance = setting._value End If If setting._name = "SplitterBottomDistance" Then SplitContainerBottom.SplitterDistance = setting._value End If Next Catch ex As Exception MsgBox("Error while loading Settings for frmDiagrams: " & vbNewLine & ex.Message) End Try End Sub Private Sub Configure_Split_Containers(VisibleContainers As Integer) Select Case VisibleContainers Case 1 ' Show only ChartTopLeft SplitContainerTop.Panel2Collapsed = True ' Collapse SplitContainerBottom SplitContainerMain.Panel2Collapsed = True Case 2 ' Collapse SplitContainerBottom SplitContainerMain.Panel2Collapsed = True Case 3 ' Collapse ChartBottomRight SplitContainerBottom.Panel2Collapsed = True ' Show SplitContainerBottom SplitContainerMain.Panel2Collapsed = False Case 4 ' Show SplitContainerBottom SplitContainerMain.Panel2Collapsed = False End Select End Sub Private Function Create_Series(title As String, type As String) As Series Dim series As Series Select Case type Case "BAR" series = New Series(title, ViewType.Bar) Case "LINE" series = New Series(title, ViewType.Line) Case "AREA" series = New Series(title, ViewType.Area) Case "PIE" series = New Series(title, ViewType.Pie) series.Label.TextPattern = "{A}: {VP:p0}" Dim view As PieSeriesView = DirectCast(series.View, PieSeriesView) view.Titles.Add(New SeriesTitle()) view.Titles(0).Text = title Case Else series = New Series(title, ViewType.Bar) End Select Return series End Function Private Function Select_Chart(index As Integer) Select Case index Case 0 Return ChartTopLeft Case 1 Return ChartTopRight Case 2 Return ChartBottomLeft Case Else Return ChartBottomRight End Select End Function Private Sub Configure_Chart_Tool_Bars() ToolStripTopLeft.Tag = ChartTopLeft ToolStripTopRight.Tag = ChartTopRight ToolStripBottomLeft.Tag = ChartBottomLeft ToolStripBottomRight.Tag = ChartBottomRight For Each toolbar As ToolStrip In toolbars toolbar.Items.Add("Export to Excel", My.Resources.xls, AddressOf ExportToExcel_Click) toolbar.Items.Add("Export to PDF", My.Resources.pdf, AddressOf ExportToPdf_Click) toolbar.Items.Add("Export to Image", My.Resources.bmp, AddressOf ExportToImage_Click) Next End Sub Private Sub Confirm_Open_File(filepath As String) Dim filename As String = New FileInfo(filepath).Name Dim message As String If USER_LANGUAGE = "de_DE" Then message = String.Format("Datei {0} erstellt. Jetzt öffnen?", filename) Else message = String.Format("File {0} created. Open now?", filename) End If Dim successResult As DialogResult = MessageBox.Show(message, "Success", MessageBoxButtons.YesNo) If successResult = System.Windows.Forms.DialogResult.Yes Then Process.Start(filepath) End If End Sub Private Sub ExportToPdf_Click(sender As ToolStripItem, e As EventArgs) Dim item As ToolStripItem = sender Dim toolbar As ToolStrip = item.GetCurrentParent() Dim chart As ChartControl = toolbar.Tag ExportCharts(New List(Of ChartControl) From {chart}, "pdf") End Sub Private Sub ExportToExcel_Click(sender As ToolStripItem, e As EventArgs) Dim item As ToolStripItem = sender Dim toolbar As ToolStrip = item.GetCurrentParent() Dim chart As ChartControl = toolbar.Tag ExportCharts(New List(Of ChartControl) From {chart}, "xls") End Sub Private Sub ExportToImage_Click(sender As ToolStripItem, e As EventArgs) Dim item As ToolStripItem = sender Dim toolbar As ToolStrip = item.GetCurrentParent() Dim chart As ChartControl = toolbar.Tag ExportCharts(New List(Of ChartControl) From {chart}, "img") End Sub Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs) Handles ToolStripButton1.Click ExportCharts(charts, "pdf") End Sub Private Sub ExportCharts(_charts As List(Of ChartControl), Optional ext As String = "pdf") Try ' Setup the 'page' Dim printingSystem As New PrintingSystem Dim compositeLink As New CompositeLink(printingSystem) Dim count = 1 ' chart counter compositeLink.Landscape = True ' set to landscape AddHandler compositeLink.CreateMarginalHeaderArea, AddressOf compositeLink_CreateMarginalHeaderArea ' Create Title Dim titleLink As New Link() AddHandler titleLink.CreateDetailHeaderArea, AddressOf titleLink_CreateDetailHeaderArea compositeLink.Links.Add(titleLink) ' Loop through charts For Each chart As ChartControl In _charts chart.OptionsPrint.SizeMode = Printing.PrintSizeMode.Zoom Dim link As New PrintableComponentLink() link.Component = chart compositeLink.Links.Add(link) If groupCount <= count Then Exit For Else count = count + 1 End If Next Select Case ext Case "img" saveDialog.Filter = "PNG Images|*.png" Case "xls" saveDialog.Filter = "Excel Files|*.xlsx" Case Else saveDialog.Filter = "PDF Files|*.pdf" End Select saveDialog.FileName = String.Format("ADDI_Report_Export_{0}", Date.Now().ToString("dd-MM-yyyy")) Dim result As DialogResult = saveDialog.ShowDialog() If result = System.Windows.Forms.DialogResult.OK Then Dim filename As String = saveDialog.FileName Select Case ext Case "img" compositeLink.ExportToImage(filename) Case "xls" compositeLink.ExportToXlsx(filename) Case Else compositeLink.ExportToPdf(filename) End Select Application.DoEvents() Confirm_Open_File(filename) End If Catch ex As Exception MsgBox("Error while exporting Charts: " & vbNewLine & ex.Message, MsgBoxStyle.Critical) End Try End Sub Private Sub compositeLink_CreateMarginalHeaderArea(sender As Object, e As CreateAreaEventArgs) e.Graph.Font = New Font("Segoe UI", 10) e.Graph.DrawPageInfo(PageInfo.DateTime, "{0:dd.MM.yyyy hhhh:mmmm}", Color.Black, New RectangleF(0, 0, 200, 50), BorderSide.None) End Sub Private Sub titleLink_CreateDetailHeaderArea(sender As Object, e As CreateAreaEventArgs) Dim tbTitle As New TextBrick Dim title As String If txtExportTitle.Text.Trim <> String.Empty Then title = txtExportTitle.Text Else title = CHART_TITLE_STRING End If tbTitle.Text = title tbTitle.Font = New Font("Segoe UI", 18) tbTitle.Rect = New RectangleF(0, 0, 300, 40) tbTitle.BorderWidth = 0 tbTitle.BackColor = Color.Transparent tbTitle.HorzAlignment = DevExpress.Utils.HorzAlignment.Near e.Graph.DrawBrick(tbTitle) End Sub End Class