Imports Syncfusion.DocToPDFConverter Imports Syncfusion.Pdf Imports Syncfusion.XPS Imports QRCoder Imports QRCoder.PayloadGenerator Imports System.IO 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 Dim AsPDF As Boolean = False 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 = "", Optional asPDF As Boolean = False) InitializeComponent() Me.ReportNr = Reportnr Me.Design = design Me.Text = "Auswertung " + Titel Me.Parameter = Parameter Me.NrBehandlung = NrBehandlung Me.AsPDF = asPDF 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_Vorschau(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(True, False, rate, kopie, fakturanr) End Sub 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 kopie = 0 And 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 If Globals.akontovorschau = True 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 Mahnungg(ByVal Stufe As Integer, 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, Optional Preview As Boolean = False, Optional design As Boolean = False) Me.ReportNr = reportnr Me.Parameter = Parameter Me.NrBehandlung = nrbehandlung If Globals.FakturaNr <> 0 Then fakturanr = Globals.FakturaNr Print_Mahnung(Stufe, Preview, design, rate, 1, fakturanr) If Preview Then Exit Sub If buchen = False Then Exit Sub db.Mahnung_Buchen(fakturanr, Stufe, daten.Tables("esdaten")) ' rechnung_buchen(rate, daten.Tables("ESDaten").Rows(0).Item("Nur_Franken") + daten.Tables("ESDaten").Rows(0).Item("Nur_Rappen") / 100) End Sub Public Sub Print_Mahnung(ByVal Stufe As Integer, Optional vorschau 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 '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 Dim FILENAME As String = db.get_reportdata(Me.ReportNr, Parameter) db.Get_RptDatei((Me.ReportNr), FILENAME) Me.freport.Preview = Me.previewControl1 If vorschau = True Or design = True Then Me.freport.Preview.Visible = True Else Me.freport.Preview.Visible = False End If 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 / Empfä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) dbr = paramdaten.NewRow dbr(0) = "@iMahnstufe" dbr(1) = Stufe 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, Stufe) 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 vorschau = True Then freport.Preview = Me.previewControl1 freport.Show() End If If vorschau = 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() Try Dim s As String = My.Settings.DocArchivPath + "\" + Now.ToString("yyyyddMMhhmmssfff") + "_" + 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 = UCase(db.Get_Option(50000)) = "TRUE" pdfexport.AllowPrint = UCase(db.Get_Option(50002)) = "TRUE" pdfexport.TextInCurves = UCase(db.Get_Option(50001)) = "TRUE" pdfexport.EmbeddingFonts = True 'pdfexport.Compressed = False 'pdfexport.AllowPrint = True 'pdfexport.EmbeddingFonts = True 'pdfexport.TextInCurves = True freport.Prepare() freport.Export(pdfexport, s + ".PDF") Dim pdfitem As New clspdfcollectionitem(Fakturanr.ToString, s + ".pdf") Globals.pdfCollection.Add(pdfitem) 'Globals.pdfCollection.Add(s + ".pdf") Catch ex As Exception End Try End If 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, Optional doktype As String = "") If Rate > 1 Then ReportNr = ReportNr + 1 ' If Rate > 1 And ReportNr = 4 Then ReportNr = 2 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 '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 Dim FILENAME As String = db.get_reportdata(Me.ReportNr, Parameter) db.Get_RptDatei((Me.ReportNr), FILENAME) Me.freport.Preview = Me.previewControl1 If vorschaue = True Or design = True Then Me.freport.Preview.Visible = True Else Me.freport.Preview.Visible = False End If ' Me.freport.Preview.Visible = False 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) If Globals.akontobuchung = True Then dbr = paramdaten.NewRow dbr(0) = "@iakontoid" dbr(1) = Globals.akontoid paramdaten.Rows.Add(dbr) End If 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") If Rate < 2 Then Globals.HauptfakturaNr = Globals.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 If doktype <> "" Then freport.SetParameterValue("Doktype", doktype) freport.PrintSettings.ShowDialog = True If Globals.IgnorePrint Then Exit Sub 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.Prepare() freport.Preview = Me.previewControl1 Dim wm As New FastReport.Watermark wm.Enabled = True wm.Text = db.Get_Option(60001) wm.Font = New Font(wm.Font.Name, 120, wm.Font.Style, wm.Font.Unit) Dim page As FastReport.ReportPage = previewControl1.Report.PreparedPages.GetPage(previewControl1.PageNo - 1) Dim originalpage As FastReport.ReportPage = TryCast(page.OriginalComponent.OriginalComponent, FastReport.ReportPage) originalpage.Watermark = wm freport.Show() previewControl1.RefreshReport() 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 If AsPDF Then Dim s As String = My.Settings.DocArchivPath + "\" + Now.ToString("yyyyddMMhhmmssfff") + "_" + 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 = UCase(db.Get_Option(50000)) = "TRUE" pdfexport.AllowPrint = UCase(db.Get_Option(50002)) = "TRUE" pdfexport.TextInCurves = UCase(db.Get_Option(50001)) = "TRUE" 'pdfexport.EmbeddingFonts = True 'pdfexport.PdfCompliance = FastReport.Export.Pdf.PDFExport.PdfStandard.PdfX_4 'pdfexport.Compressed = False 'pdfexport.AllowPrint = True ' pdfexport.EmbeddingFonts = True 'pdfexport.TextInCurves = True 'pdfexport.Compressed = True 'pdfexport.PdfCompliance = FastReport.Export.Pdf.PDFExport.PdfStandard.PdfA_2a freport.Prepare() freport.Export(pdfexport, s + ".PDF") 'Process.Start(s + ".pdf") Dim pdfitem As New clspdfcollectionitem(Globals.FakturaNr.ToString, s + ".pdf") Globals.pdfCollection.Add(pdfitem) ' Globals.pdfCollection.Add(s + ".pdf") Exit Sub End If freport.PrintSettings.ShowDialog = False freport.Print() 'Export the printed Document Try Dim s As String = My.Settings.DocArchivPath + "\" + Now.ToString("yyyyddMMhhmmssfff") + "_" + 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 = UCase(db.Get_Option(50000)) = "TRUE" pdfexport.AllowPrint = UCase(db.Get_Option(50002)) = "TRUE" pdfexport.TextInCurves = UCase(db.Get_Option(50001)) = "TRUE" pdfexport.EmbeddingFonts = True ' pdfexport.Compressed = False 'pdfexport.AllowPrint = True 'pdfexport.EmbeddingFonts = True 'pdfexport.TextInCurves = True freport.Prepare() freport.Export(pdfexport, s + ".PDF") Dim pdfitem As New clspdfcollectionitem(Fakturanr.ToString, s + ".pdf") Globals.pdfCollection.Add(pdfitem) 'Globals.pdfCollection.Add(s + ".pdf") Catch ex As Exception End Try End If End Sub Private Sub get_esdaten(ratenr As Integer, Optional kopie As Integer = 0, Optional fakturanr As Integer = 0, Optional MahnStufe 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) dbr = paramdaten.NewRow dbr(0) = "@iMahnstufe" dbr(1) = MahnStufe paramdaten.Rows.Add(dbr) dbr = paramdaten.NewRow dbr(0) = "@iHauptfakturanr" If ratenr = 0 Then dbr(1) = 0 Else dbr(1) = Globals.HauptfakturaNr paramdaten.Rows.Add(dbr) If Globals.akontobuchung = True Then dbr = paramdaten.NewRow dbr(0) = "@iakontoid" dbr(1) = Globals.akontoid paramdaten.Rows.Add(dbr) End If 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 Dim datum As DateTime datum = Now If fakturanr <> 0 Then Dim db1 As New clsDB db1.Get_Tabledata("Faktura", "where nrfaktura=" + fakturanr.ToString) datum = db1.dsDaten.Tables(0).Rows(0).Item("datum") End If 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, datum) While Len(dd) < 2 dd = "0" + dd End While s = s + dd dd = DatePart(DateInterval.Month, datum) While Len(dd) < 2 dd = "0" + dd End While s = s + dd dd = Year(datum).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) db.dsDaten.Tables(0).Rows(0).Item("qr_referenz_aufbereitet") = ref1 db.dsDaten.Tables(0).Rows(0).Item("qr_referenz") = ref1.Replace(" ", "") 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 Try Generate_QRImage(db.dsDaten.Tables(0).Rows(0)) Catch End Try End Sub Sub Generate_QRImage(r As DataRow) Try Dim intdb As New clsDB If UCase(intdb.Get_Option(20000)) <> "TRUE" Then Exit Sub Dim contactGeneral As SwissQrCode.Contact = New SwissQrCode.Contact(r("QR_Name"), r("QR_PLZ"), r("QR_Ort"), r("QR_Land"), r("QR_Strasse"), r("QR_Hausnummer")) Dim contactdebitor As SwissQrCode.Contact = New SwissQrCode.Contact(r("QR_debitor_Name"), r("QR_debitor_PLZ"), r("QR_debitor_Ort"), r("QR_debitor_Land"), r("QR_debitor_Strasse"), r("QR_debitor_Hausnummer")) Dim reference As SwissQrCode.Reference Dim iban As SwissQrCode.Iban If intdb.Get_Option(20003) = "QRR" Then iban = New SwissQrCode.Iban(r("QR_IBAN"), PayloadGenerator.SwissQrCode.Iban.IbanType.QrIban) reference = New SwissQrCode.Reference(SwissQrCode.Reference.ReferenceType.QRR, r("qr_referenz"), SwissQrCode.Reference.ReferenceTextType.QrReference) End If If intdb.Get_Option(20003) = "NON" Then iban = New SwissQrCode.Iban(r("QR_IBAN"), PayloadGenerator.SwissQrCode.Iban.IbanType.Iban) ' reference = New SwissQrCode.Reference(SwissQrCode.Reference.ReferenceType.NON, Nothing, SwissQrCode.Reference.ReferenceTextType.QrReference) reference = New SwissQrCode.Reference(SwissQrCode.Reference.ReferenceType.NON, Nothing, Nothing) End If Dim additionalInformation As SwissQrCode.AdditionalInformation = New SwissQrCode.AdditionalInformation(r("fakturanr"), "") 'Dim additionalInformation As SwissQrCode.AdditionalInformation = New SwissQrCode.AdditionalInformation(r("fakturanr"), "RG-Nr:") Dim currency As SwissQrCode.Currency = SwissQrCode.Currency.CHF Dim amount As Decimal = r("QR_Betrag") Dim generator As SwissQrCode = New SwissQrCode(iban, currency, contactdebitor, reference, additionalInformation, contactGeneral, amount, Nothing, Nothing) Dim payload As String = generator.ToString() Dim qrGenerator As QRCodeGenerator = New QRCodeGenerator() Dim qrCodeData As QRCodeData = qrGenerator.CreateQrCode(payload, QRCodeGenerator.ECCLevel.M, True) Dim qrCode As QRCode = New QRCode(qrCodeData) 'Dim qrCodeAsBitmap = qrCode.GetGraphic(20, Color.Black, Color.White, CType(Bitmap.FromFile(Application.StartupPath & "\CH-Kreuz_7mm.png"), Bitmap), 14, 1) Dim qrCodeAsBitmap = qrCode.GetGraphic(20, Color.Black, Color.White, CType(Bitmap.FromFile(Application.StartupPath & "\CH-Kreuz_7mm.png"), Bitmap), 14, 1, False) Dim qrfilename As String = intdb.Get_Option(20002) + Me.NrBehandlung.ToString + "_" + Now.ToString("yyyymmddHHmmss") + "_" + Get_Unique_ID() + "_QR.png" qrCodeAsBitmap.Save(qrfilename) r("QR_Image") = qrfilename Catch ex As Exception MsgBox(ex.Message) End Try End Sub Public Function Get_Unique_ID() As String Dim id As String Dim Startdate As DateTime = #1/1/1970# Dim Spanne As TimeSpan Spanne = DateTime.Now.Subtract(Startdate) id = CType(Math.Abs(Spanne.TotalSeconds()), Integer) & "" & Int(99999 * Rnd()) + 1111 Return id End Function 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