OnDoc/vbBarcodes/Class1.vb

Imports System.Data.SqlTypes
Imports Microsoft.Office.Interop.Word
Imports Model
Imports System.Drawing
Imports Database
Imports System.Runtime.CompilerServices
Imports System.Net

Public Class vbarcodes

    Private WithEvents objWord As Microsoft.Office.Interop.Word.Application
    Private WithEvents docWord As Microsoft.Office.Interop.Word.Document

    Dim Textboxes(100) As String
    Dim Textboxesi As Integer
    Dim Public_barcodeleft As Integer
    Dim Public_barcodetop As Integer
    Dim Public_barcodewidth As Integer
    Dim Public_barcodeheight As Integer
    Dim docdata As New clsDocData
    Dim connectionstring As String = ""
    Dim Temppath As String = ""
    Public Function GenerateBarcodes(ByRef word As Microsoft.Office.Interop.Word.Application, ByRef ddata As clsDocData, connectionstring As String, temppath As String)
        Logging.Logging.Debug("Generate Barcodes Start", "vbBarcodes", docdata.Dokumentid)
        Public_barcodeleft = ddata.barcode_left
        Public_barcodetop = ddata.barcode_top
        Public_barcodewidth = ddata.barcode_width
        Public_barcodeheight = ddata.barcode_height
        Me.Temppath = temppath
        docdata = ddata
        docWord = word.ActiveDocument
        objWord = word
        objWord.WindowState = WdWindowState.wdWindowStateMinimize
        objWord.Visible = True

        Me.connectionstring = connectionstring
        Logging.Logging.Debug("Delete Textfelder", "vbBarcodes", docdata.Dokumentid)
        delete_Textfelder()
        Logging.Logging.Debug("Insert Textfelder", "vbBarcodes", docdata.Dokumentid)
        Insert_TextFelder()
        Logging.Logging.Debug("Ins Barcode", "vbBarcodes", docdata.Dokumentid)
        ins_Barcode()
        objWord.Visible = False
        objWord.WindowState = WdWindowState.wdWindowStateNormal

    End Function

    Public Shared Function ScaleImage(ByVal image As Image, ByVal height As Integer) As Image
        Dim ratio As Double = height / image.Height
        Dim newWidth = CInt(image.Width * ratio)
        Dim newHeight = CInt(image.Height * ratio)
        Dim newImage As Bitmap = New Bitmap(newWidth, newHeight)
        Using g As Graphics = Graphics.FromImage(newImage)
            g.DrawImage(image, 0, 0, newWidth, newHeight)
        End Using
        image.Dispose()
        Return newImage
    End Function


    Dim BarcodeBeschriftung As String = ""
    Dim BarcodeContent As String = ""
    Dim Kantenlaenge As String = ""
    Dim BarcodeFormatn As String = ""
    Dim barcodeImage2of5 As System.Drawing.Image
    Private Sub ins_Barcode()
        Dim Barcode2of5 As New BarcodeLib.clsBarI25()
        'barcodeImage2of5 = Barcode2of5.GetBarI25(Color.Black, Color.White, docdata.Dokumentid.Substring(6, 16), "Bar 25i c HR", 36, 350, 50, " U", "Futur Book", 8, 0)
        'barcodeImage2of5.Save(Temppath + "a_" + docdata.Dokumentid + ".png", System.Drawing.Imaging.ImageFormat.Png)
        'barcodeImage2of5 = Barcode.Get_LinerBarcode(Barcoded.Symbology.I2of5, docdata.Dokumentid.Substring(6, 16), docdata.Dokumentid.Substring(6, 16) + docdata.barcode_zusatz, docdata.barcode_textposition, docdata.Zusatz_Font, Convert.ToInt32(docdata.Zusatz_FontSize), 0)
        'barcodeImage2of5 = ScaleImage(barcodeImage2of5,
        '                              30)
        'barcodeImage2of5.Save(Temppath + "a_" + docdata.Dokumentid + ".png", System.Drawing.Imaging.ImageFormat.Png)


        BarcodeFormatn = docdata.barcode_formatn
        BarcodeBeschriftung = docdata.barcode_text
        Kantenlaenge = docdata.barcode_kantenlaenge
        BarcodeContent = docdata.barcode_content
        Logging.Logging.Debug("Start Barcode-Generierung", "vbbarcodes", docdata.Dokumentid)
        If docdata.barcode_type <> 0 Then
            datamatrix_generator()
        End If



        Dim xname As String
        Dim i As Integer
        Dim pages As Long
        Dim prop As Object
        Try
            For Each prop In objWord.ActiveDocument.BuiltInDocumentProperties
                If UCase(prop.Name) = "NUMBER OF PAGES" Then
                    pages = prop.value
                End If
            Next
        Catch ex As Exception
            For Each prop In objWord.ActiveDocument.BuiltInDocumentProperties
                If UCase(prop.Name) = "NUMBER OF PAGES" Then
                    pages = prop.value
                End If
            Next
        End Try



        objWord.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdStory)
        Textboxesi = 1
        For i = 1 To pages
            xname = Str(i)
            If Left(xname, 1) = " " Then xname = Right(xname, Len(xname) - 1)
            objWord.Selection.GoTo(What:=Microsoft.Office.Interop.Word.WdGoToItem.wdGoToPage, Name:=xname)
            HeaderFooterAnzeigen()
            insert_Barcode(i)
            Textboxesi = Textboxesi + 1
            objWord.ActiveWindow.ActivePane.View.SeekView = Microsoft.Office.Interop.Word.WdSeekView.wdSeekMainDocument
        Next i
        If docdata.barcode_type <> 0 Then
            System.IO.File.Delete(Temppath + "\a_" + docdata.Dokumentid.ToString + ".png")
        End If
    End Sub
    Sub Insert_Datamatrix()
        Dim Form
        Dim strsel As String
        Dim strresult
        Dim s As String
        Dim dmposition As Integer
        ' Selection.ShapeRange.Select

        Try
            Form = objWord.Selection.HeaderFooter.Shapes.Item(Textboxes(Textboxesi))
            Form.Select()
            Form = objWord.Selection.HeaderFooter.Shapes.Item(Textboxes(Textboxesi))
            Form.Select()
            objWord.Selection.TypeText(Text:="")
            Dim Zeichen As String
            Zeichen = " U"
            Select Case BarcodeFormatn
                Case 0
                    objWord.Selection.ParagraphFormat.Alignment = Microsoft.Office.Interop.Word.WdParagraphAlignment.wdAlignParagraphRight
                    objWord.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdLine, Extend:=Microsoft.Office.Interop.Word.WdMovementType.wdExtend)
                    objWord.Selection.Delete(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdCharacter, Count:=1)
                    objWord.Selection.InlineShapes.AddPicture(Temppath + "\a_" + docdata.Dokumentid.ToString + ".png", LinkToFile:=False, SaveWithDocument:=True)
                Case 1
                    objWord.Selection.ParagraphFormat.Alignment = Microsoft.Office.Interop.Word.WdParagraphAlignment.wdAlignParagraphLeft
                    objWord.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdLine, Extend:=Microsoft.Office.Interop.Word.WdMovementType.wdExtend)
                    objWord.Selection.Delete(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdCharacter, Count:=1)
                    objWord.Selection.InlineShapes.AddPicture(Temppath + "\a_" + docdata.Dokumentid.ToString + ".png", LinkToFile:=False, SaveWithDocument:=True)
                Case 2
                    objWord.Selection.ParagraphFormat.Alignment = Microsoft.Office.Interop.Word.WdParagraphAlignment.wdAlignParagraphLeft
                    objWord.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdLine, Extend:=Microsoft.Office.Interop.Word.WdMovementType.wdExtend)
                    objWord.Selection.Delete(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdCharacter, Count:=1)
                    objWord.Selection.InlineShapes.AddPicture(Temppath + "\a_" + docdata.Dokumentid.ToString + ".png", LinkToFile:=False, SaveWithDocument:=True)
                Case 3
                    objWord.Selection.ParagraphFormat.Alignment = Microsoft.Office.Interop.Word.WdParagraphAlignment.wdAlignParagraphLeft
                    objWord.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdLine, Extend:=Microsoft.Office.Interop.Word.WdMovementType.wdExtend)
                    objWord.Selection.Delete(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdCharacter, Count:=1)
                    objWord.Selection.InlineShapes.AddPicture(Temppath + "\a_" + docdata.Dokumentid.ToString + ".png", LinkToFile:=False, SaveWithDocument:=True)

            End Select
            Form = Nothing

            Exit Sub
        Catch ex As Exception
        End Try
    End Sub
    Private Sub insert_Barcode(ByVal x As Integer)
        If docdata.barcode_type <> 0 Then
            Insert_Datamatrix()
            Exit Sub
        End If


        Dim Form
        Dim strsel As String
        Dim strresult
        Dim s As String
        ' Selection.ShapeRange.Select




        Try
            Form = objWord.Selection.HeaderFooter.Shapes.Item(Textboxes(Textboxesi))
            Form.Select()
            Form = objWord.Selection.HeaderFooter.Shapes.Item(Textboxes(Textboxesi))
            Form.Select()

            'objWord.Selection.ParagraphFormat.Alignment = Microsoft.Office.Interop.Word.WdParagraphAlignment.wdAlignParagraphLeft
            'objWord.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdLine, Extend:=Microsoft.Office.Interop.Word.WdMovementType.wdExtend)
            'objWord.Selection.Delete(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdCharacter, Count:=1)
            'objWord.Selection.InlineShapes.AddPicture(Temppath + "\a_" + docdata.Dokumentid.ToString + ".png", LinkToFile:=False, SaveWithDocument:=True)
            'Form = Nothing
            'Return


            If docdata.barcode_horizontal = False Then
                objWord.ActiveDocument.Tables.Add(Range:=objWord.Selection.Range, NumRows:=1, NumColumns:=1)
                With objWord.Selection.Tables.Item(1)
                    .Borders.Item(Microsoft.Office.Interop.Word.WdBorderType.wdBorderLeft).LineStyle = Microsoft.Office.Interop.Word.WdLineStyle.wdLineStyleNone
                    .Borders.Item(Microsoft.Office.Interop.Word.WdBorderType.wdBorderRight).LineStyle = Microsoft.Office.Interop.Word.WdLineStyle.wdLineStyleNone
                    .Borders.Item(Microsoft.Office.Interop.Word.WdBorderType.wdBorderTop).LineStyle = Microsoft.Office.Interop.Word.WdLineStyle.wdLineStyleNone
                    .Borders.Item(Microsoft.Office.Interop.Word.WdBorderType.wdBorderBottom).LineStyle = Microsoft.Office.Interop.Word.WdLineStyle.wdLineStyleNone
                    .Borders.Item(Microsoft.Office.Interop.Word.WdBorderType.wdBorderDiagonalDown).LineStyle = Microsoft.Office.Interop.Word.WdLineStyle.wdLineStyleNone
                    .Borders.Item(Microsoft.Office.Interop.Word.WdBorderType.wdBorderDiagonalUp).LineStyle = Microsoft.Office.Interop.Word.WdLineStyle.wdLineStyleNone
                    .Borders.Shadow = False
                End With
                objWord.Selection.Orientation = Microsoft.Office.Interop.Word.WdTextOrientation.wdTextOrientationUpward
                objWord.Selection.Tables.Item(1).Rows.HeightRule = Microsoft.Office.Interop.Word.WdRowHeightRule.wdRowHeightAtLeast
                objWord.Selection.Tables.Item(1).Rows.Height = Form.height
            End If

            Dim id As String
            'erneurung DMS
            id = docdata.Dokumentid
            ''Barcode-Generierung




            s = Bar25I(Microsoft.VisualBasic.Right(Right(id, Len(id) - 6), 16))
            objWord.Selection.TypeText(Text:=s)
            objWord.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdLine, Extend:=Microsoft.Office.Interop.Word.WdMovementType.wdExtend)
            objWord.Selection.Font.Name = docdata.barcode_font
            objWord.Selection.Font.Size = docdata.barcode_fontsize
            objWord.Selection.ParagraphFormat.Alignment = Microsoft.Office.Interop.Word.WdParagraphAlignment.wdAlignParagraphRight
            objWord.Selection.EndKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdLine)
            objWord.Selection.Font.Name = "Arial"
            objWord.Selection.Font.Size = 8

            Dim Zeichen As String = docdata.barcode_zusatz
            objWord.Selection.TypeText(Zeichen)
            Form = Nothing
        Catch ex As Exception
        End Try

    End Sub

    Private BarTextOut As String
    Private BarTextIn As String
    Private DoCheckSum As Integer
    Private TempString As String
    Private CharValue As Long
    Private II As Integer
    Private Sum As Long
    Private barcodeout
    Private CheckSum As Integer
    Public Function Bar25I(ByVal BarTextIn As String) As String


        ' Initialize input and output strings
        BarTextOut = ""
        BarTextIn = RTrim(LTrim(BarTextIn))

        ' Throw away non-numeric data
        TempString = ""
        For II = 1 To Len(BarTextIn)
            If IsNumeric(Mid(BarTextIn, II, 1)) Then
                TempString = TempString & Mid(BarTextIn, II, 1)
            End If
        Next II

        ' If not an even number of digits, add a leading 0
        If (Len(TempString) Mod 2) = 1 Then
            TempString = "0" & TempString
        End If

        ' Break digit pairs up and convert to characters- build output string
        For II = 1 To Len(TempString) Step 2
            'Break string into pairs of digits and get value
            CharValue = Mid(TempString, II, 2)
            'translate value to ASCII and save in BarTextOut
            If CharValue < 90 Then
                BarTextOut = BarTextOut & Chr(CharValue + 33)
            Else
                BarTextOut = BarTextOut & Chr(CharValue + 71)
            End If
        Next II

        'Build ouput string, trailing space for Windows rasterization bug
        barcodeout = "{" & BarTextOut & "} "

        'Return the string
        Bar25I = barcodeout


    End Function
    Private Sub delete_Textfelder()

        Dim xname As String
        Dim i As Integer
        Dim i1 As Integer
        Dim pages As Long
        Dim Prop As Object
        objWord.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdStory)

        For Each Prop In objWord.ActiveDocument.BuiltInDocumentProperties
            If UCase(Prop.Name) = "NUMBER OF PAGES" Then
                pages = Prop.value
            End If
        Next
        For i = 1 To pages
            xname = Str(i)
            If Left(xname, 1) = " " Then xname = Right(xname, Len(xname) - 1)
            objWord.Selection.GoTo(What:=Microsoft.Office.Interop.Word.WdGoToItem.wdGoToPage, Name:=xname)
            HeaderFooterAnzeigen()
            While objWord.Selection.HeaderFooter.Shapes.Count > 0
                objWord.Selection.HeaderFooter.Shapes.Item(1).Delete()
            End While
            '            On Error GoTo eh
            '           '            Resume Next
            '          For i1 = 1 To objword.Selection.HeaderFooter.Shapes.Count
            '             objword.Selection.HeaderFooter.Shapes.Item(i1).Delete()
            '        Next i1
            '       On Error GoTo 0
            objWord.ActiveWindow.ActivePane.View.SeekView = Microsoft.Office.Interop.Word.WdSeekView.wdSeekMainDocument
        Next i

        Exit Sub
