jj 19.10 improve diagrams, add export options
This commit is contained in:
@@ -1,6 +1,131 @@
|
||||
Imports DevExpress.XtraCharts
|
||||
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_FORM_ID)
|
||||
CHART_ENTITY_SQL = String.Format("SELECT * FROM TBPMO_CHART_ENTITY WHERE ENTITY_ID = {0}", CURRENT_FORM_ID)
|
||||
CHART_GROUPS_SQL = String.Format("SELECT DISTINCT GROUP_ID FROM TBPMO_CHART_ENTITY WHERE ENTITY_ID = {0} ORDER BY GROUP_ID", CURRENT_FORM_ID)
|
||||
CHART_TITLE_STRING = ClassDatabase.Execute_Scalar(CHART_TITLE_SQL)
|
||||
CHART_ENTITY_DT = ClassDatabase.Return_Datatable(CHART_ENTITY_SQL)
|
||||
CHART_GROUPS_DT = ClassDatabase.Return_Datatable(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 = ClassDatabase.Return_Datatable(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 = ClassDatabase.Return_Datatable(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_FORM_ID)
|
||||
@@ -57,8 +182,6 @@ Public Class frmDiagrams
|
||||
|
||||
Private Sub Configure_Split_Containers(VisibleContainers As Integer)
|
||||
Select Case VisibleContainers
|
||||
Case 0
|
||||
MsgBox("No Diagrams found")
|
||||
Case 1
|
||||
' Show only ChartTopLeft
|
||||
SplitContainerTop.Panel2Collapsed = True
|
||||
@@ -78,15 +201,6 @@ Public Class frmDiagrams
|
||||
End Select
|
||||
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 Create_Series(title As String, type As String) As Series
|
||||
Dim series As Series
|
||||
|
||||
@@ -123,97 +237,144 @@ Public Class frmDiagrams
|
||||
End Select
|
||||
End Function
|
||||
|
||||
Private Sub frmDiagrams_Load(sender As Object, e As EventArgs) Handles MyBase.Load
|
||||
Dim CHART_ENTITY_SQL, CHART_GROUPS_SQL As String
|
||||
Dim CHART_ENTITY_DT, CHART_GROUPS_DT As DataTable
|
||||
Private Sub Configure_Chart_Tool_Bars()
|
||||
ToolStripTopLeft.Tag = ChartTopLeft
|
||||
ToolStripTopRight.Tag = ChartTopRight
|
||||
ToolStripBottomLeft.Tag = ChartBottomLeft
|
||||
ToolStripBottomRight.Tag = ChartBottomRight
|
||||
|
||||
CHART_ENTITY_SQL = String.Format("SELECT * FROM TBPMO_CHART_ENTITY WHERE ENTITY_ID = {0}", CURRENT_FORM_ID)
|
||||
CHART_GROUPS_SQL = String.Format("SELECT DISTINCT GROUP_ID FROM TBPMO_CHART_ENTITY WHERE ENTITY_ID = {0} ORDER BY GROUP_ID", CURRENT_FORM_ID)
|
||||
CHART_ENTITY_DT = ClassDatabase.Return_Datatable(CHART_ENTITY_SQL)
|
||||
CHART_GROUPS_DT = ClassDatabase.Return_Datatable(CHART_GROUPS_SQL)
|
||||
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
|
||||
|
||||
Dim Groups As DataRowCollection = CHART_GROUPS_DT.Rows
|
||||
Dim GroupCount As Integer = Groups.Count
|
||||
Private Sub Confirm_Open_File(filepath As String)
|
||||
Dim filename As String = New FileInfo(filepath).Name
|
||||
Dim message As String
|
||||
|
||||
Load_Settings()
|
||||
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 = ClassDatabase.Return_Datatable(sql)
|
||||
|
||||
Dim series As Series = Create_Series(title, type)
|
||||
|
||||
' Select Current Chart
|
||||
chart = Select_Chart(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
|
||||
If USER_LANGUAGE = "de_DE" Then
|
||||
message = String.Format("Datei {0} erstellt. Jetzt öffnen?", filename)
|
||||
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 = ClassDatabase.Return_Datatable(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
|
||||
|
||||
' Show Data
|
||||
chart.Series.Add(series)
|
||||
Next
|
||||
message = String.Format("File {0} created. Open now?", filename)
|
||||
End If
|
||||
|
||||
|
||||
Dim successResult As DialogResult = MessageBox.Show(message, "Success", MessageBoxButtons.YesNo)
|
||||
If successResult = 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 = 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
|
||||
Reference in New Issue
Block a user