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