Imports System.Collections.Generic Imports System.Data Imports System.IO Imports DigitalData.Modules.Base Imports DigitalData.Modules.Database Imports DigitalData.Modules.Logging Imports GdPicture14 Imports System.Drawing Imports System.Linq Public Class XRechnungViewDocument Private ReadOnly _logger As Logger Private ReadOnly _logConfig As LogConfig Private ReadOnly _filesystem As FilesystemEx Private ReadOnly _file As ZUGFeRD.FileFunctions Private ReadOnly _gdpictureLicenseKey As String Private fontResName As String Private fontResNameBold As String Private fontResNameItalic As String Private MyGDPicturePDF As GdPicturePDF Public Sub New(LogConfig As LogConfig, MSSQL As MSSQLServer, GDPictureLicenseKey As String) _logConfig = LogConfig _logger = LogConfig.GetLogger() _filesystem = New FilesystemEx(_logConfig) _file = New ZUGFeRD.FileFunctions(LogConfig, MSSQL) _gdpictureLicenseKey = GDPictureLicenseKey End Sub Public Function Create_PDFfromXML(oxmlFile As FileInfo, pDTItemValues As DataTable) As FileInfo _logger.Debug("Create_PDFfromXML() Start") Try Dim oXRechnungFile = oxmlFile.FullName Dim oNewFileinfo As FileInfo Dim oxmlFilePath = oxmlFile.FullName Dim oViewRecieptFilename = oxmlFile.Name Dim oTempFilePath = Path.GetDirectoryName(oxmlFilePath) + "\Temp" If Not Directory.Exists(oTempFilePath) Then Directory.CreateDirectory(oTempFilePath) End If oTempFilePath = oTempFilePath + "\xrechnung.xml" If File.Exists(oTempFilePath) Then File.Delete(oTempFilePath) End If File.Move(oxmlFilePath, oTempFilePath) oxmlFile = New FileInfo(oTempFilePath) oViewRecieptFilename = oViewRecieptFilename.Replace("xml", "pdf") Dim oOutputPath = Path.GetDirectoryName(oxmlFilePath) + "\" + oViewRecieptFilename If File.Exists(oOutputPath) Then File.Delete(oOutputPath) End If MyGDPicturePDF = New GdPicturePDF() MyGDPicturePDF.NewPDF(PdfConformance.PDF_A_2a) Dim oPDFStatus As GdPictureStatus = MyGDPicturePDF.NewPDF() If oPDFStatus <> GdPictureStatus.OK Then _logger.Warn($"Error initializing PDF: {oPDFStatus}") Return Nothing End If MyGDPicturePDF.SetOrigin(PdfOrigin.PdfOriginTopLeft) MyGDPicturePDF.SetMeasurementUnit(PdfMeasurementUnit.PdfMeasurementUnitMillimeter) MyGDPicturePDF.SetLineWidth(1) fontResName = MyGDPicturePDF.AddStandardFont(PdfStandardFont.PdfStandardFontHelvetica) fontResNameBold = MyGDPicturePDF.AddStandardFont(PdfStandardFont.PdfStandardFontHelveticaBold) fontResNameItalic = MyGDPicturePDF.AddStandardFont(PdfStandardFont.PdfStandardFontHelveticaBoldOblique) MyGDPicturePDF.SetTitle("xInvoice VisualReceipt") MyGDPicturePDF.SetAuthor("Digital Data GmbH, Ludwig Rinn Str. 16, 35452 Heuchelheim") 'Create a New page MyGDPicturePDF.NewPage(PdfPageSizes.PdfPageSizeA4) ' Dim oCurrent As Integer = MyGDPicturePDF.GetCurrentPage() Dim yPosition As Single = Create_PageHeader(False) Create_PageFooter() Dim oArea As String = "" Dim oIsPosition As Boolean = False Dim oPosCount = 0 Dim oPosTerm As String = "" Dim oPosDesc As String = "" Dim oCurrencySymbol = "€" Dim oWidthLine = 200 yPosition += 5 Dim font As New Font("Helvetica", 10) Dim xRight As Integer = 100 Dim oIndex As Integer = 0 Dim oYPlus As Integer = 0 Dim oCreateTextBox As Boolean = False For Each oRow As DataRow In pDTItemValues.Rows Dim Y_eq_lastrow As Boolean = CBool(oRow.Item("Y_eq_lastrow")) Dim oRowCaption As String = oRow.Item("Row_Caption") Dim oItemSPECNAME As String = oRow.Item("SPEC_NAME") Dim oItemValue As String = oRow.Item("ITEM_VALUE") Dim oDisplay As Boolean = oRow.Item("Display") Dim oAreaSwitch As Boolean = False If oRow.Item("Area") = "INTERNAL" Then If oItemSPECNAME = "STATIC_Y_SWITCH" Then yPosition = oItemValue End If End If If yPosition >= 270 Then oPDFStatus = MyGDPicturePDF.NewPage(PdfPageSizes.PdfPageSizeA4) If oPDFStatus <> GdPictureStatus.OK Then _logger.Warn($"Could not create a second page. The error was: {oPDFStatus}") Exit For Else yPosition = Create_PageHeader(True) Create_PageFooter() End If 'oCurrent = MyGDPicturePDF.GetCurrentPage() End If If oRow.Item("Area") = "INTERNAL" Then _logger.Debug($"Next Item as Area is internal") Continue For End If _logger.Debug($"Working on SPEC_NAME: {oItemSPECNAME}") If oArea <> oRow.Item("Area") Then '########## AREA WECHSEL ########### oAreaSwitch = True oCreateTextBox = False oArea = oRow.Item("Area") _logger.Debug($"Area-Switch to: {oArea}") Dim oAREACaption As String If oArea = "TYPE" Then oAREACaption = $"{Return_InvType(oItemValue)} [{oItemValue}]" ElseIf oArea = "SELLER" Then oAREACaption = "Verkäufer / Seller:" ElseIf oArea = "BUYER" Then oAREACaption = "Käufer / Buyer:" ElseIf oArea = "POSITION" Then oAREACaption = "Positionen / Positions:" oIsPosition = True ElseIf oArea = "AMOUNT" Then oAREACaption = "Beträge / Amounts:" oCreateTextBox = True ElseIf oArea = "TAXPOS" Then oAREACaption = "Steuerbeträge / Tax amounts:" oIsPosition = True ElseIf oArea = "PAYMENT" Then oAREACaption = "Zahlungsinformationen / Payment details:" Else oAREACaption = String.Empty End If If Not oAREACaption = String.Empty Then 'erste Area-Linie yPosition += 5 MyGDPicturePDF.DrawLine(10, yPosition, oWidthLine, yPosition) 'gdpicturePDF.DrawText(fontResName, 10, yPosition, XRechnungStrings.Seperator_Line) yPosition += 5 'Area caption MyGDPicturePDF.DrawText(fontResNameBold, 10, yPosition, oAREACaption) yPosition += 5 If oArea = "TYPE" Then MyGDPicturePDF.DrawLine(10, yPosition, oWidthLine, yPosition) ' gdpicturePDF.DrawText(fontResName, 10, yPosition, XRechnungStrings.Seperator_Line) yPosition += 5 ElseIf oArea = "POSITION" Then 'Tabellendarstellung MyGDPicturePDF.DrawText(fontResName, 10, yPosition, "Pos#") MyGDPicturePDF.DrawText(fontResName, 19, yPosition, "Anz./am.") MyGDPicturePDF.DrawText(fontResName, 35, yPosition, "Einh/unt") MyGDPicturePDF.DrawText(fontResName, 50, yPosition, "Pos.Text") MyGDPicturePDF.DrawText(fontResName, 164, yPosition, "Steuer/tax") MyGDPicturePDF.DrawText(fontResName, 181, yPosition, "Betrag/sum") yPosition += 5 'Tabellendarstellung Ende End If End If If oArea = "TYPE" Then If oItemSPECNAME = "INVOICE_CURRENCY" Then If oItemValue <> "EUR" Then oCurrencySymbol = oItemValue End If End If ElseIf oArea = "POSITION" Then oIsPosition = True If oItemSPECNAME = "INVOICE_POSITION_AMOUNT" Then oPosCount += 1 'oPosTerm = $"{oPosCount}. {oItemValue} * " 'oItemValue = oPosTerm 'Tabellendarstellung oPosTerm = "" MyGDPicturePDF.DrawText(fontResName, 10, yPosition, oPosCount) ' 'Dim otextBoxYPos As Integer = yPosition - 3.5 'MyGDPicturePDF.DrawTextBox(fontResName, 10, otextBoxYPos, 16, YCoo_TextBoxPlus5(otextBoxYPos), ' TextAlignment.TextAlignmentFar, TextAlignment.TextAlignmentNear, ' oPosCount) MyGDPicturePDF.DrawText(fontResName, 19, yPosition, oItemValue) 'Tabellendarstellung Ende oDisplay = False ' yPosition -= 5 End If ElseIf oArea = "TAXPOS" Then oIsPosition = True If oItemSPECNAME = "INVOICE_TAXPOS_RATE" Then oPosCount = 1 oPosTerm = $"{oItemValue} %:" oItemValue = oPosTerm oDisplay = False yPosition -= 5 End If End If Else 'INDIVIDUELLES VERHALTEN BEI Folge-ITEMS _logger.Debug($"FollowItem - Area: [{oArea}] - ItemSpecname: [{oItemSPECNAME}] - ItemValue: [{oItemValue}]") Dim otextBoxYPos As Integer If oArea = "POSITION" Then If oItemSPECNAME = "INVOICE_POSITION_AMOUNT" Then oPosCount += 1 oYPlus = 0 'Tabellendarstellung yPosition += 5 oPosTerm = "" MyGDPicturePDF.DrawText(fontResName, 10, yPosition, oPosCount) 'otextBoxYPos = yPosition - 3.5 'MyGDPicturePDF.DrawTextBox(fontResName, 10, otextBoxYPos, 16, YCoo_TextBoxPlus5(otextBoxYPos), ' TextAlignment.TextAlignmentFar, TextAlignment.TextAlignmentNear, ' oPosCount) MyGDPicturePDF.DrawText(fontResName, 19, yPosition, oItemValue) 'Tabellendarstellung Ende oDisplay = False ElseIf oItemSPECNAME = "INVOICE_POSITION_UNIT_TYPE" Then oYPlus = 0 Dim oUnit = Return_UnitType(oItemValue) MyGDPicturePDF.DrawText(fontResName, 35, yPosition, oUnit) oDisplay = False ElseIf oItemSPECNAME = "INVOICE_POSITION_ARTICLE" Then 'Tabellendarstellung oYPlus = 0 oPosDesc = "" oPosDesc = oItemValue Dim oYDyn As Integer = yPosition - 5 Dim oPartsNL As List(Of String) = StringFunctions.SplitTextByNewLine(oItemValue) For Each olinepart As String In oPartsNL Dim oParts As List(Of String) = StringFunctions.SplitText_Length(olinepart, 67) ' Durchlaufen der einzelnen Teile in einer Schleife For Each part As String In oParts oYDyn += 5 oYPlus += 5 MyGDPicturePDF.DrawText(fontResName, 50, oYDyn, part) Next Next 'Tabellendarstellung Ende ' oPosTerm += $" {oItemValue}" oDisplay = False ElseIf oItemSPECNAME = "INVOICE_POSITION_NOTE" Then 'Tabellendarstellung Dim cleanedText As String = RemoveNewlinesAndTabs(oItemValue) Dim oParts As List(Of String) = StringFunctions.SplitText_Length(cleanedText, 70) ' Durchlaufen der einzelnen Teile in einer Schleife Dim oYDyn As Integer = yPosition Dim oPartsNL As List(Of String) = StringFunctions.SplitTextByNewLine(oItemValue) For Each olinepart As String In oPartsNL Dim oPartsPN As List(Of String) = StringFunctions.SplitText_Length(olinepart, 70) ' Durchlaufen der einzelnen Teile in einer Schleife For Each part As String In oPartsPN oYDyn += 5 oYPlus += 5 MyGDPicturePDF.DrawText(fontResName, 50, oYDyn, part) Next Next 'oPosTerm += $" {oItemValue}" oDisplay = False ElseIf oItemSPECNAME = "INVOICE_TAXPOS_TAX_RATE" Or oItemSPECNAME = "INVOICE_TAXPOS_RATE" Then 'Tabellendarstellung MyGDPicturePDF.DrawText(fontResName, 164, yPosition, $"{oItemValue} %") 'Tabellendarstellung ENDE ' oPosTerm += $" - {oItemValue} %" oDisplay = False ElseIf oItemSPECNAME = "INVOICE_POSITION_TAX_AMOUNT" Then ' oPosTerm += $" - {oItemValue} {oCurrencySymbol}" 'Tabellendarstellung Dim oYPos = yPosition - 3.5 Dim TAXTERM = $"{oItemValue} {oCurrencySymbol}" MyGDPicturePDF.DrawTextBox(fontResName, 177, oYPos, 198, YCoo_TextBoxPlus5(oYPos), TextAlignment.TextAlignmentFar, TextAlignment.TextAlignmentNear, TAXTERM) ' MyGDPicturePDF.DrawText(fontResName, 180, yPosition, $"{oItemValue} {oCurrencySymbol}") 'Tabellendarstellung Ende End If oItemValue = oPosTerm ElseIf oArea = "HEAD" Then If oItemSPECNAME = "INVOICE_DATE" Or oItemSPECNAME = "INVOICE_SERVICE_DATE" Then Dim oDateString As String = oItemValue Dim oParsedDate As DateTime = DateTime.ParseExact(oDateString, "yyyyMMdd", System.Globalization.CultureInfo.InvariantCulture) oItemValue = oParsedDate.ToString("dd.MM.yyyy") End If ElseIf oArea = "TAXPOS" Then If oItemSPECNAME = "INVOICE_TAXPOS_RATE" Then oPosCount += 1 oPosTerm = $"{oItemValue} %:" oDisplay = False ElseIf oItemSPECNAME = "INVOICE_TAXPOS_AMOUNT" Then oPosTerm += $" {oItemValue} {oCurrencySymbol}" oDisplay = False ElseIf oItemSPECNAME = "INVOICE_TAXPOS_TYPE" Then oPosTerm += $" {oItemValue}" End If oItemValue = oPosTerm End If End If If oDisplay = True And Len(oItemValue) > 0 Then If Y_eq_lastrow = False And oAreaSwitch = False Then yPosition += 5 End If If oArea = "AMOUNT" Then If oItemSPECNAME = "INVOICE_TOTAL_TAX" Or oItemSPECNAME = "INVOICE_TOTAL_NET" Or oItemSPECNAME = "INVOICE_TOTAL_GROSS" Then oItemValue += $" {oCurrencySymbol}" End If End If If oRowCaption <> String.Empty Then 'Zuerst die RowCaption MyGDPicturePDF.DrawText(fontResName, 10, yPosition, oRowCaption) 'Dann den Wert If oCreateTextBox Then Dim otextBoxYPos = yPosition - 3 MyGDPicturePDF.DrawTextBox(fontResName, 70, otextBoxYPos, 90, YCoo_TextBoxPlus5(otextBoxYPos), TextAlignment.TextAlignmentFar, TextAlignment.TextAlignmentCenter, oItemValue) Else MyGDPicturePDF.DrawText(fontResName, 70, yPosition, oItemValue) End If Else If Y_eq_lastrow = True Then MyGDPicturePDF.DrawText(fontResName, oRow.Item("xPosition"), yPosition, oItemValue) Else If oItemValue.Length > 112 Then ' Liste zur Speicherung der Teilstrings Dim teilStrings As New List(Of String) ' Schleife, um den String in Teilstrings zu zerlegen For i As Integer = 0 To oItemValue.Length - 1 Step 112 ' Sicherstellen, dass wir nicht über die Länge des Strings hinausgehen Dim laenge As Integer = Math.Min(112, oItemValue.Length - i) Dim teilString As String = oItemValue.Substring(i, laenge) teilStrings.Add(teilString) Next ' Ausgabe der Teilstrings For Each teilString As String In teilStrings MyGDPicturePDF.DrawText(fontResName, 10, yPosition, teilString) yPosition += 5 Next Else MyGDPicturePDF.DrawText(fontResName, 10, yPosition, oItemValue) End If End If End If Else 'Tabellendarstellung If oItemSPECNAME = "INVOICE_POSITION_TAX_AMOUNT" And oYPlus > 0 Then yPosition += oYPlus - 5 End If 'Tabellendarstellung Ende End If oIndex += 1 Next Dim oeinv_Format As PdfInvoiceDataFormat = PdfInvoiceDataFormat.ZUGFeRD_2_0 MyGDPicturePDF.EmbedFile(oTempFilePath, "Rechnungsdaten im ZUGFeRD-XML-Format") 'Finalize And save the PDF oPDFStatus = MyGDPicturePDF.SaveToFile(oOutputPath) If oPDFStatus = GdPictureStatus.OK Then _logger.Info("PDF VisualReceipt generated successfully!") Else _logger.Warn($"Error generating PDF VisualReceipt: {oPDFStatus}") End If 'Release resources MyGDPicturePDF.CloseDocument() If oPDFStatus = GdPictureStatus.OK Then File.Delete(oXRechnungFile) oNewFileinfo = New FileInfo(oOutputPath) _logger.Debug("Create_PDFfromXML() End successfully") Return oNewFileinfo Else _logger.Debug("Create_PDFfromXML() Ends with nothing") Return Nothing End If Catch ex As Exception _logger.Error(ex) Return Nothing End Try End Function Private Function RemoveNewlinesAndTabs(ByVal text As String) As String Return text.Replace(vbCr, " - ").Replace(vbLf, "").Replace(vbTab, " ") End Function Private Function YCoo_TextBoxMinus5(yPosition As Integer) Return yPosition - 5 End Function Private Function YCoo_TextBoxPlus5(yPosition As Integer) Return yPosition + 5 End Function Function SplitTextByNewLine(text As String) As List(Of String) If String.IsNullOrEmpty(text) Then Return New List(Of String)() End If ' Zerlege den Text anhand von Zeilenumbrüchen Dim lines As List(Of String) = text.Split({vbCrLf, vbLf, vbCr}, StringSplitOptions.None).ToList() Return lines End Function Public Function Create_PageHeader(pFollowPage As Boolean) As Integer 'Draw content on the PDF Dim yPosition As Integer = 15 MyGDPicturePDF.SetTextSize(18) MyGDPicturePDF.DrawText(fontResName, 10, yPosition, "xRechnung Sichtbeleg - xInvoice Visual Receipt") yPosition += 10 MyGDPicturePDF.SetTextSize(10) MyGDPicturePDF.DrawText(fontResNameItalic, 10, yPosition, XRechnungStrings.CommentSichtbeleg_DE_Row1) yPosition += 5 MyGDPicturePDF.DrawText(fontResNameItalic, 10, yPosition, XRechnungStrings.CommentSichtbeleg_DE_Row2) yPosition += 5 MyGDPicturePDF.DrawText(fontResNameItalic, 10, yPosition, XRechnungStrings.CommentSichtbeleg_EN_Row1) yPosition += 5 MyGDPicturePDF.DrawText(fontResNameItalic, 10, yPosition, XRechnungStrings.CommentSichtbeleg_EN_Row2) Return yPosition End Function Public Sub Create_PageFooter() MyGDPicturePDF.DrawLine(10, 280, 200, 280) Dim oCreatedString = $"Maschinell erstellt durch / Automatically created by Digital Data E-Rechnung Parser: {Now.ToString}" MyGDPicturePDF.DrawText(fontResName, 10, 285, oCreatedString) End Sub Private Function Return_InvType(pType As String) As String Dim oReturn As String = "Rechnung/invoice" If pType = "380" Then oReturn = "Handelsrechnung/Commercial invoice" ElseIf pType = "381" Then oReturn = "Gutschriftanzeige/Credit advice" ElseIf pType = "384" Then oReturn = "Rechnungskorrektur/Invoice correction" ElseIf pType = "386" Then oReturn = "Vorauszahlungsrechnung/Prepayment invoice" ElseIf pType = "326" Then oReturn = "Teilrechnung/Partial invoice" ElseIf pType = "84" Then oReturn = "Gutschrift/Credit note" ElseIf pType = "389" Then oReturn = "Gutschriftsverfahren/Credit note procedure" End If Return oReturn End Function Private Function Return_UnitType(pType As String) As String Dim oReturn As String = "Stück/pc" If pType = "C62" Then oReturn = "Stück/pc" ElseIf pType = "DAY" Then oReturn = "Tag/day" ElseIf pType = "HAR" Then oReturn = "Hek/hec" ElseIf pType = "HUR" Then oReturn = "h" ElseIf pType = "KGM" Then oReturn = "kg" ElseIf pType = "KTM" Then oReturn = "km" ElseIf pType = "KWH" Then oReturn = pType ElseIf pType = "LS" Then oReturn = "pausch/flat" ElseIf pType = "MIN" Then oReturn = "minute" ElseIf pType = "MTK" Then oReturn = "QM/SM" ElseIf pType = "Kubik/CM" Then oReturn = "MTR" ElseIf pType = "Meter" Then oReturn = "minute" ElseIf pType = "P1" Then oReturn = "%" ElseIf pType = "SET" Then oReturn = "Set" ElseIf pType = "TNE" Then oReturn = "Tonne/ton" ElseIf pType = "WEE" Then oReturn = "Woche/week" End If Return oReturn End Function End Class