Resize Image ( Bilder verkleinern )

  • VB.NET
  • .NET (FX) 4.5–4.8

Es gibt 17 Antworten in diesem Thema. Der letzte Beitrag () ist von -Franky-.

    Resize Image ( Bilder verkleinern )

    Moin moin

    Hab mir noch ein kleines Tool gemacht. Es soll einen Text auf ein Bild schreiben usw...
    Das mit dem Text aufs Bild bringen und das erneute abspeichern der neuen jpg-Datei klappt.
    Was nicht klappt ist das verkleinern, da kommen seltsame Gebilde raus.

    Siehe Bildanhang.

    Die schwarze Fläche hat die Abmessungen die das Bild ergeben soll aber das eigentliche Bild wird naja seht mal....
    EDIT Nochmal umgebaut .... brachte aber auch keine Verbesserung außer das die schwarze Fläche nun komplett verzogen ist.
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Private Sub PutTextonImage()
    2. Directory.CreateDirectory(Sourcepath & "\Fertige")
    3. Dim Files As String() = IO.Directory.GetFiles(Sourcepath, "*.jpg")
    4. Targetpath = Sourcepath & "\Fertige\"
    5. Me.BeginInvoke(Sub() PB_ani.Visible = True)
    6. For Each File As String In Files
    7. Img = Image.FromFile(File)
    8. Dim ImgName As String = System.IO.Path.GetFileName(File)
    9. Dim newImage As New Bitmap(Img)
    10. Dim newText As Graphics = Graphics.FromImage(newImage)
    11. Dim drawBrush As SolidBrush = New SolidBrush(newColor)
    12. Dim drawFont As Font = New Font("Segoe UI", 9)
    13. Dim drawString As String = tb_signatur.Text & MyDatum
    14. newText.DrawString(drawString, drawFont, drawBrush, 10, 10)
    15. Dim newFile As String
    16. newFile = Targetpath & ImgName
    17. Threading.Thread.Sleep(500)
    18. Me.BeginInvoke(Sub() lstB_newpic.Items.Add(newFile))
    19. Me.BeginInvoke(Sub() lbl_datei.Text = "Verarbeite Datei: " & newFile)
    20. Dim scale_factor As Single = 0.6
    21. Dim smalImage As New Bitmap(Width, Height)
    22. Dim g As Graphics = Graphics.FromImage(smalImage)
    23. g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
    24. g.DrawImage(newImage, New Rectangle(0, 0, Width, Height), New Rectangle(0, 0, CInt(newImage.Width * scale_factor), CInt(newImage.Height * scale_factor)), GraphicsUnit.Pixel)
    25. g.Dispose()
    26. smalImage.Save(newFile, System.Drawing.Imaging.ImageFormat.Jpeg)
    27. newImage.Dispose()
    28. smalImage.Dispose()
    29. Next
    30. Me.BeginInvoke(Sub() PB_ani.Visible = False)
    31. End Sub



    *Topic verschoben*
    Bilder
    • 61N_0001.JPG

      153,95 kB, 600×899, 136 mal angesehen
    Asperger Autistin. Brauche immer etwas um gewisse Sachen zu verstehen. :huh:

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Marcus Gräfe“ ()

    Hi

    Wo kommen denn Width und Height für smalImage her? Hmm, Img = Image.FromFile(File) ist irgendwie überflüssig. Da kannst auch gleich Dim newImage As New Bitmap(File) nehmen. Du erstellst hier per Dim newText As Graphics ein Graphics, gibst dieses aber nicht frei (Dispose). Das ganze könnte etwas übersichtlicher werden wenn Du Using/End Using verwendest. Dann wäre evtl. zu überlegen ob man den Text nicht besser auf das skalierte Bitmap zeichnet anstatt auf newImage. So wird der Text ja mit runterskaliert.

    Edit: EDR war etwas schneller. ;)
    Mfg -Franky-
    @ErfinderDesRades & @-Franky-
    Moin moin
    Habe meinen Fehler gefunden. Hier ein Code der funktioniert.

    Mein Wunsch wäre es jetzt bei der Größe halt kein ScaleFactor einzusetzen sondern, egal ob Hochformat oder Querformat, die Längste Seite auf eine festgesetzte Größe zu skalieren.
    Da fehlt mir leider jeder Ansatz. Im Web gibt es echt nicht viel zu diesem Thema zu finden.
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Private Sub PutTextonImage()
    2. Directory.CreateDirectory(Sourcepath & "\Fertige")
    3. Dim Files As String() = IO.Directory.GetFiles(Sourcepath, "*.jpg")
    4. Targetpath = Sourcepath & "\Fertige\"
    5. Me.BeginInvoke(Sub() PB_ani.Visible = True)
    6. For Each File As String In Files
    7. Dim ImgName As String = System.IO.Path.GetFileName(File)
    8. Dim newImage As New Bitmap(File)
    9. '------
    10. Dim scalefactor As Single = 0.6
    11. Dim Width As Integer = CInt(newImage.Width * scalefactor)
    12. Dim Height As Integer = CInt(newImage.Height * scalefactor)
    13. Dim smalImage As New Bitmap(Width, Height)
    14. Dim g As Graphics = Graphics.FromImage(smalImage)
    15. g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
    16. g.DrawImage(newImage, New Rectangle(0, 0, Width, Height), New Rectangle(0, 0, newImage.Width, newImage.Height), GraphicsUnit.Pixel)
    17. g.Dispose()
    18. Dim newText As Graphics = Graphics.FromImage(smalImage)
    19. Dim drawBrush As SolidBrush = New SolidBrush(newColor)
    20. Dim drawFont As Font = New Font("Segoe UI", newSize)
    21. Dim drawString As String = tb_signatur.Text & "-" & MyDatum
    22. newText.DrawString(drawString, drawFont, drawBrush, 10, 10)
    23. Dim newFile As String
    24. newFile = Targetpath & ImgName
    25. Threading.Thread.Sleep(200)
    26. Me.BeginInvoke(Sub() lstB_newpic.Items.Add(newFile))
    27. Me.BeginInvoke(Sub() lbl_datei.Text = "Verarbeite Datei: " & newFile)
    28. smalImage.Save(newFile, System.Drawing.Imaging.ImageFormat.Jpeg)
    29. newImage.Dispose()
    30. smalImage.Dispose()
    31. Next
    32. Me.BeginInvoke(Sub() PB_ani.Visible = False)
    33. End Sub

    Asperger Autistin. Brauche immer etwas um gewisse Sachen zu verstehen. :huh:
    Also wenn ich dich richtig verstehe, möchtest du, dass ein Bild, egal welche Größe es auch hat, immer auf eine bestimmte, festgesetzte Größe skaliert wird.

    Wenn das soweit die zutrifft, dann kannst du ja deine gewünschte "maximale Größe" festlegen.
    Nun kannst du schauen, welche der beiden Seiten der Bilder größer ist und diesen Wert speichern:

    sowas wie: wenn laenge > breite -> laengsteSeite = laenge - ansonsten: laengsteSeite= breite.

    Nun kannst du ja das Verhältnis ausrechnen, das du brauchst, um die Skalierung durchzuführen:

    SkalierungsFaktor = festgesetzteGröße / maximaleGroesse

    Und nun kannst du laenge und breite mit dem Skalierungsfaktor multiplizieren und weißt, welche Größe dein New Bitmap haben müsste. So ist immer die längste Seite berücksichtigt und wird anhand derer das auf die richtige, maximale Größe gestreckt oder gestaucht
    @PadreSperanza

    Erstmal danke für die Tips. Soweit bin ich nun.
    Bei Return kommt ein Fehler und wie berechne ich nun die 2te Seite?

    VB.NET-Quellcode

    1. Public Function ImgScalefaktor(ByVal newImage As Image) As Image
    2. Dim Width As Single = newImage.Width
    3. Dim Height As Single = newImage.Height
    4. Dim longsize As Single
    5. Dim shortsize As Single
    6. If Width > Height Then
    7. longsize = Width
    8. Else
    9. longsize = Height
    10. End If
    11. Dim newlongsize As Single
    12. newlongsize = 1000
    13. scalefactor = newlongsize / longsize
    14. Return scalefactor ' Hier müsste ich ja ein Bitmap zurückgeben???
    15. End Function


    ÄNDERUNG

    VB.NET-Quellcode

    1. Width = newlongsize / longsize
    2. Height = '????
    3. Dim smalImage As New Bitmap(Width, Height)
    4. Return smalImage
    Asperger Autistin. Brauche immer etwas um gewisse Sachen zu verstehen. :huh:

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Amelie“ ()

    VB.NET-Quellcode

    1. ​Public Function PicResizeByWidth(SourceImage As String, NewWidth As Integer) As Bitmap
    2. Dim InputBitmap As New Bitmap(SourceImage)
    3. Dim SizeFactor As Decimal = CDec(NewWidth / InputBitmap.Width)
    4. Dim NewHeigth As Integer = CInt(SizeFactor * InputBitmap.Height)
    5. Dim OutputBitmap As New Bitmap(Image.FromFile(SourceImage), NewWidth, NewHeigth)
    6. PicResizeByWidth = OutputBitmap
    7. InputBitmap.Dispose()
    8. OutputBitmap.Dispose()
    9. End Function
    Also ich habe nun mal etwas gemacht, hatte den Beitrag von @Morrison aber noch nicht gesehen und zugegeben wüste ich jetzt auch nicht wie ich das in meinen ersten Code einbauen sollte.

    Zu meinem Code. Bilder werden zwar verkleinert und Text kommt auch wieder drauf ABER.
    Aus Bildern 6016*4016 sowohl Hochformat als auch Querformat werden Bilder in: 722*384 aber immer nur Querformat. Siehe Bild
    Irgendwo herhaspel ich mich..

    Spoiler anzeigen

    VB.NET-Quellcode

    1. Public Function ImgScale(ByVal newImage As String) As Bitmap
    2. Dim newBitmap As New Bitmap(newImage)
    3. Dim Width As Integer = newBitmap.Width
    4. Dim Height As Integer = newBitmap.Height
    5. Dim longsize As Integer
    6. Dim shortsize As Integer
    7. Dim newWidth As Integer
    8. Dim newHeight As Integer
    9. If Width > Height Then
    10. longsize = Width
    11. shortsize = Height
    12. Else
    13. longsize = Height
    14. shortsize = Width
    15. End If
    16. Dim newlongsize As Integer = 1000
    17. Dim ScaleFactor As Decimal = CDec(newlongsize / longsize)
    18. Dim newshortsize As Integer = CInt(ScaleFactor * shortsize)
    19. If Width > Height Then
    20. newWidth = newlongsize
    21. newHeight = newshortsize
    22. Else
    23. newWidth = newshortsize
    24. newHeight = newlongsize
    25. End If
    26. ' Bis hier hin sind die neuen Abmessungen korrekt.
    27. ' Habe ich mir anzeigen lassen.
    28. Dim smalImage As New Bitmap(Image.FromFile(newImage), newWidth, newHeight)
    29. Return smalImage
    30. End Function
    31. Private Sub PutTextonImage()
    32. Directory.CreateDirectory(Sourcepath & "\Fertige")
    33. Dim Files As String() = IO.Directory.GetFiles(Sourcepath, "*.jpg")
    34. Targetpath = Sourcepath & "\Fertige\"
    35. Me.BeginInvoke(Sub() PB_ani.Visible = True)
    36. For Each File As String In Files
    37. Dim ImgName As String = System.IO.Path.GetFileName(File)
    38. ' zur Funktion umrechen
    39. ImgScale(File)
    40. Dim newImage As New Bitmap(File)
    41. Dim smalImage As New Bitmap(Width, Height)
    42. Dim g As Graphics = Graphics.FromImage(smalImage)
    43. g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
    44. g.DrawImage(newImage, New Rectangle(0, 0, Width, Height), New Rectangle(0, 0, newImage.Width, newImage.Height), GraphicsUnit.Pixel)
    45. g.Dispose()
    46. ' Text aufs neue Bild
    47. Dim newText As Graphics = Graphics.FromImage(smalImage)
    48. Dim drawBrush As SolidBrush = New SolidBrush(newColor)
    49. Dim drawFont As Font = New Font("Segoe UI", newSize)
    50. Dim drawString As String = tb_signatur.Text & "-" & MyDatum
    51. newText.DrawString(drawString, drawFont, drawBrush, 10, 10)
    52. Dim newFile As String
    53. newFile = Targetpath & ImgName
    54. Threading.Thread.Sleep(500)
    55. Me.BeginInvoke(Sub() lstB_newpic.Items.Add(newFile))
    56. Me.BeginInvoke(Sub() lbl_datei.Text = "Verarbeite Datei: " & newFile)
    57. smalImage.Save(newFile, System.Drawing.Imaging.ImageFormat.Jpeg)
    58. newImage.Dispose()
    59. smalImage.Dispose()
    60. newText.Dispose()
    61. Next
    62. Me.BeginInvoke(Sub() PB_ani.Visible = False)
    63. End Sub

    Bilder
    • imgRezi-1.jpg

      47,3 kB, 400×173, 100 mal angesehen
    Asperger Autistin. Brauche immer etwas um gewisse Sachen zu verstehen. :huh:
    Hallo zusammen,

    eine Hand voll Bild-Typen haben zusätzliche Meta-Informationen (Stichwort EXIF), wie u.a. auch die Rotation.

    Schau dir mal das Beispiel an. Wenn ich das richtig verstehe, hat dann das Bild die gleiche Ausrichtung und der Flag bestimmt wie es auf dem Endgerät angezeigt wird.
    Möglicherweise geht die Information bei dir verloren oder werden nicht berücksichtigt.

    VG,
    Acr0most
    Wenn das Leben wirklich nur aus Nullen und Einsen besteht, dann laufen sicherlich genügen Nullen frei herum. :D
    Signature-Move 8o
    kein Problem mit privaten Konversationen zu Thema XY :thumbup:
    So das ist der Code welcher nun das macht, was ich mir so vorgestellt habe.
    Vielleicht kann mir noch jemand erklären und zeigen, wie ich hier das mit dem Using / End Using anwende.
    Ich habe das versucht aber ....

    Spoiler anzeigen

    VB.NET-Quellcode

    1. Private Sub PutTextonImage()
    2. Directory.CreateDirectory(Sourcepath & "\Fertige")
    3. Dim Files As String() = IO.Directory.GetFiles(Sourcepath, "*.jpg")
    4. Targetpath = Sourcepath & "\Fertige\"
    5. Me.BeginInvoke(Sub() PB_ani.Visible = True)
    6. For Each File As String In Files
    7. Dim ImgName As String = System.IO.Path.GetFileName(File)
    8. Dim newImage As New Bitmap(File)
    9. 'Größen von ComboBox
    10. maxWidth = maxWidth
    11. maxHeight = maxHeight
    12. Dim ratioX = CDbl(maxWidth) / newImage.Width
    13. Dim ratioY = CDbl(maxHeight) / newImage.Height
    14. Dim ratio = Math.Min(ratioX, ratioY)
    15. Dim Width = CInt((newImage.Width * ratio))
    16. Dim Height = CInt((newImage.Height * ratio))
    17. Dim smalImage As New Bitmap(Width, Height)
    18. Dim g As Graphics = Graphics.FromImage(smalImage)
    19. g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
    20. g.DrawImage(newImage, New Rectangle(0, 0, Width, Height), New Rectangle(0, 0, newImage.Width, newImage.Height), GraphicsUnit.Pixel)
    21. Dim newText As Graphics = Graphics.FromImage(smalImage)
    22. ' Font Color & Font Size von Combobox
    23. Dim drawBrush As SolidBrush = New SolidBrush(newColor)
    24. Dim drawFont As Font = New Font("Segoe UI", newSize)
    25. Dim drawString As String = tb_signatur.Text & "-" & MyDatum
    26. newText.DrawString(drawString, drawFont, drawBrush, 10, 10)
    27. Dim newFile As String
    28. newFile = Targetpath & ImgName
    29. Threading.Thread.Sleep(100)
    30. Me.BeginInvoke(Sub() lstB_newpic.Items.Add(newFile))
    31. Me.BeginInvoke(Sub() lbl_datei.Text = "Verarbeite Datei: " & newFile)
    32. smalImage.Save(newFile, System.Drawing.Imaging.ImageFormat.Jpeg)
    33. newImage.Dispose()
    34. smalImage.Dispose()
    35. g.Dispose()
    36. Next
    37. Me.BeginInvoke(Sub() PB_ani.Visible = False)
    38. End Sub

    Asperger Autistin. Brauche immer etwas um gewisse Sachen zu verstehen. :huh:

    VB.NET-Quellcode

    1. Using g As Graphics = Graphics.FromImage(smalImage)
    2. g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
    3. g.DrawImage(newImage, New Rectangle(0, 0, Width, Height), New Rectangle(0, 0, newImage.Width, newImage.Height), GraphicsUnit.Pixel)
    4. Using drawBrush As SolidBrush = New SolidBrush(newColor)
    5. Using drawFont As Font = New Font("Segoe UI", newsize)
    6. Dim drawString As String = tb_signatur.Text & "-" & MyDatum
    7. g.DrawString(drawString, drawFont, drawBrush, 10, 10)
    8. End Using
    9. End Using
    10. End Using

    Dieser Beitrag wurde bereits 3 mal editiert, zuletzt von „Morrison“ ()

    Alles, was disposed werden kann, sollte per Using-Block ersetzt werden. Es gibt Ausnahmen, jaja, aber darüber kann man reden, wenn man bei solchen Konstrukten angekommen ist.
    Man setzt da ein Using, wo die disposable-Variable ihren Wert bekommt und setzt da ein End Using, wo man jene Variable durch .Dispose entsorgen will.
    So z.B. auch der SolidBrush und die Font:

    VB.NET-Quellcode

    1. Using g As Graphics = Graphics.FromImage(smalImage)
    2. g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
    3. g.DrawImage(newImage, New Rectangle(0, 0, Width, Height), New Rectangle(0, 0, newImage.Width, newImage.Height), GraphicsUnit.Pixel)
    4. 'Font Color & Font Size von Combobox
    5. Using drawBrush As New SolidBrush(newColor) 'statt Dim
    6. Using drawFont As New Font("Segoe UI", newSize) 'statt Dim
    7. Dim drawString As String = tb_signatur.Text & "-" & MyDatum
    8. g.DrawString(drawString, drawFont, drawBrush, 10, 10)
    9. End Using 'hier stünde ohne das Using eben drawFont.Dispose
    10. End Using 'hier stünde ohne das Using eben drawBrush.Dispose
    11. End Using

    Dieser Beitrag wurde bereits 5 mal editiert, zuletzt von „VaporiZed“, mal wieder aus Grammatikgründen.

    Aufgrund spontaner Selbsteintrübung sind all meine Glaskugeln beim Hersteller. Lasst mich daher bitte nicht den Spekulatiusbackmodus wechseln.

    Amelie schrieb:

    VB.NET-Quellcode
    ...
    scalefactor = newlongsize / longsize
    Return scalefactor ' Hier müsste ich ja ein Bitmap zurückgeben???
    End Function


    Du könntest hier ja auch ein new Bitmap zurückgeben:

    Quellcode

    1. ​return new Bitmap(ScaleFactor * urspruenglicheLanege, ScaleFactor * urspruenglicheBreite)
    Moin moin zusammen

    Habe nun noch etwas geändert. Jetzt kann ich die Signature auch in den Ecken platzieren sowie Datum ein/ausblenden. ;)
    Eine Frage noch zu Disposen / Using
    Was ist genau der Unterschied und ist es zwingend das Using zu verwenden? Wenn ich das richtig verstanden habe, machen doch beide den Speicher frei?

    Spoiler anzeigen

    VB.NET-Quellcode

    1. Public Sub PutTextonImage()
    2. Directory.CreateDirectory(Sourcepath & "\Fertige")
    3. Dim Files As String() = IO.Directory.GetFiles(Sourcepath, "*.jpg")
    4. Targetpath = Sourcepath & "\Fertige\"
    5. Me.BeginInvoke(Sub() PB_ani.Visible = True)
    6. For Each File As String In Files
    7. Dim ImgName As String = System.IO.Path.GetFileName(File)
    8. Dim newImage As New Bitmap(File)
    9. maxWidth = maxWidth
    10. maxHeight = maxHeight
    11. Dim ratioX = CDbl(maxWidth) / newImage.Width
    12. Dim ratioY = CDbl(maxHeight) / newImage.Height
    13. Dim ratio = Math.Min(ratioX, ratioY)
    14. Dim Width = CInt((newImage.Width * ratio))
    15. Dim Height = CInt((newImage.Height * ratio))
    16. Dim smalImage As New Bitmap(Width, Height)
    17. Using g As Graphics = Graphics.FromImage(smalImage)
    18. g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
    19. g.DrawImage(newImage, New Rectangle(0, 0, Width, Height), New Rectangle(0, 0, newImage.Width, newImage.Height), GraphicsUnit.Pixel)
    20. Dim newText As Graphics = Graphics.FromImage(smalImage)
    21. Using drawBrush As SolidBrush = New SolidBrush(newColor)
    22. Using drawFont As Font = New Font("Segoe UI", newSize)
    23. newsignature()
    24. Dim drawString As String = signature
    25. ' ========>Hier ( Dim txtlaenge ) funktionier aber das Using nicht
    26. Dim txtlaenge As SizeF = newText.MeasureString(drawString, drawFont)
    27. Textpos(smalImage.Width, smalImage.Height, CInt(txtlaenge.Width))
    28. newText.DrawString(drawString, drawFont, drawBrush, txtpos_x, txtpos_y)
    29. End Using
    30. End Using
    31. End Using
    32. Dim newFile As String
    33. newFile = Targetpath & ImgName
    34. Threading.Thread.Sleep(100)
    35. Me.BeginInvoke(Sub() lstB_newpic.Items.Add(newFile))
    36. Me.BeginInvoke(Sub() lbl_datei.Text = "Verarbeite Datei: " & newFile)
    37. smalImage.Save(newFile, System.Drawing.Imaging.ImageFormat.Jpeg)
    38. Next
    39. Me.BeginInvoke(Sub() PB_ani.Visible = False)
    40. End Sub
    41. #End Region

    Asperger Autistin. Brauche immer etwas um gewisse Sachen zu verstehen. :huh:
    Moin moin

    Amelie schrieb:

    Was ist genau der Unterschied und ist es zwingend das Using zu verwenden? Wenn ich das richtig verstanden habe, machen doch beide den Speicher frei?

    Jupp. Ein "Dim o As New Object" / "o.Dispose" macht das gleiche wie "Using o As New Object" / "End Using". Der Vorteil am Using/End Using ist das man nicht vergisst das Object irgendwann per Dispose freizugeben. Ein Object das Dispose implementiert, sollte nur solange leben, wie es benötigt wird. Es gibt, wie @VaporiZed schon angemerkt hat, Ausnahmen zum Bsp. wenn Du in innerhalb einer Klasse ein Object bei "Dim c as New Class" erzeugst das solange leben soll bis die Klasse selber Disposed wird. Setzt aber voraus das die Klasse selber IDispose implementiert in der dann das Object disposed wird. Der wichtigste Unterschied dürfte bei Using/End Using auch sein das alle Variablen die innerhalb dieses Using-Blocks erstellt werden, also Dim WhatEver as Interger = Value, nach dem End Using nicht mehr zur Verfügung stehen.
    Mfg -Franky-

    -Franky- schrieb:

    Der Vorteil am Using/End Using ist das man nicht vergisst das Object irgendwann per Dispose freizugeben.
    Es geht auch nicht nur ums vergessen, du kommst aus dem Using-Block gar nicht mehr ohne Dispose raus. Wenn z.B. eine Exception geworfen wird und die Methode abbricht, wird das Dispose durch das using trotzdem gefeuert.