eh:

        'MsgBox(Err.Description)
        Resume Next
    End Sub

    Private Sub Insert_TextFelder()

        Dim xname As String
        Dim i As Integer
        Dim pages As Long
        Dim prop As Object
        For Each prop In objWord.ActiveDocument.BuiltInDocumentProperties
            If UCase(prop.Name) = "NUMBER OF PAGES" Then
                pages = prop.value
            End If
        Next
        Textboxesi = 1
        objWord.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdStory)
        For i = 1 To pages
            xname = Str(i)
            If Left(xname, 1) = " " Then xname = Right(xname, Len(xname) - 1)
            objWord.Selection.GoTo(What:=Microsoft.Office.Interop.Word.WdGoToItem.wdGoToPage, Name:=xname)
            insert_Textfield()
            objWord.ActiveWindow.ActivePane.View.SeekView = Microsoft.Office.Interop.Word.WdSeekView.wdSeekMainDocument
        Next i

    End Sub

    Private Sub HeaderFooterAnzeigen()

        If objWord.ActiveWindow.View.SplitSpecial <> Microsoft.Office.Interop.Word.WdSpecialPane.wdPaneNone Then
            objWord.ActiveWindow.Panes.Item(2).Close()
        End If
        If objWord.ActiveWindow.ActivePane.View.Type = Microsoft.Office.Interop.Word.WdViewType.wdNormalView Or objWord.ActiveWindow.ActivePane.View.Type = Microsoft.Office.Interop.Word.WdViewType.wdOutlineView Then
            objWord.ActiveWindow.ActivePane.View.Type = Microsoft.Office.Interop.Word.WdViewType.wdPrintView
        End If
        objWord.ActiveWindow.ActivePane.View.SeekView = Microsoft.Office.Interop.Word.WdSeekView.wdSeekCurrentPageHeader
        If objWord.Selection.HeaderFooter.IsHeader = True Then
            objWord.ActiveWindow.ActivePane.View.SeekView = Microsoft.Office.Interop.Word.WdSeekView.wdSeekCurrentPageFooter
        Else
            objWord.ActiveWindow.ActivePane.View.SeekView = Microsoft.Office.Interop.Word.WdSeekView.wdSeekCurrentPageHeader
        End If

    End Sub



    Private Sub insert_Textfield()

        Try



            HeaderFooterAnzeigen()
            objWord.Selection.HeaderFooter.Shapes.AddTextbox(1, Public_barcodeleft, Public_barcodetop,
                Public_barcodewidth#, Public_barcodeheight).Select()
            '  objword.Selection.ShapeRange.TextFrame.TextRange.Select
            objWord.Selection.ShapeRange.Line.Visible = Microsoft.Office.Core.MsoTriState.msoFalse
            'objword.Selection.ShapeRange.Line.Visible = Microsoft.Office.Core.MsoTriState.msoFalse 'RS:2006-08-22
            objWord.Selection.ShapeRange.TextFrame.MarginLeft = 0.0#
            objWord.Selection.ShapeRange.TextFrame.MarginRight = 0.0#
            objWord.Selection.ShapeRange.TextFrame.MarginTop = 0.0#
            objWord.Selection.ShapeRange.TextFrame.MarginBottom = 0.0#
            objWord.Selection.Collapse()
            Textboxes(Textboxesi) = objWord.Selection.HeaderFooter.Shapes.Item(Textboxesi).Name
            Textboxesi = Textboxesi + 1
            'System.Windows.Forms.Application.DoEvents()
            Exit Sub

        Catch ex As Exception
            'MsgBox(ex.Message)
        End Try

    End Sub


    Sub datamatrix_generator()
        Dim zeichen As String = docdata.barcode_zusatz
        Me.BarcodeBeschriftung = Me.BarcodeBeschriftung + zeichen
        Me.Generage_BarcodeImage()
    End Sub

    Dim ObjPointMinus As Integer = 0
    Sub Generage_BarcodeImage()
        Dim FontColor As Color = Color.Black
        Dim BackColor As Color = Color.White
        Dim FontName As String = docdata.Zusatz_Font
        Dim FontSize As Integer = docdata.Zusatz_FontSize
        Dim Height As Integer = 0
        Dim Width As Integer = 0
        Logging.Logging.Debug(FontName + FontSize.ToString(), "vbbarcodes", docdata.Dokumentid)
        Dim objFont As New Drawing.Font(FontName, FontSize)
        Dim image1bmp As New Bitmap(400, 400)
        Dim image1 As Bitmap = Datamatrix_Generator_1(Height, Width)
        Dim objFontsize As Graphics = Graphics.FromImage(image1bmp)
        Dim sf = objFontsize.MeasureString(BarcodeBeschriftung, objFont)
        Select Case BarcodeFormatn
            Case 0, 2
                If image1.Width < 70 Then Width = sf.Width + 10 + image1.Width Else Width = image1.Width * 3
            Case 1, 3
                If image1.Width < 70 Then Width = sf.Width + 10 + image1.Width Else Width = image1.Width * 3
            Case 22
                If image1.Height < 70 Then Height = sf.Height + 10 + image1.Height Else Height = image1.Height * 3
            Case 33
                If image1.Height < 70 Then Height = sf.Height + 10 + image1.Height Else Height = image1.Height * 3
        End Select

        Dim objBitmap As New Bitmap(Width, Height)
        Dim objGraphics As Graphics = Graphics.FromImage(objBitmap)
        Dim objBrushForeColor As New SolidBrush(FontColor)
        Dim objBrushBackColor As New SolidBrush(BackColor)
        Dim objColor As Color

        Select Case BarcodeFormatn
            Case 0 'rechts
                Dim stringFormat As New StringFormat()
                stringFormat.Alignment = StringAlignment.Far
                stringFormat.LineAlignment = StringAlignment.Near
                objGraphics.FillRectangle(objBrushBackColor, 0, 0, Width, Height)
                Dim objPoint As New PointF(Width - image1.Width - 10, Height - sf.Height - ObjPointMinus)
                objGraphics.DrawString(BarcodeBeschriftung, objFont, objBrushForeColor, objPoint, stringFormat)
                objGraphics.DrawImage(image1, New Drawing.Point(Width - image1.Width, 0))
            Case 1 'links
                objGraphics.FillRectangle(objBrushBackColor, 0, 0, Width, Height)
                Dim objPoint As New PointF(image1.Width + 10, Height - sf.Height - ObjPointMinus)
                objGraphics.DrawString(BarcodeBeschriftung, objFont, objBrushForeColor, objPoint)
                objGraphics.DrawImage(image1, New Drawing.Point(0, 0))
            Case 2 'links
                objGraphics.FillRectangle(objBrushBackColor, 0, 0, Width, Height)
                Dim objPoint As New PointF(image1.Width + 10, Height - sf.Height - ObjPointMinus)
                objGraphics.DrawString(BarcodeBeschriftung, objFont, objBrushForeColor, objPoint)
                objGraphics.DrawImage(image1, New Drawing.Point(0, 0))
                objBitmap.RotateFlip(RotateFlipType.Rotate90FlipNone)
            Case 3
                Dim stringFormat As New StringFormat()
                stringFormat.Alignment = StringAlignment.Far
                stringFormat.LineAlignment = StringAlignment.Near
                objGraphics.FillRectangle(objBrushBackColor, 0, 0, Width, Height)
                Dim objPoint As New PointF(Width - image1.Width - 10, Height - sf.Height - ObjPointMinus)
                objGraphics.DrawString(BarcodeBeschriftung, objFont, objBrushForeColor, objPoint, stringFormat)
                objGraphics.DrawImage(image1, New Drawing.Point(Width - image1.Width, 0))
                objBitmap.RotateFlip(RotateFlipType.Rotate90FlipNone)
            Case 3
        End Select
        image1 = Nothing
        objBitmap.Save(Temppath + "a_" + docdata.Dokumentid + ".png", System.Drawing.Imaging.ImageFormat.Png)
        objBitmap = Nothing

    End Sub
    Function Datamatrix_Generator_1(ByRef Height As Integer, ByRef width As Integer) As Image
        Dim DMNetCtrl As New MW6.SDK.DataMatrix.DataMatrixNet
        DMNetCtrl.Data = Me.barcodecontent
        Dim ActualRows As Integer
        Dim ActualCols As Integer
        Dim ActualWidth As Integer
        Dim ActualHeight As Integer
        Dim ExtraWidth As Integer = 0
        Dim ExtraHeight As Integer = 0
        Dim imgsize As Integer
        DMNetCtrl.GetActualRC(ActualRows, ActualCols)
        DMNetCtrl.GetActualSize(True, Nothing, ActualWidth, ActualHeight)
        DMNetCtrl.SetSize(ActualWidth + ExtraWidth, ActualHeight + ExtraHeight)
        Dim MS As System.IO.MemoryStream = New System.IO.MemoryStream
        DMNetCtrl.SaveAsMemory(MS, System.Drawing.Imaging.ImageFormat.Png)
        Dim img4 As Image
        img4 = System.Drawing.Image.FromStream(MS)
        If Me.Kantenlaenge = "" Then Me.Kantenlaenge = 2

        Try
            imgsize = Me.Kantenlaenge * 37.795275593333
        Catch
            imgsize = 1.5 * 37.795275593333
        End Try

        img4 = AutoSizeImage(img4, imgsize, imgsize, True)
        width = img4.Width
        Height = img4.Height
        MS.Close()
        Return img4



    End Function
    Public Function AutoSizeImage(ByVal oBitmap As Image,
ByVal maxWidth As Integer,
ByVal maxHeight As Integer,
Optional ByVal bStretch As Boolean = False) As Image

        ' Größenverhältnis der max. Dimension
        Dim maxRatio As Single = maxWidth / maxHeight

        ' Bildgröße und aktuelles Größenverhältnis
        Dim imgWidth As Integer = oBitmap.Width
        Dim imgHeight As Integer = oBitmap.Height
        Dim imgRatio As Single = imgWidth / imgHeight

        ' Bild anpassen?
        If (imgWidth > maxWidth Or imgHeight > maxHeight) Or (bStretch) Then
            If imgRatio <= maxRatio Then
                ' Größenverhältnis des Bildes ist kleiner als die
                ' maximale Größe, in der das Bild angezeigt werden kann.
                ' In diesem Fall muss die Bildbreite angepasst werden.
                imgWidth = imgWidth / (imgHeight / maxHeight)
                imgHeight = maxHeight
            Else
                ' Größenverhältnis des Bildes ist größer als die 
                ' maximale Größe, in der das Bild angezeigt werden kann.
                ' In diesem Fall muss die Bildhöhe angepasst werden.
                imgHeight = imgHeight / (imgWidth / maxWidth)
                imgWidth = maxWidth
            End If

            ' Bitmap-Objekt in der neuen Größe erstellen
            Dim oImage As New Bitmap(imgWidth, imgHeight)

            ' Bild interpolieren, damit die Qualität erhalten bleibt
            Using g As Graphics = Graphics.FromImage(oImage)
                g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
                g.DrawImage(oBitmap, New Drawing.Rectangle(0, 0, imgWidth, imgHeight))
            End Using

            ' neues Bitmap zurückgeben
            Return oImage
        Else
            ' unverändertes Originalbild zurückgeben
            Return oBitmap
        End If
    End Function
End Class