Resize Image ( Bilder verkleinern )

Amelie · 14. Februar 2022, 15:26

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

Private Sub PutTextonImage()
Directory.CreateDirectory(Sourcepath & "\Fertige")
Dim Files As String() = IO.Directory.GetFiles(Sourcepath, "*.jpg")
Targetpath = Sourcepath & "\Fertige\"
Me.BeginInvoke(Sub() PB_ani.Visible = True)
For Each File As String In Files
Img = Image.FromFile(File)
Dim ImgName As String = System.IO.Path.GetFileName(File)
Dim newImage As New Bitmap(Img)
Dim newText As Graphics = Graphics.FromImage(newImage)
Dim drawBrush As SolidBrush = New SolidBrush(newColor)
Dim drawFont As Font = New Font("Segoe UI", 9)
Dim drawString As String = tb_signatur.Text & MyDatum
newText.DrawString(drawString, drawFont, drawBrush, 10, 10)
Dim newFile As String
newFile = Targetpath & ImgName
Threading.Thread.Sleep(500)
Me.BeginInvoke(Sub() lstB_newpic.Items.Add(newFile))
Me.BeginInvoke(Sub() lbl_datei.Text = "Verarbeite Datei: " & newFile)
Dim scale_factor As Single = 0.6
Dim smalImage As New Bitmap(Width, Height)
Dim g As Graphics = Graphics.FromImage(smalImage)
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
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)
g.Dispose()
smalImage.Save(newFile, System.Drawing.Imaging.ImageFormat.Jpeg)
newImage.Dispose()
smalImage.Dispose()
Next
Me.BeginInvoke(Sub() PB_ani.Visible = False)
End Sub

*Topic verschoben*

ErfinderDesRades · 14. Februar 2022, 20:01

ich sehe da nur die Methode PutTextOnImage
Wo ist die Methode ImageResize?

ah - noch ein Ansatz:

VB.NET-Quellcode

Dim smalImage As New Bitmap(Width, Height)

Wo kommen die Werte Width, Height her?
sollte da der scaleFactor nicht einfliessen?

-Franky- · 14. Februar 2022, 20:19

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.

Amelie · 15. Februar 2022, 07:28

@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

Private Sub PutTextonImage()
Directory.CreateDirectory(Sourcepath & "\Fertige")
Dim Files As String() = IO.Directory.GetFiles(Sourcepath, "*.jpg")
Targetpath = Sourcepath & "\Fertige\"
Me.BeginInvoke(Sub() PB_ani.Visible = True)
For Each File As String In Files
Dim ImgName As String = System.IO.Path.GetFileName(File)
Dim newImage As New Bitmap(File)
'------
Dim scalefactor As Single = 0.6
Dim Width As Integer = CInt(newImage.Width * scalefactor)
Dim Height As Integer = CInt(newImage.Height * scalefactor)
Dim smalImage As New Bitmap(Width, Height)
Dim g As Graphics = Graphics.FromImage(smalImage)
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.DrawImage(newImage, New Rectangle(0, 0, Width, Height), New Rectangle(0, 0, newImage.Width, newImage.Height), GraphicsUnit.Pixel)
g.Dispose()
Dim newText As Graphics = Graphics.FromImage(smalImage)
Dim drawBrush As SolidBrush = New SolidBrush(newColor)
Dim drawFont As Font = New Font("Segoe UI", newSize)
Dim drawString As String = tb_signatur.Text & "-" & MyDatum
newText.DrawString(drawString, drawFont, drawBrush, 10, 10)
Dim newFile As String
newFile = Targetpath & ImgName
Threading.Thread.Sleep(200)
Me.BeginInvoke(Sub() lstB_newpic.Items.Add(newFile))
Me.BeginInvoke(Sub() lbl_datei.Text = "Verarbeite Datei: " & newFile)
smalImage.Save(newFile, System.Drawing.Imaging.ImageFormat.Jpeg)
newImage.Dispose()
smalImage.Dispose()
Next
Me.BeginInvoke(Sub() PB_ani.Visible = False)
End Sub

PadreSperanza · 15. Februar 2022, 09:13

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

Amelie · 15. Februar 2022, 10:07

@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

Public Function ImgScalefaktor(ByVal newImage As Image) As Image
Dim Width As Single = newImage.Width
Dim Height As Single = newImage.Height
Dim longsize As Single
Dim shortsize As Single
If Width > Height Then
longsize = Width
Else
longsize = Height
End If
Dim newlongsize As Single
newlongsize = 1000
scalefactor = newlongsize / longsize
Return scalefactor ' Hier müsste ich ja ein Bitmap zurückgeben???
End Function

