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.
1057 lines
41 KiB
1057 lines
41 KiB
Imports PropertyGridEx
|
|
Imports System.IO
|
|
Imports System.Data.SqlClient
|
|
Imports System.Text.RegularExpressions
|
|
|
|
Public Class frmAuswertung
|
|
Dim sqlfilename As String
|
|
Dim reportfilename As String
|
|
Dim intdb As New clsDB
|
|
Dim ReportCollection As New Collection
|
|
Dim ParameterColleation As New Collection
|
|
|
|
Dim NodesThatMatch As New List(Of TreeNode)
|
|
|
|
Dim usedb As Boolean = UCase(intdb.Get_Option(60010)) = "TRUE"
|
|
|
|
Public Function Findnode(keyvalue As String) As Boolean
|
|
Try
|
|
Dim tn As TreeNode = SearchTheTreeView(Me.TreeReporting, keyvalue)
|
|
TreeReporting.SelectedNode = tn
|
|
Return True
|
|
Catch
|
|
End Try
|
|
End Function
|
|
|
|
Public Function Set_Propertiesvalue(propertynr As Integer, iValue As String)
|
|
Properties.Item(propertynr).Value = iValue
|
|
End Function
|
|
Private Function SearchTheTreeView(ByVal TV As TreeView, ByVal Tag As String) As TreeNode
|
|
' Empty previous
|
|
NodesThatMatch.Clear()
|
|
' Keep calling RecursiveSearch
|
|
For Each TN As TreeNode In TV.Nodes
|
|
If TN.Tag = Tag Then
|
|
NodesThatMatch.Add(TN)
|
|
End If
|
|
|
|
RecursiveSearch(TN, Tag)
|
|
Next
|
|
If NodesThatMatch.Count > 0 Then
|
|
Return NodesThatMatch(0)
|
|
Else
|
|
Return Nothing
|
|
End If
|
|
|
|
End Function
|
|
|
|
Private Sub RecursiveSearch(ByVal treeNode As TreeNode, ByVal tag As String)
|
|
|
|
' Keep calling the test recursively.
|
|
For Each TN As TreeNode In treeNode.Nodes
|
|
If TN.Tag = tag Then
|
|
NodesThatMatch.Add(TN)
|
|
End If
|
|
|
|
RecursiveSearch(TN, tag)
|
|
Next
|
|
End Sub
|
|
Private Sub SchliessenToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles SchliessenToolStripMenuItem.Click
|
|
Me.Close()
|
|
End Sub
|
|
|
|
Private Sub tsbtnquit_Click(sender As Object, e As EventArgs) Handles tsbtnquit.Click
|
|
Me.Close()
|
|
End Sub
|
|
|
|
Private Sub frmAuswertung_Load(sender As Object, e As EventArgs) Handles MyBase.Load
|
|
Get_Reports()
|
|
Globals.sec.Set_Form_Security(Me)
|
|
End Sub
|
|
|
|
|
|
|
|
#Region "DB"
|
|
|
|
|
|
Sub Get_Reports_from_db()
|
|
Dim db As New clsDB
|
|
db.Get_Tabledata("Reporting", "", "Select * from reporting where aktiv=1 and funktionsstufe >=" + Globals.Funktionsstufe.ToString + " order by parent, sort")
|
|
Load_Treeview(db.dsDaten, Me.TreeReporting)
|
|
End Sub
|
|
|
|
Private Sub Load_Treeview(ByVal oSourceData As DataSet, ByRef tree As TreeView)
|
|
|
|
If Not (oSourceData Is Nothing) Then
|
|
Dim oView As DataView = oSourceData.Tables(0).DefaultView
|
|
Dim oTable As DataTable = oView.Table
|
|
Dim oDS As DataSet = New DataSet()
|
|
oDS.Tables.Add(oTable.Copy())
|
|
|
|
If oDS.Relations.Contains("SelfRefenceRelation") = False Then
|
|
oDS.Relations.Add("SelfRefenceRelation",
|
|
oDS.Tables(0).Columns("nrreport"),
|
|
oDS.Tables(0).Columns("Parent"))
|
|
End If
|
|
oTable.Dispose()
|
|
oTable = Nothing
|
|
LoadTreeView(oDS, tree)
|
|
oDS.Dispose()
|
|
oDS = Nothing
|
|
End If
|
|
|
|
End Sub
|
|
|
|
''' <summary>
|
|
''' Tree aufbauen
|
|
''' </summary>
|
|
''' <param name="oDS"></param>
|
|
''' <param name="oTreeview"></param>
|
|
''' <remarks></remarks>
|
|
Private Sub LoadTreeView(ByVal oDS As DataSet, ByRef oTreeview As TreeView)
|
|
'Dim oTreeView As TreeView = New TreeView()
|
|
Dim oDataRow As DataRow
|
|
For Each oDataRow In oDS.Tables(0).Rows
|
|
If Not oDataRow.IsNull("Parent") Then
|
|
If oDataRow.Item("Parent") = 0 Then
|
|
'If oDataRow.IsNull("Parentid") Then
|
|
Dim oNode As New TreeNode()
|
|
oNode.Text = oDataRow("Bezeichnung").ToString()
|
|
oNode.Tag = oDataRow("nrreport").ToString
|
|
oNode.ImageIndex = 0
|
|
oNode.SelectedImageIndex = 0
|
|
oNode.StateImageIndex = 0
|
|
oTreeview.Nodes.Add(oNode)
|
|
RecursivelyLoadTree(oDataRow, oNode)
|
|
End If
|
|
End If
|
|
Next oDataRow
|
|
oDS.Dispose()
|
|
oDS = Nothing
|
|
End Sub
|
|
|
|
Private Sub RecursivelyLoadTree(ByVal oDataRow As DataRow, ByRef oNode As TreeNode)
|
|
Dim oChildRow As DataRow
|
|
For Each oChildRow In oDataRow.GetChildRows("SelfRefenceRelation")
|
|
Dim oChildNode As New TreeNode()
|
|
oChildNode.Text = oChildRow("Bezeichnung").ToString()
|
|
oChildNode.Tag = oChildRow("nrreport").ToString()
|
|
oChildNode.ImageIndex = 1
|
|
oChildNode.SelectedImageIndex = 1
|
|
oChildNode.StateImageIndex = 1
|
|
oNode.Nodes.Add(oChildNode)
|
|
RecursivelyLoadTree(oChildRow, oChildNode)
|
|
Next oChildRow
|
|
End Sub
|
|
|
|
#End Region
|
|
|
|
Sub Get_Reports()
|
|
If usedb Then
|
|
Get_Reports_from_db()
|
|
Exit Sub
|
|
End If
|
|
Dim fileEntries As String() = Directory.GetFiles(intdb.Get_Option(100), "*.frx")
|
|
' Process the list of .txt files found in the directory. '
|
|
Dim fileName As String
|
|
|
|
'For Each fileName In fileEntries
|
|
' If (System.IO.File.Exists(fileName)) Then
|
|
' Dim r As New FastReport.Report
|
|
' r.Load(fileName)
|
|
' Dim s As String
|
|
' s = r.ReportInfo.Name
|
|
|
|
|
|
' '
|
|
' End If
|
|
'Next
|
|
|
|
Dim s As String
|
|
Me.TreeReporting.Nodes.Clear()
|
|
Dim fn As String
|
|
fn = intdb.Get_Option(100)
|
|
fn = fn + Globals.ActUser.ToString + "_Reports.txt"
|
|
If File.Exists(fn) Then
|
|
FileOpen(1, fn, Mode:=OpenMode.Input)
|
|
Else
|
|
FileOpen(1, intdb.Get_Option(100) + "Reports.txt", Mode:=OpenMode.Input)
|
|
End If
|
|
|
|
While Not EOF(1)
|
|
Input(1, s)
|
|
ReportCollection.Add(New Report(s))
|
|
End While
|
|
FileClose(1)
|
|
|
|
Dim tn As TreeNode
|
|
Dim i As Integer
|
|
For i = 1 To ReportCollection.Count
|
|
Dim xreport As Report = ReportCollection(i)
|
|
If xreport.Parentid = 0 Then
|
|
tn = New TreeNode
|
|
tn.Text = xreport.Reportname
|
|
tn.Tag = xreport.Keyvalue
|
|
TreeReporting.Nodes.Add(tn)
|
|
Else
|
|
Dim tn1 As New TreeNode
|
|
tn1.Text = xreport.Reportname
|
|
tn1.Tag = xreport.Keyvalue
|
|
tn.Nodes.Add(tn1)
|
|
End If
|
|
Next
|
|
Me.TreeReporting.ExpandAll()
|
|
'Fill_Parameter()
|
|
Me.TreeReporting.SelectedNode = Me.TreeReporting.Nodes(0)
|
|
End Sub
|
|
|
|
Private Sub TreeReporting_AfterSelect(sender As Object, e As TreeViewEventArgs) Handles TreeReporting.AfterSelect
|
|
Try
|
|
Me.Properties.HelpVisible = False
|
|
Dim i As Integer = TreeReporting.SelectedNode.Tag
|
|
If usedb Then
|
|
|
|
reportfilename = intdb.Get_Option(100)
|
|
sqlfilename = reportfilename + Now.ToString("yyyyMMddhhmmss") + ".sql"
|
|
reportfilename = reportfilename + Now.ToString("yyyyMMddhhmmss") + ".frx"
|
|
Dim db As New clsDB
|
|
db.Get_Tabledata("Report", "", "Select * from reporting where nrreport=" + TreeReporting.SelectedNode.Tag)
|
|
Dim objwriter As New System.IO.StreamWriter(sqlfilename)
|
|
objwriter.Write(db.dsDaten.Tables(0).Rows(0).Item("SQL"))
|
|
objwriter.Close()
|
|
objwriter = Nothing
|
|
Dim objwriter1 As New System.IO.StreamWriter(reportfilename)
|
|
objwriter1.Write(db.dsDaten.Tables(0).Rows(0).Item("Reportfile"))
|
|
objwriter1.Close()
|
|
objwriter1 = Nothing
|
|
Fill_Parameter()
|
|
Exit Sub
|
|
End If
|
|
get_filenames()
|
|
Fill_Parameter()
|
|
Catch
|
|
End Try
|
|
|
|
End Sub
|
|
Sub get_filenames()
|
|
For i As Integer = 1 To ReportCollection.Count
|
|
Dim rc As Report = ReportCollection(i)
|
|
If rc.Reportname = Me.TreeReporting.SelectedNode.Text Then
|
|
sqlfilename = intdb.Get_Option(101)
|
|
If Microsoft.VisualBasic.Right(sqlfilename, 1) <> "\" Then sqlfilename = sqlfilename + "\"
|
|
sqlfilename = sqlfilename + rc.sqlfile
|
|
reportfilename = intdb.Get_Option(100)
|
|
If Microsoft.VisualBasic.Right(reportfilename, 1) <> "\" Then reportfilename = reportfilename + "\"
|
|
reportfilename = reportfilename + rc.reportfile
|
|
End If
|
|
Next
|
|
End Sub
|
|
|
|
Sub Fill_Parameter()
|
|
ParameterColleation.Clear()
|
|
Dim sr As StreamReader = New StreamReader(sqlfilename)
|
|
Dim s As String
|
|
Do While sr.Peek() >= 0
|
|
s = sr.ReadLine()
|
|
If Microsoft.VisualBasic.Left(s, 1) = "#" Then
|
|
ParameterColleation.Add(New Reportparameter(s))
|
|
End If
|
|
Loop
|
|
sr.Close()
|
|
|
|
Properties.ShowCustomProperties = True
|
|
Properties.Item.Clear()
|
|
Dim defaultvalue As String
|
|
Me.Properties.ContextMenuStrip = Nothing
|
|
If ParameterColleation.Count > 0 Then
|
|
For i As Integer = 1 To ParameterColleation.Count
|
|
Dim param As Reportparameter = ParameterColleation(i)
|
|
If param.description <> "" Then Me.Properties.HelpVisible = True Else Me.Properties.HelpVisible = False
|
|
Select Case UCase(param.Parametertype)
|
|
Case "TABLE"
|
|
Dim splitter() As String
|
|
splitter = param.ParameterDefault.ToString.Split(";")
|
|
Properties.Item.Add(param.Parameterbezeichnung, splitter(0), False, "Tabellenauswahl", param.description, True)
|
|
Properties.Item(Properties.Item.Count - 1).Datasource = splitter
|
|
Properties.Item(Properties.Item.Count - 1).IsDropdownResizable = False
|
|
'Properties.Item(Properties.Item.Count - 1)
|
|
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
|
|
Case "DATATABLE"
|
|
Dim splitter() As String
|
|
splitter = param.ParameterDefault.ToString.Split(";")
|
|
Dim db As New clsDB
|
|
db.Get_Tabledata("Parameter", "", param.ParameterDefault)
|
|
Dim s1 As String = ""
|
|
For Each r As DataRow In db.dsDaten.Tables(0).Rows
|
|
If s1 <> "" Then s1 = s1 + "~"
|
|
If db.dsDaten.Tables(0).Columns.Count > 1 Then
|
|
Try
|
|
s1 = s1 + r.Item(0).ToString + " -- " + r.Item(1).ToString
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message)
|
|
End Try
|
|
Else
|
|
s1 = s1 + r.Item(0)
|
|
End If
|
|
|
|
Next
|
|
s1 = "" + "~" + s1
|
|
splitter = s1.Split("~")
|
|
Properties.Item.Add(param.Parameterbezeichnung, splitter(0), False, "Tabellenauswahl", param.description, 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
|
|
Case Else
|
|
Select Case param.ParameterDefault
|
|
Case "now"
|
|
Properties.Item.Add(param.Parameterbezeichnung, New Date(Today.Ticks), False, "Parameter", param.description, True)
|
|
Case Else
|
|
defaultvalue = param.ParameterDefault
|
|
If IsNumeric(defaultvalue) Then
|
|
Properties.Item.Add(param.Parameterbezeichnung, defaultvalue, False, "Parameter", param.description, True)
|
|
If param.Parameterbezeichnung = "Nummern (Komma-Getrennt)" Then
|
|
Me.Properties.ContextMenuStrip = ContextMenuStrip1
|
|
End If
|
|
Else
|
|
Select Case defaultvalue
|
|
Case "currentyear"
|
|
Properties.Item.Add(param.Parameterbezeichnung, Year(Now), False, "Parameter", param.description, True)
|
|
Case "lastyear"
|
|
Properties.Item.Add(param.Parameterbezeichnung, Year(Now) - 1, False, "Parameter", param.description, True)
|
|
Case "firstofcurrentyear"
|
|
Dim dt As Date = "01.01." + Year(Now).ToString
|
|
Properties.Item.Add(param.Parameterbezeichnung, New Date(dt.Ticks), False, "Parameter", param.description, True)
|
|
Case "lastofcurrentyear"
|
|
Dim dt As Date = "31.12." + Year(Now).ToString
|
|
Properties.Item.Add(param.Parameterbezeichnung, New Date(dt.Ticks), False, "Parameter", param.description, True)
|
|
Case "firstofcurrentmonth"
|
|
Dim m As String = Month(Now).ToString
|
|
While Len(m) < 2
|
|
m = "0" + m
|
|
End While
|
|
Dim dt As Date = "01." + m + "." + Year(Now).ToString
|
|
Properties.Item.Add(param.Parameterbezeichnung, New Date(dt.Ticks), False, "Parameter", param.description, True)
|
|
Case "lastofcurrentmonth"
|
|
Dim datLastDay As Date
|
|
datLastDay = GetLastDayOfMonth(Month(Now), Year(Now))
|
|
|
|
Properties.Item.Add(param.Parameterbezeichnung, New Date(datLastDay.Ticks), False, "Parameter", param.description, True)
|
|
Case "currentdate"
|
|
Dim dt As Date = Now.ToShortDateString
|
|
Properties.Item.Add(param.Parameterbezeichnung, New Date(dt.Ticks), False, "Parameter", param.description, True)
|
|
Case "monthtable"
|
|
Dim splitter() As String
|
|
splitter = param.ParameterDefault.ToString.Split(";")
|
|
Dim dr As New DataTable
|
|
dr.Columns.Add("Keyvalue")
|
|
dr.Columns.Add("Value")
|
|
Dim currentdate As Date = FirstDayOfMonth(Now)
|
|
currentdate = currentdate.AddMonths(+12)
|
|
|
|
For ii As Integer = 1 To 24
|
|
Dim r As DataRow = dr.NewRow
|
|
r(0) = Month_Year(currentdate)
|
|
r(1) = Month_Year_Name(currentdate)
|
|
dr.Rows.Add(r)
|
|
currentdate = currentdate.AddMonths(-1)
|
|
Next
|
|
|
|
|
|
Dim s1 As String = ""
|
|
For Each r As DataRow In dr.Rows
|
|
If s1 <> "" Then s1 = s1 + "~"
|
|
If dr.Columns.Count > 1 Then
|
|
Try
|
|
s1 = s1 + r.Item(0).ToString + " -- " + r.Item(1).ToString
|
|
Catch ex As Exception
|
|
MsgBox(ex.Message)
|
|
End Try
|
|
Else
|
|
s1 = s1 + r.Item(0)
|
|
End If
|
|
|
|
Next
|
|
s1 = "" + "~" + s1
|
|
splitter = s1.Split("~")
|
|
Properties.Item.Add(param.Parameterbezeichnung, splitter(0), False, "Tabellenauswahl", param.description, 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
|
|
Case Else
|
|
Properties.Item.Add(param.Parameterbezeichnung, defaultvalue, False, "Parameter", param.description, True)
|
|
End Select
|
|
End If
|
|
|
|
End Select
|
|
End Select
|
|
|
|
'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
|
|
|
|
Public Function GetLastDayOfMonth(intMonth, intYear) As Date
|
|
GetLastDayOfMonth = DateSerial(intYear, intMonth + 1, 0)
|
|
|
|
End Function
|
|
|
|
Public Function FirstDayOfMonth(ByVal sourceDate As DateTime) As DateTime
|
|
Return New DateTime(sourceDate.Year, sourceDate.Month, 1)
|
|
End Function
|
|
|
|
Public Function Month_Year(ByVal d As Date) As String
|
|
Dim m As String
|
|
m = Month(d).ToString
|
|
While Len(m) < 2
|
|
m = "0" + m
|
|
|
|
End While
|
|
Return m + "." + Year(d).ToString
|
|
End Function
|
|
|
|
Public Function Month_Year_Name(ByVal d As Date) As String
|
|
Dim m As String
|
|
Dim s As String
|
|
m = Month(d).ToString
|
|
While Len(m) < 2
|
|
m = "0" + m
|
|
|
|
End While
|
|
Select Case m
|
|
Case "01"
|
|
s = "Januar"
|
|
Case "02"
|
|
s = "Februar"
|
|
Case "03"
|
|
s = "Mörz"
|
|
Case "04"
|
|
s = "April"
|
|
Case "05"
|
|
s = "Mai"
|
|
Case "06"
|
|
s = "Juni"
|
|
Case "07"
|
|
s = "Juli"
|
|
Case "08"
|
|
s = "August"
|
|
Case "09"
|
|
s = "September"
|
|
Case "10"
|
|
s = "Oktober"
|
|
Case "11"
|
|
s = "November"
|
|
Case "12"
|
|
s = "Dezember"
|
|
End Select
|
|
Return s + " " + Year(d).ToString
|
|
End Function
|
|
|
|
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
|
|
Show_Report()
|
|
End Sub
|
|
|
|
Public Sub Show_CAMT_Journal()
|
|
If usedb = True Then
|
|
Dim rdb As New clsDB
|
|
Dim f As New frmAuswertung
|
|
f.MdiParent = Me.ParentForm.MdiParent
|
|
f.Show()
|
|
rdb.Get_Tabledata("CAMT_Run", "", "Select top 1 * From camt_run order By nreintrag desc")
|
|
Dim camtnr As Integer = rdb.dsDaten.Tables(0).Rows(0).Item("nreintrag")
|
|
rdb.Get_Tabledata("CAMT_Journal", "", "Select top 1 * from Reporting where Bezeichnung='CAMT-Journal'")
|
|
|
|
If Me.Findnode(rdb.dsDaten.Tables(0).Rows(0).Item("NrReport")) Then
|
|
Me.Set_Propertiesvalue(0, camtnr)
|
|
Me.Show_Report()
|
|
End If
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
Dim tmpcollection As New Collection
|
|
Dim s As String
|
|
Me.TreeReporting.Nodes.Clear()
|
|
FileOpen(1, intdb.Get_Option(100) + "Reports.txt", Mode:=OpenMode.Input)
|
|
While Not EOF(1)
|
|
Input(1, s)
|
|
tmpcollection.Add(New Report(s))
|
|
End While
|
|
FileClose(1)
|
|
|
|
For i = 1 To tmpcollection.Count
|
|
Dim xreport As Report = ReportCollection(i)
|
|
If xreport.reportfile = "CamtJournaleinfach.frx" Then
|
|
sqlfilename = intdb.Get_Option(101)
|
|
If Microsoft.VisualBasic.Right(sqlfilename, 1) <> "\" Then sqlfilename = sqlfilename + "\"
|
|
sqlfilename = sqlfilename + xreport.sqlfile
|
|
reportfilename = intdb.Get_Option(100)
|
|
If Microsoft.VisualBasic.Right(reportfilename, 1) <> "\" Then reportfilename = reportfilename + "\"
|
|
reportfilename = reportfilename + xreport.reportfile
|
|
End If
|
|
Next
|
|
ParameterColleation.Clear()
|
|
Dim sr As StreamReader = New StreamReader(sqlfilename)
|
|
|
|
Do While sr.Peek() >= 0
|
|
s = sr.ReadLine()
|
|
If Microsoft.VisualBasic.Left(s, 1) = "#" Then
|
|
ParameterColleation.Add(New Reportparameter(s))
|
|
End If
|
|
Loop
|
|
sr.Close()
|
|
Dim db As New clsDB
|
|
db.Get_Tabledata("CAMT_RUN", "", "Select top 1 * from CAMT_Run order by nreintrag desc")
|
|
Show_Report(db.dsDaten.Tables(0).Rows(0).Item(0).ToString)
|
|
|
|
|
|
End Sub
|
|
Private Function SplitWords(ByVal s As String) As String()
|
|
' Call Regex.Split function from the imported namespace.
|
|
' ... Return the result array.
|
|
Return Regex.Split(s, "\W+")
|
|
End Function
|
|
|
|
Sub Show_Report(Optional Paramvalue As String = "")
|
|
If Paramvalue <> "" Then Me.GroupBox1.Visible = False
|
|
Dim SQL As String = ""
|
|
Dim export_filename As String
|
|
Dim report As New FastReport.Report
|
|
'20221108 - Fonts
|
|
Dim fonts = Directory.GetFiles(Application.StartupPath + "\Fonts")
|
|
|
|
For Each F As String In fonts
|
|
FastReport.Utils.Config.PrivateFontCollection.AddFontFile(F)
|
|
Next
|
|
|
|
FastReport.Utils.Config.FontListFolder = Application.StartupPath + "\Fonts"
|
|
'20221108 Ende
|
|
If Not File.Exists(reportfilename) Then
|
|
Dim tmp As String
|
|
tmp = reportfilename
|
|
reportfilename = intdb.Get_Option("100")
|
|
If Microsoft.VisualBasic.Right(reportfilename, 1) <> "\" Then reportfilename = reportfilename + "\empty.frx" Else 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 spl As String()
|
|
'spl = report.ReportInfo.Description.Split("vbCrLf")
|
|
'SQL = ""
|
|
'Dim ss As String
|
|
'For i As Integer = 0 To spl.Length - 1
|
|
' If spl(i).Substring(0, 1) = "#" Then
|
|
' ss = ss
|
|
' Else
|
|
' ss = spl(i)
|
|
' ss = ss.Replace("""", "")
|
|
' SQL = SQL + " " + vbCrLf + " " + ss
|
|
' End If
|
|
'Next
|
|
|
|
|
|
|
|
Dim sr As StreamReader = New StreamReader(sqlfilename)
|
|
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()
|
|
|
|
Dim Absender As String = intdb.Get_Option(103)
|
|
report.SetParameterValue("Absender", Absender)
|
|
|
|
For i = 1 To ParameterColleation.Count
|
|
Dim r As Reportparameter = ParameterColleation(i)
|
|
Dim PV As String = ""
|
|
Try
|
|
If Paramvalue <> "" Then
|
|
PV = Paramvalue
|
|
Else
|
|
PV = Properties.Item(i - 1).Value
|
|
End If
|
|
Catch
|
|
End Try
|
|
|
|
'If pv.IndexOf(" -- ") > -1 Then
|
|
' Dim p As Integer
|
|
' p = pv.IndexOf(" -- ")
|
|
' pv = pv.Substring(0, p)
|
|
'End If
|
|
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
|
|
Dim x As String = ""
|
|
If Paramvalue <> "" Then x = Paramvalue Else x = Properties.Item(i - 1).Value.ToString
|
|
If x.IndexOf(" -- ") > -1 Then
|
|
x = x.Substring(0, PV.IndexOf(" -- "))
|
|
Properties.Item(i - 1).Value = x
|
|
report.SetParameterValue(r.Parameterbezeichnung, x)
|
|
Else
|
|
If Paramvalue <> "" Then
|
|
report.SetParameterValue(r.Parameterbezeichnung, x.ToString)
|
|
Else
|
|
report.SetParameterValue(r.Parameterbezeichnung, Properties.Item(i - 1).Value.ToString)
|
|
End If
|
|
'report.SetParameterValue(r.Parameterbezeichnung, Properties.Item(i - 1).Value.ToString)
|
|
|
|
End If
|
|
' 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 = intdb.Get_Option("102") + export_filename + ".pdf"
|
|
|
|
Dim sr1 As StreamReader = New StreamReader(sqlfilename)
|
|
Dim s1 As String = ""
|
|
Dim sqlcollection As New Collection
|
|
Dim defsqlcollection As New Collection
|
|
SQL = ""
|
|
Do While sr1.Peek() >= 0
|
|
s1 = sr1.ReadLine
|
|
If Trim(s1) <> "" Then
|
|
If s1.IndexOf("-SQL-") > -1 Then
|
|
If SQL <> "" Then sqlcollection.Add(SQL)
|
|
SQL = ""
|
|
Else
|
|
If s1.Substring(0, 1) <> "#" Then
|
|
SQL = SQL + vbCrLf + s1
|
|
End If
|
|
End If
|
|
End If
|
|
|
|
Loop
|
|
If SQL <> "" Then sqlcollection.Add(SQL)
|
|
sr1.Close()
|
|
|
|
|
|
|
|
For i1 As Integer = 1 To sqlcollection.Count
|
|
Dim s2 As String = sqlcollection(i1).ToString
|
|
For i = 1 To ParameterColleation.Count
|
|
Dim r As Reportparameter = ParameterColleation(i)
|
|
Dim PV As String = ""
|
|
If Paramvalue <> "" Then PV = Paramvalue Else PV = Properties.Item(i - 1).Value
|
|
|
|
If r.Parametertype = "datetime" Then
|
|
Dim dt As Date = PV
|
|
PV = dt.ToString("yyyy-MM-dd")
|
|
Else
|
|
If Paramvalue <> "" Then PV = Paramvalue Else PV = Properties.Item(i - 1).Value
|
|
End If
|
|
|
|
s2 = s2.Replace(r.Parametername, PV)
|
|
Next
|
|
|
|
defsqlcollection.Add(s2)
|
|
Next
|
|
|
|
Dim ds As New DataSet
|
|
Dim tblcounter As Integer = 0
|
|
|
|
'20180829
|
|
If defsqlcollection.Count > 1 Then
|
|
For i = 1 To defsqlcollection.Count
|
|
Dim db As New clsDB
|
|
db.Get_Tabledata("Reportdata", "", defsqlcollection(i))
|
|
ds.Tables.Add(db.dsDaten.Tables(0).Copy)
|
|
tblcounter = tblcounter + 1
|
|
ds.Tables(ds.Tables.Count - 1).TableName = "Daten_" + tblcounter.ToString
|
|
db.Dispose()
|
|
Next
|
|
Else
|
|
Dim db As New clsDB
|
|
db.Get_Tabledata("Reportdata", "", defsqlcollection(1))
|
|
ds.Tables.Add(db.dsDaten.Tables(0).Copy)
|
|
ds.Tables(ds.Tables.Count - 1).TableName = "Daten"
|
|
db.Dispose()
|
|
End If
|
|
|
|
|
|
|
|
|
|
'Dim SQLconnect As New SqlConnection
|
|
'SQLconnect.ConnectionString = intdb.Connectionstring
|
|
'SQLconnect.Open()
|
|
|
|
'Dim da As New SqlDataAdapter("", SQLconnect)
|
|
'Dim sqlcmd As New SqlCommand
|
|
|
|
'sqlcmd.Connection = SQLconnect
|
|
'sqlcmd.CommandType = CommandType.Text
|
|
'If defsqlcollection.Count > 1 Then
|
|
' For i = 1 To defsqlcollection.Count
|
|
' sqlcmd.CommandText = defsqlcollection(i)
|
|
' da.SelectCommand = sqlcmd
|
|
' tblcounter = tblcounter + 1
|
|
' da.Fill(ds, "Daten_" + tblcounter.ToString)
|
|
' Next
|
|
'Else
|
|
' sqlcmd.CommandText = defsqlcollection(1)
|
|
' da.SelectCommand = sqlcmd
|
|
' Try
|
|
' da.Fill(ds, "Daten")
|
|
' Catch ex As Exception
|
|
' MsgBox(ex.Message)
|
|
|
|
' End Try
|
|
'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)
|
|
Process.Start(export_filename)
|
|
Exit Sub
|
|
End If
|
|
|
|
|
|
If Me.CheckBox1.Checked = False Then
|
|
report.ShowPrepared()
|
|
Else
|
|
Dim ReportDate As DateTime = System.IO.File.GetLastWriteTime(reportfilename)
|
|
report.Design()
|
|
Dim ReportDate2 As DateTime = System.IO.File.GetLastWriteTime(reportfilename)
|
|
If ReportDate < ReportDate2 Then
|
|
Dim db As New clsDB
|
|
Dim t As String = System.IO.File.ReadAllText(reportfilename)
|
|
db.Exec_SQL("Update Reporting set reportfile='" + t + "' where nrreport = " + Me.TreeReporting.SelectedNode.Tag)
|
|
End If
|
|
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 Properties_DoubleClick(sender As Object, e As EventArgs) Handles Properties.DoubleClick
|
|
|
|
End Sub
|
|
|
|
Private Sub Properties_Click(sender As Object, e As EventArgs) Handles Properties.Click
|
|
|
|
End Sub
|
|
|
|
Private Sub PatientenAuswahlToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles PatientenAuswahlToolStripMenuItem.Click
|
|
Dim f As New FrmSearchDialog
|
|
f.ShowDialog()
|
|
If f.DialogResult = DialogResult.OK Then
|
|
Me.Properties.Item(1).Value = f.TextBox1.Text
|
|
Me.Properties.Refresh()
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub frmAuswertung_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
|
|
Dim path As String = intdb.Get_Option(100)
|
|
DeleteDirectory(path)
|
|
End Sub
|
|
Private Sub DeleteDirectory(path As String)
|
|
If Directory.Exists(path) Then
|
|
'Delete all files from the Directory
|
|
For Each filepath As String In Directory.GetFiles(path)
|
|
File.Delete(filepath)
|
|
Next
|
|
'Delete all child Directories
|
|
'For Each dir As String In Directory.GetDirectories(path)
|
|
' DeleteDirectory(dir)
|
|
'Next
|
|
'Delete a Directory
|
|
'Directory.Delete(path)
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs) Handles ToolStripButton1.Click
|
|
Me.TreeReporting.ExpandAll()
|
|
End Sub
|
|
|
|
Private Sub ToolStripButton2_Click(sender As Object, e As EventArgs) Handles ToolStripButton2.Click
|
|
Me.TreeReporting.CollapseAll()
|
|
End Sub
|
|
End Class
|
|
|
|
Public Class Report
|
|
Dim m_reportname As String
|
|
|
|
Dim m_keyvalue As Integer
|
|
Property Keyvalue As Integer
|
|
Get
|
|
Return m_keyvalue
|
|
|
|
End Get
|
|
Set(value As Integer)
|
|
m_keyvalue = value
|
|
End Set
|
|
End Property
|
|
|
|
Dim m_parentid As Integer
|
|
Property Parentid As Integer
|
|
Get
|
|
Return m_parentid
|
|
End Get
|
|
Set(value As Integer)
|
|
m_parentid = value
|
|
End Set
|
|
End Property
|
|
|
|
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)
|
|
Try
|
|
Dim splitter() As String
|
|
splitter = inputstring.Split(";")
|
|
Me.Keyvalue = splitter(0)
|
|
Me.Parentid = splitter(1)
|
|
Me.Reportname = splitter(2)
|
|
Me.sqlfile = splitter(3)
|
|
Me.reportfile = splitter(4)
|
|
Catch
|
|
End Try
|
|
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
|
|
|
|
Dim m_description As String
|
|
Property description As String
|
|
Get
|
|
Return m_description
|
|
End Get
|
|
Set(value As String)
|
|
m_description = 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
|
|
Try
|
|
Me.description = splitter(4)
|
|
Catch ex As Exception
|
|
Me.description = ""
|
|
End Try
|
|
End Sub
|
|
|
|
|
|
End Class
|
|
''' <summary>
|
|
''' A Simple Class to test BrowsableAttribute usage
|
|
''' </summary>
|
|
''' <remarks></remarks>
|
|
<Serializable()>
|
|
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 |