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.

437 lines
15 KiB

Imports Syncfusion.DocToPDFConverter
Imports Syncfusion.Pdf
Imports Syncfusion.XPS
Public Class frmReportView
Dim splitter() As String
Dim WithEvents freport As FastReport.Report
Dim ReportNr As Integer
Dim Design As Boolean
Dim Parameter As String
Dim NrBehandlung As String
Dim daten As New DataSet
Sub New()
InitializeComponent()
End Sub
Sub New(ByVal Reportnr As Integer, ByVal design As Boolean, ByVal Titel As String, Optional Parameter As String = "", Optional NrBehandlung As String = "")
InitializeComponent()
Me.ReportNr = Reportnr
Me.Design = design
Me.Text = "Auswertung " + Titel
Me.Parameter = Parameter
Me.NrBehandlung = NrBehandlung
End Sub
Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
Dim paramdaten As New DataTable
Dim dbr As DataRow = paramdaten.NewRow
Dim db As New clsDB
Public Sub Fakturierung(ByVal reportnr As String, ByVal nrbehandlung As Integer, ByVal Parameter As String, ByVal rate As Integer, Optional kopie As Integer = 0, Optional fakturanr As Integer = 0, Optional buchen As Boolean = True)
Me.ReportNr = reportnr
Me.Parameter = Parameter
Me.NrBehandlung = nrbehandlung
If Globals.FakturaNr <> 0 Then fakturanr = Globals.FakturaNr
Print_Rechnung(False, False, rate, kopie, fakturanr)
If kopie = 1 Then Exit Sub
If buchen = False Then Exit Sub
rechnung_buchen(rate, daten.Tables("ESDaten").Rows(0).Item("Nur_Franken") + daten.Tables("ESDaten").Rows(0).Item("Nur_Rappen") / 100)
End Sub
Sub rechnung_buchen(rate As Integer, Betrag As Decimal)
db.Rechnung_buchen(1, daten.Tables("esdaten").Rows(0).Item("fakturanr"), rate, daten.Tables("behandlungsdaten").Rows(0).Item("nrbehandlung"), Betrag)
End Sub
Public Sub Print_Rechnung(Optional vorschaue As Boolean = False, Optional design As Boolean = False, Optional Rate As Integer = 0, Optional kopie As Integer = 0, Optional Fakturanr As Integer = 0)
If Rate > 1 Then ReportNr = ReportNr + 1
Dim kopien As Integer = 1
db.Get_Tabledata("Auswertung", "where Auswertungnr=" + Me.ReportNr.ToString)
kopien = db.dsDaten.Tables(0).Rows(0).Item("Kopien")
freport = New FastReport.Report
Dim FILENAME As String = db.get_reportdata(Me.ReportNr, Parameter)
db.Get_RptDatei((Me.ReportNr), FILENAME)
Me.freport.Preview = Me.previewControl1
Try
freport.Load(FILENAME)
Catch ex As Exception
MsgBox(ex.Message)
End Try
daten.Tables.Add(db.dsDaten.Tables(0).Copy)
daten.Tables(0).TableName = "Daten"
' Allg Behandlungsdaten / Empänger / Totale
paramdaten.Columns.Clear()
paramdaten.Rows.Clear()
daten.Tables.Clear()
dbr = paramdaten.NewRow
paramdaten.Columns.Add("Paramname")
paramdaten.Columns.Add("Paramvalue")
dbr(0) = "@behandlungsnr"
dbr(1) = Me.NrBehandlung
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@typ"
dbr(1) = "2"
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@kopie"
dbr(1) = kopie
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@ifakturanr"
dbr(1) = Fakturanr
paramdaten.Rows.Add(dbr)
db.Get_Tabledata("sp_get_fakturadata", "", "", "", True, paramdaten)
daten.Tables.Add(db.dsDaten.Tables(0).Copy)
daten.Tables(daten.Tables.Count - 1).TableName = "Behandlungsdaten"
' Leistungen
paramdaten.Rows.Clear()
dbr = paramdaten.NewRow
dbr(0) = "@behandlungsnr"
dbr(1) = Me.NrBehandlung
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@typ"
dbr(1) = "3"
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@kopie"
dbr(1) = kopie
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@ifakturanr"
dbr(1) = Fakturanr
paramdaten.Rows.Add(dbr)
'paramdaten.Rows.Add(dbr)
db.Get_Tabledata("sp_get_fakturadata", "", "", "", True, paramdaten)
daten.Tables.Add(db.dsDaten.Tables(0).Copy)
daten.Tables(daten.Tables.Count - 1).TableName = "Leistungen"
paramdaten.Rows.Clear()
dbr = paramdaten.NewRow
dbr(0) = "@behandlungsnr"
dbr(1) = Me.NrBehandlung
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@typ"
dbr(1) = "4"
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@kopie"
dbr(1) = kopie
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@ifakturanr"
dbr(1) = Fakturanr
paramdaten.Rows.Add(dbr)
'paramdaten.Rows.Add(dbr)
db.Get_Tabledata("sp_get_fakturadata", "", "", "", True, paramdaten)
daten.Tables.Add(db.dsDaten.Tables(0).Copy)
daten.Tables(daten.Tables.Count - 1).TableName = "Leistungen_LR"
paramdaten.Rows.Clear()
dbr = paramdaten.NewRow
dbr(0) = "@behandlungsnr"
dbr(1) = Me.NrBehandlung
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@typ"
dbr(1) = "5"
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@kopie"
dbr(1) = kopie
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@ifakturanr"
dbr(1) = Fakturanr
paramdaten.Rows.Add(dbr)
db.Get_Tabledata("sp_get_fakturadata", "", "", "", True, paramdaten)
daten.Tables.Add(db.dsDaten.Tables(0).Copy)
daten.Tables(daten.Tables.Count - 1).TableName = "Leistungen_Dentotar"
get_esdaten(Rate, kopie, Fakturanr)
daten.Tables.Add(db.dsDaten.Tables(0).Copy)
Globals.FakturaNr = db.dsDaten.Tables(0).Rows(0).Item("fakturanr")
daten.Tables(daten.Tables.Count - 1).TableName = "ESDaten"
freport.RegisterData(daten)
freport.GetDataSource("Behandlungsdaten").Enabled = True
freport.GetDataSource("Leistungen").Enabled = True
freport.GetDataSource("Leistungen_LR").Enabled = True
freport.GetDataSource("Leistungen_Dentotar").Enabled = True
freport.GetDataSource("ESDaten").Enabled = True
freport.PrintSettings.ShowDialog = True
If design = True Then
Dim ReportDate As DateTime = System.IO.File.GetLastWriteTime(FILENAME)
freport.Design()
Dim ReportDate2 As DateTime = System.IO.File.GetLastWriteTime(FILENAME)
If ReportDate < ReportDate2 Then
db.Save_RptDatei(Me.ReportNr, FILENAME)
End If
End If
If vorschaue = True Then
freport.Preview = Me.previewControl1
freport.Show()
End If
If vorschaue = False And design = False Then
Dim printer As New clsPrinter
Dim printername As String
Dim papierschacht As String
printer.Get_Printersettings(ReportNr, printername, papierschacht)
freport.PrintSettings.Printer = printername
freport.PrintSettings.Copies = kopien
Try
freport.PrintSettings.PaperSource = papierschacht
Catch
End Try
freport.PrintSettings.ShowDialog = False
freport.Print()
Exit Sub
Dim s As String = My.Settings.DocArchivPath + "\" + Now.ToString("yyyyddMMhhmmss") + "_" + Me.NrBehandlung.ToString
Dim xpsfilename As String = s + ".xps"
Dim pdffilename As String = s + ".pdf"
Dim imagefilename As String = s + ".jpg"
Dim rtffilename As String = s + ".rtf"
'Dim pdfExport As New FastReport.Export.Pdf.PDFExport()
'pdfExport.ShowProgress = False
'pdfExport.Subject = "Export"
'pdfExport.Title = "Export"
'pdfExport.Compressed = False
'pdfExport.AllowPrint = True
'pdfExport.EmbeddingFonts = True
'freport.Prepare()
'freport.Export(pdfExport, s + ".PDF")
'Exit Sub
Dim XPSEXPORT As New FastReport.Export.OoXML.XPSExport
freport.Export(XPSEXPORT, xpsfilename)
'Process.Start(Application.StartupPath + "\xpstopdf.exe", "-input=" + xpsfilename)
Dim p As New ProcessStartInfo
p.Arguments = xpsfilename
p.FileName = Application.StartupPath + "\topdf.bat"
p.WindowStyle = ProcessWindowStyle.Hidden
Process.Start(p)
Globals.RGCollection.Add(pdffilename)
'Dim rtfexport As New FastReport.Export.RichText.RTFExport
'freport.Export(rtfexport, rtffilename)
'Dim rtfDocument As New Syncfusion.DocIO.DLS.WordDocument(rtffilename)
'Dim converter As New DocToPDFConverter()
'Dim pdfDocument As PdfDocument = converter.ConvertToPDF(rtfDocument)
'pdfDocument.Save(pdffilename)
'pdfDocument.Close(True)
'rtfDocument.Close()
'Dim imgexport As New FastReport.Export.Image.ImageExport
'imgexport.ImageFormat = FastReport.Export.Image.ImageExportFormat.Jpeg
'imgexport.ResolutionX = 300
'imgexport.Resolution = 300
'freport.Export(imgexport, imagefilename)
'Dim xexport As New FastReport.Export.Image.ImageExport
'xexport.ImageFormat = FastReport.Export.Image.ImageExportFormat.Tiff
'xexport.ResolutionX = 300
'xexport.ResolutionY = 300
'freport.Prepare()
'freport.Export(xexport, s + ".TIF")
End If
End Sub
Private Sub get_esdaten(ratenr As Integer, Optional kopie As Integer = 0, Optional fakturanr As Integer = 0)
'ES-Daten auselsen
paramdaten.Rows.Clear()
dbr = paramdaten.NewRow
dbr(0) = "@behandlungsnr"
dbr(1) = Me.NrBehandlung
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@typ"
dbr(1) = "1"
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@Betrag"
dbr(1) = "0"
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@rate"
dbr(1) = ratenr
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@kopie"
dbr(1) = kopie
paramdaten.Rows.Add(dbr)
dbr = paramdaten.NewRow
dbr(0) = "@ifakturanr"
dbr(1) = fakturanr
paramdaten.Rows.Add(dbr)
db.Get_Tabledata("sp_get_fakturadata", "", "", "", True, paramdaten)
Dim Referenznr As String
Dim s As String
Dim S1 As String
s = db.dsDaten.Tables(0).Rows(0).Item("Nur_Franken").ToString
S1 = db.dsDaten.Tables(0).Rows(0).Item("Nur_Rappen").ToString
While Len(S1) < 2
S1 = "0" + S1
End While
s = s + S1
While Len(s) < 10
s = "0" + s
End While
s = db.dsDaten.Tables(0).Rows(0).Item("vs_belegart").ToString + s
s = s + Trim(Pruefziffer(s)) + ">"
Referenznr = s
s = db.dsDaten.Tables(0).Rows(0).Item("vs_besrid").ToString + db.dsDaten.Tables(0).Rows(0).Item("fakturanr").ToString + "0000"
Dim dd As String
dd = DatePart(DateInterval.Day, Now)
While Len(dd) < 2
dd = "0" + dd
End While
s = s + dd
dd = DatePart(DateInterval.Month, Now)
While Len(dd) < 2
dd = "0" + dd
End While
s = s + dd
dd = Year(Now).ToString
dd = dd.Substring(2, 2)
s = s + dd
s = s + Trim(Pruefziffer(s))
Dim ref1 As String
ref1 = s.Substring(0, 2) + " " + s.Substring(2, 5) + " " + s.Substring(7, 5) + " " + s.Substring(12, 5) + " " + s.Substring(17, 5) + " " + s.Substring(22, 5)
Referenznr = Referenznr + s + "+"
db.dsDaten.Tables(0).Rows(0).Item("referenzzeile1") = ref1
s = db.dsDaten.Tables(0).Rows(0).Item("Vs_teilnehmernummer")
s = s + Trim(Pruefziffer(s)) + ">"
Referenznr = Referenznr + " " + s
db.dsDaten.Tables(0).Rows(0).Item("Referenzzeile2") = Referenznr
End Sub
Public Function Pruefziffer(ByVal zahl As String) As String
Dim ptab(9, 9) As Integer
Dim pz(9) As Integer
Dim s1, s2, s3 As String
Dim i1, i2 As Long
s1 = "0,9,4,6,8,2,7,1,3,5"
s2 = s1
For i1 = 0 To 9
For i2 = 0 To 9
ptab(i1, i2) = Mid(s2, (i2 * 2) + 1, 1)
Next
s3 = Microsoft.VisualBasic.Left(s1, 1)
s1 = Microsoft.VisualBasic.Right(s1, Len(s1) - 2)
s1 = s1 + "," + s3
s2 = s1
Next
pz(0) = 0
pz(1) = 9
pz(2) = 8
pz(3) = 7
pz(4) = 6
pz(5) = 5
pz(6) = 4
pz(7) = 3
pz(8) = 2
pz(9) = 1
Dim i, x, y, z, e As Integer
Dim xx As String
y = 0
For i = 1 To Len(zahl)
x = Val(Mid(zahl, i, 1))
y = ptab(x, y)
Next
Pruefziffer = Str(pz(y))
End Function
Sub DesignReport()
Dim db As New clsDB
Dim FILENAME As String = db.get_reportdata(Me.ReportNr, Parameter)
db.Get_RptDatei(Me.ReportNr, FILENAME)
Me.freport.Preview = Me.previewControl1
Try
freport.Load(FILENAME)
Catch ex As Exception
MsgBox(ex.Message)
End Try
Dim daten As New DataSet
daten.Tables.Add(db.dsDaten.Tables(0).Copy)
daten.Tables(0).TableName = "Daten"
freport.RegisterData(daten)
'If splitter.Length > 1 Then
' Dim i As Integer
' For i = 0 To splitter.Length - 1
' If splitter(i).ToString.Length > 10 Then
' If i = 0 Then
' freport.GetDataSource("Daten").Enabled = True
' Else
' freport.GetDataSource("Daten_" + i.ToString).Enabled = True
' End If
' End If
' Next
'Else
'End If
'freport.SetParameterValue("Parcours", allg.Get_Option(2))
'freport.SetParameterValue("Spruch", allg.Get_Option(3))
'freport.Preview = Me.previewControl1
freport.GetDataSource("Daten").Enabled = True
If Me.Design = True Then
freport.Design()
MsgBox("Hallo")
Me.Close()
Else
Me.previewControl1.RefreshReport()
freport.Show()
End If
End Sub
Private Sub tsbtnquit_Click(sender As Object, e As EventArgs) Handles tsbtnquit.Click
Me.Close()
End Sub
End Class