ÄNDERUNG

VB.NET-Quellcode

Width = newlongsize / longsize
Height = '????
Dim smalImage As New Bitmap(Width, Height)
Return smalImage

Morrison · 15. Februar 2022, 11:15

VB.NET-Quellcode

Public Function PicResizeByWidth(SourceImage As String, NewWidth As Integer) As Bitmap
Dim InputBitmap As New Bitmap(SourceImage)
Dim SizeFactor As Decimal = CDec(NewWidth / InputBitmap.Width)
Dim NewHeigth As Integer = CInt(SizeFactor * InputBitmap.Height)
Dim OutputBitmap As New Bitmap(Image.FromFile(SourceImage), NewWidth, NewHeigth)
PicResizeByWidth = OutputBitmap
InputBitmap.Dispose()
OutputBitmap.Dispose()
End Function

Amelie · 15. Februar 2022, 13:50

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

Public Function ImgScale(ByVal newImage As String) As Bitmap
Dim newBitmap As New Bitmap(newImage)
Dim Width As Integer = newBitmap.Width
Dim Height As Integer = newBitmap.Height
Dim longsize As Integer
Dim shortsize As Integer
Dim newWidth As Integer
Dim newHeight As Integer
If Width > Height Then
longsize = Width
shortsize = Height
Else
longsize = Height
shortsize = Width
End If
Dim newlongsize As Integer = 1000
Dim ScaleFactor As Decimal = CDec(newlongsize / longsize)
Dim newshortsize As Integer = CInt(ScaleFactor * shortsize)
If Width > Height Then
newWidth = newlongsize
newHeight = newshortsize
Else
newWidth = newshortsize
newHeight = newlongsize
End If
' Bis hier hin sind die neuen Abmessungen korrekt.
' Habe ich mir anzeigen lassen.
Dim smalImage As New Bitmap(Image.FromFile(newImage), newWidth, newHeight)
Return smalImage
End Function
Private Sub PutTextonImage()
Directory.CreateDirectory(Sourcepath & "\Fertige")
Dim Files As String() = IO.Directory.GetFiles(Sourcepath, "*.jpg")
Targetpath = Sourcepath & "\Fertige\"
Me.BeginInvoke(Sub() PB_ani.Visible = True)
For Each File As String In Files
Dim ImgName As String = System.IO.Path.GetFileName(File)
' zur Funktion umrechen
ImgScale(File)
Dim newImage As New Bitmap(File)
Dim smalImage As New Bitmap(Width, Height)
Dim g As Graphics = Graphics.FromImage(smalImage)
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.DrawImage(newImage, New Rectangle(0, 0, Width, Height), New Rectangle(0, 0, newImage.Width, newImage.Height), GraphicsUnit.Pixel)
g.Dispose()
' Text aufs neue Bild
Dim newText As Graphics = Graphics.FromImage(smalImage)
Dim drawBrush As SolidBrush = New SolidBrush(newColor)
Dim drawFont As Font = New Font("Segoe UI", newSize)
Dim drawString As String = tb_signatur.Text & "-" & MyDatum
newText.DrawString(drawString, drawFont, drawBrush, 10, 10)
Dim newFile As String
newFile = Targetpath & ImgName
Threading.Thread.Sleep(500)
Me.BeginInvoke(Sub() lstB_newpic.Items.Add(newFile))
Me.BeginInvoke(Sub() lbl_datei.Text = "Verarbeite Datei: " & newFile)
smalImage.Save(newFile, System.Drawing.Imaging.ImageFormat.Jpeg)
newImage.Dispose()
smalImage.Dispose()
newText.Dispose()
Next
Me.BeginInvoke(Sub() PB_ani.Visible = False)
End Sub

Acr0most · 15. Februar 2022, 15:02

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

Amelie · 15. Februar 2022, 16:17

@Acr0most
Danke für den Tip aber daran hat es nicht gelegen.

Habe es nun hinbekommen. Teste noch einweing und dann poste ich den fertigen code

Amelie · 15. Februar 2022, 17:05

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

