Imports SautinSoft.HtmlToRtf Imports System.IO Imports System.Data.SqlClient Imports System.Data.SqlTypes Imports C1.Win.C1TrueDBGrid Public Class frmAuspraegungstexte Dim themanr As Integer = 0 Dim rtffilename As String = "" Sub New() ' Dieser Aufruf ist für den Designer erforderlich. InitializeComponent() ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu. End Sub Sub New(ByVal themanr As Integer) InitializeComponent() Me.themanr = themanr End Sub Private Sub frmAuspraegungstexte_Load(sender As Object, e As EventArgs) Handles MyBase.Load Me.PnlAll.Visible = True Me.PnlAll.Dock = DockStyle.Fill Dim daten As New DataTable daten = Me.Get_Auspraegungen(Me.themanr) Dim h As New SautinSoft.HtmlToRtf Dim firstRtf As String = "" Dim Delimitter As String = "" Dim secondRtf As String = "" Dim singleRtf As String = "" singleRtf = ReadFromFile(Application.StartupPath + "\vorlagen\empty.rtf") Delimitter = ReadFromFile(Application.StartupPath + "\vorlagen\delimitter.rtf") For Each dr As DataRow In daten.Rows rtffilename = Globals.TmpFilepath + "\RTF_" + System.IO.Path.GetRandomFileName + ".rtf" Get_Dokument(rtffilename, dr.Item("Kommunikationauspraegungnr").ToString) secondRtf = ReadFromFile(rtffilename) singleRtf = h.MergeRtfString(singleRtf, secondRtf) singleRtf = h.MergeRtfString(singleRtf, Delimitter) System.IO.File.Delete(rtffilename) Next rtbDoc1.Rtf = singleRtf End Sub Public Function ReadFromFile(ByVal fileName As String) As String Dim fileString As String = "" Try Dim fs As System.IO.FileStream = New FileStream(fileName, FileMode.Open, FileAccess.Read, FileShare.Read) Dim b(CInt(Fix(fs.Length)) - 1) As Byte If fs.Read(b, 0, CInt(Fix(fs.Length))) > 0 Then Dim arCharRes(fs.Length - 1) As Char For i As Integer = 0 To fs.Length - 1 arCharRes(i) = ChrW(b(i)) Next i fileString = New String(arCharRes) End If fs.Close() Return fileString Catch Return "" End Try End Function Public Function Get_Auspraegungen(ByVal Kommunikationnr As Integer) As DataTable Dim Eintragsdaten As New DataTable Dim connection As New SqlConnection() Dim da As New SqlDataAdapter("", connection) Eintragsdaten.Rows.Clear() Dim sqlcmd As New SqlCommand sqlcmd.CommandText = "sp_get_Kommunikationauspraegung_mit_dokumenten" sqlcmd.Parameters.Add("@Kommunikationnr", SqlDbType.Int, 4) sqlcmd.Parameters(0).Value = Kommunikationnr sqlcmd.CommandType = CommandType.StoredProcedure sqlcmd.Connection = connection Try connection.ConnectionString = Globals.sConnectionString connection.Open() da.SelectCommand = sqlcmd da.Fill(Eintragsdaten) Catch ex As Exception Finally connection.Close() da.Dispose() sqlcmd.Dispose() End Try Return Eintragsdaten End Function Public Function Get_Dokument(ByVal Filename As String, ByVal nr As Integer) Try Dim connection As New SqlConnection() Dim da As New SqlDataAdapter("Select * From KommunkationAuspraegung where KommunikationAuspraegungNr=" + nr.ToString, connection) Dim CB As SqlCommandBuilder = New SqlCommandBuilder(da) Dim ds As New DataSet() Try connection.ConnectionString = Globals.sConnectionString connection.Open() da.Fill(ds, "Dokument") Dim myRow As DataRow myRow = ds.Tables(0).Rows(0) Dim MyData() As Byte MyData = myRow.Item(4) Dim K As Long K = UBound(MyData) Dim fs As New FileStream(Filename, FileMode.OpenOrCreate, FileAccess.Write) fs.Write(MyData, 0, K) fs.Close() fs = Nothing Catch ex As Exception 'MsgBox(ex.Message, MsgBoxStyle.Critical) Return "" Finally connection.Close() connection = Nothing End Try CB = Nothing ds = Nothing da = Nothing Return Filename Catch ex As Exception MsgBox(ex.Message) End Try End Function Private Sub tsbtnSaveAs_Click(sender As Object, e As EventArgs) Handles tsbtnSaveAs.Click SaveFileDialog1.Title = "RTE - Save File" SaveFileDialog1.DefaultExt = "rtf" SaveFileDialog1.Filter = "Rich Text Dateien|*.rtf|Text Dateien|*.txt|HTML Dateien|*.htm|Alle Dateien|*.*" SaveFileDialog1.FilterIndex = 1 SaveFileDialog1.ShowDialog() If SaveFileDialog1.FileName = "" Then Exit Sub Dim strExt As String strExt = System.IO.Path.GetExtension(SaveFileDialog1.FileName) strExt = strExt.ToUpper() Select Case strExt Case ".RTF" rtbdoc1.SaveFile(SaveFileDialog1.FileName, RichTextBoxStreamType.RichText) Case Else Dim txtWriter As System.IO.StreamWriter txtWriter = New System.IO.StreamWriter(SaveFileDialog1.FileName) txtWriter.Write(rtbdoc1.Text) txtWriter.Close() txtWriter = Nothing rtbdoc1.SelectionStart = 0 rtbdoc1.SelectionLength = 0 End Select rtbdoc1.Modified = False End Sub Private Sub tsbtnPageSetup_Click(sender As Object, e As EventArgs) Handles tsbtnPageSetup.Click PageSetupDialog1.Document = PrintDocument1 PageSetupDialog1.ShowDialog() End Sub Private Sub tsbtbPreview_Click(sender As Object, e As EventArgs) Handles tsbtbPreview.Click PrintPreviewDialog1.Document = Me.PrintDocument1 PrintPreviewDialog1.ShowDialog() End Sub Private Sub tsbtnprint_Click(sender As Object, e As EventArgs) Handles tsbtnprint.Click PrintDialog1.Document = PrintDocument1 If PrintDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then PrintDocument1.Print() End If End Sub #Region "Printing" Private checkPrint As Integer Private Sub PrintDocument1_BeginPrint(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintEventArgs) Handles PrintDocument1.BeginPrint ' Adapted from Microsoft's example for extended richtextbox control ' checkPrint = 0 End Sub Private Sub PrintDocument1_PrintPage(ByVal sender As Object, ByVal e As System.Drawing.Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage ' Adapted from Microsoft's example for extended richtextbox control ' ' Print the content of the RichTextBox. Store the last character printed. checkPrint = rtbdoc1.Print(checkPrint, rtbdoc1.TextLength, e) ' Look for more pages If checkPrint < rtbdoc1.TextLength Then e.HasMorePages = True Else e.HasMorePages = False End If End Sub #End Region Private Sub TSBtnQuit_Click(sender As Object, e As EventArgs) Handles TSBtnQuit.Click Me.Close() End Sub End Class