Private Sub PutTextonImage()
Directory.CreateDirectory(Sourcepath & "\Fertige")
Dim Files As String() = IO.Directory.GetFiles(Sourcepath, "*.jpg")
Targetpath = Sourcepath & "\Fertige\"
Me.BeginInvoke(Sub() PB_ani.Visible = True)
For Each File As String In Files
Dim ImgName As String = System.IO.Path.GetFileName(File)
Dim newImage As New Bitmap(File)
'Größen von ComboBox
maxWidth = maxWidth
maxHeight = maxHeight
Dim ratioX = CDbl(maxWidth) / newImage.Width
Dim ratioY = CDbl(maxHeight) / newImage.Height
Dim ratio = Math.Min(ratioX, ratioY)
Dim Width = CInt((newImage.Width * ratio))
Dim Height = CInt((newImage.Height * ratio))
Dim smalImage As New Bitmap(Width, Height)
Dim g As Graphics = Graphics.FromImage(smalImage)
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.DrawImage(newImage, New Rectangle(0, 0, Width, Height), New Rectangle(0, 0, newImage.Width, newImage.Height), GraphicsUnit.Pixel)
Dim newText As Graphics = Graphics.FromImage(smalImage)
' Font Color & Font Size von Combobox
Dim drawBrush As SolidBrush = New SolidBrush(newColor)
Dim drawFont As Font = New Font("Segoe UI", newSize)
Dim drawString As String = tb_signatur.Text & "-" & MyDatum
newText.DrawString(drawString, drawFont, drawBrush, 10, 10)
Dim newFile As String
newFile = Targetpath & ImgName
Threading.Thread.Sleep(100)
Me.BeginInvoke(Sub() lstB_newpic.Items.Add(newFile))
Me.BeginInvoke(Sub() lbl_datei.Text = "Verarbeite Datei: " & newFile)
smalImage.Save(newFile, System.Drawing.Imaging.ImageFormat.Jpeg)
newImage.Dispose()
smalImage.Dispose()
g.Dispose()
Next
Me.BeginInvoke(Sub() PB_ani.Visible = False)
End Sub

Morrison · 15. Februar 2022, 18:04

VB.NET-Quellcode

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

VaporiZed · 15. Februar 2022, 18:12

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

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

PadreSperanza · 15. Februar 2022, 20:29

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

return new Bitmap(ScaleFactor * urspruenglicheLanege, ScaleFactor * urspruenglicheBreite)

Amelie · 16. Februar 2022, 07:41

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

Public Sub PutTextonImage()
Directory.CreateDirectory(Sourcepath & "\Fertige")
Dim Files As String() = IO.Directory.GetFiles(Sourcepath, "*.jpg")
Targetpath = Sourcepath & "\Fertige\"
Me.BeginInvoke(Sub() PB_ani.Visible = True)
For Each File As String In Files
Dim ImgName As String = System.IO.Path.GetFileName(File)
Dim newImage As New Bitmap(File)
maxWidth = maxWidth
maxHeight = maxHeight
Dim ratioX = CDbl(maxWidth) / newImage.Width
Dim ratioY = CDbl(maxHeight) / newImage.Height
Dim ratio = Math.Min(ratioX, ratioY)
Dim Width = CInt((newImage.Width * ratio))
Dim Height = CInt((newImage.Height * ratio))
Dim smalImage As New Bitmap(Width, Height)
Using g As Graphics = Graphics.FromImage(smalImage)
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.DrawImage(newImage, New Rectangle(0, 0, Width, Height), New Rectangle(0, 0, newImage.Width, newImage.Height), GraphicsUnit.Pixel)
Dim newText As Graphics = Graphics.FromImage(smalImage)
Using drawBrush As SolidBrush = New SolidBrush(newColor)
Using drawFont As Font = New Font("Segoe UI", newSize)
newsignature()
Dim drawString As String = signature
' ========>Hier ( Dim txtlaenge ) funktionier aber das Using nicht
Dim txtlaenge As SizeF = newText.MeasureString(drawString, drawFont)
Textpos(smalImage.Width, smalImage.Height, CInt(txtlaenge.Width))
newText.DrawString(drawString, drawFont, drawBrush, txtpos_x, txtpos_y)
End Using
End Using
End Using
Dim newFile As String
newFile = Targetpath & ImgName
Threading.Thread.Sleep(100)
Me.BeginInvoke(Sub() lstB_newpic.Items.Add(newFile))
Me.BeginInvoke(Sub() lbl_datei.Text = "Verarbeite Datei: " & newFile)
smalImage.Save(newFile, System.Drawing.Imaging.ImageFormat.Jpeg)
Next
Me.BeginInvoke(Sub() PB_ani.Visible = False)
End Sub
#End Region

-Franky- · 16. Februar 2022, 08:11

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.

Bluespide · 16. Februar 2022, 08:18

-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.

-Franky- · 16. Februar 2022, 08:30

@Bluespide Natürlich, auch ein sehr guter Punkt den Du genannt hast.

Resize Image ( Bilder verkleinern )

Resize Image ( Bilder verkleinern )

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

Amelie schrieb:

Quellcode

VB.NET-Quellcode

Amelie schrieb:

-Franky- schrieb:

Ähnliche Themen

8 Benutzer haben hier geschrieben