Boolean(,) to Byte() / 2-dim Array in 1-dim Array konvertieren

Morrison · 25. April 2016, 00:12

Hallo!
Ich bearbeite Bilder und konvertiere diese von Bitmap zu Byte() und speichere dann alles in einer .XML-Datei ab!
Nun habe ich das Problem das ich eine Funktion hab die mit einem Boolean(,) Array funktioniert..d.H. ich brauche eine Funktion, bzw. zwei, mit denen ich von Byte() zu Boolean(,) konvertieren kann!

Hmm, meine versuche dazu funktionieren iwie nicht! Wenn ich das Array zurück inn Bitmap verwandel sehe ich nur paar Bildpunkte in der ersten Zeile tanzen..

Spoiler anzeigen

~blaze~ · 25. April 2016, 00:29

Hi
Bilder gehören i.A. nicht in eine Datenbank.
Was zudem nicht passt: Es müsste wohl x + _stride sein. Aber ehrlich gesagt passt das Hinten und Vorne nicht. Byte() ist wesentlich eleganter, als Boolean(,) (und in diesem Fall auch eleganter, als BitArray()).
Speichere das Bild in eine Datei auf dem Server ab und wähle für die Datei einen eindeutigen Namen. Anschließend lässt du die Datenbank auf die Datei verweisen.

Viele Grüße
~blaze~

jvbsl · 25. April 2016, 00:33

0 1 2 3 4 5
6 7 8 9 10 11
12 13 14 15 16 17
18 19 20 21 22 23
24 25 26 27 28 29

wie könnte man da nur das Mapping von 2D auf 1D machen?

x+y geht schonmal nicht: max(x+y) = 9 und wir müssen bis mind. 29 kommen
also eine einfache Multiplikation muss her

y*6+x -> max(y*6+x)=29

und außerdem bildet jedes (x,y) paar auf nur einen index Wert ab.

Morrison · 25. April 2016, 00:55

Naja, Datenbank = DataTable

..also das soll ein Bitmap von 20*20 px sein!
Bei _Array.UpperLength bekomm ich 401.

..dann ist das ja auch schon Falsch:

Spoiler anzeigen

Quellcode

Public Shared Function getBinaryTiles(ByVal bmp As Bitmap, ByVal iRowCount As Integer, ByVal iColumnCount As Integer, ByVal iPercentNeeded As Integer) As Byte()
Dim iTileWidth As Integer = CInt(bmp.Width / iColumnCount)
Dim iTileHeight As Integer = CInt(bmp.Height / iRowCount)
Dim iPixelsInTile As Integer = iTileHeight * iTileWidth
Dim bBinary(401) As Byte
Dim iTileX As Integer = 0
Dim iTileY As Integer = 0
Dim _lbBitmap As New LockBits(bmp)
_lbBitmap.LockBits()
For iX = 0 To _lbBitmap.Width - 1 Step iTileWidth
For iY = 0 To _lbBitmap.Height - 1 Step iTileHeight
Dim iCountMarkedPixelsInTile As Integer = 0
For x = iX To iX + iTileWidth - 1
For y = iY To iY + iTileHeight - 1
If _lbBitmap.GetPixel(x, y).GetBrightness = 0 Then
iCountMarkedPixelsInTile += 1
End If
Next
Next
Dim iPercent As Integer = CInt(Math.Round(100 / iPixelsInTile * iCountMarkedPixelsInTile, 0))
If iPercent >= iPercentNeeded Then
bBinary(iTileX + iTileY) = 255
Else
bBinary(iTileX + iTileY) = 0
End If
iTileY += 1
Next
iTileX += 1
iTileY = 0
Next
_lbBitmap.UnlockBits()
Return bBinary
End Function

ErfinderDesRades · 25. April 2016, 13:14

ich verstehe das Problem nicht.
Bitmap nach Byte() konvertieren kann ich.
Bilder in Db speichern finde ich auch i.O., je nach Anforderung.
Weil eine Db, die nur Dateipfade verwaltet, ist anfällig dagegen, dass jemand im Dateisystem rumpfuscht - und kleine Bildle eh noProblem.

Aber warum man Byte() nach Boolean(,) konvertieren will, ist mir unerfindlich, und es scheint ja auch iwas mit Tile-Generierung zu tun haben - aber was?

Also meine Lieblings-Gegenfrage/Bitte: Erklär mal, was du eiglich beabsichtigst.

Morrison · 25. April 2016, 15:30

Hehe, nunja..ich habe eine Bitmap von der ich die Pixeldaten mit LockBits auslese um diese als Byte() zu speichern. Soweit alles i.O.!
Dann habe ich eine Funktion (nicht von mir) die mir von dem Bitmap, wie oben erwähnt, Tiles generiert..aber nur Boolean(,) akzeptiert..

..deswegen das hin und her! Hab schon versucht die Funktion umzuschreiben..aber da kommt nur murks bei rum..

..grml..und die Funktion klappt auch nicht:

Spoiler anzeigen

Quellcode

[vbnet] Private Function _pixelate(ByVal _bmp As Bitmap) As Bitmap
Dim bmOut As Bitmap = New Bitmap(_bmp.Width, _bmp.Height, _bmp.PixelFormat)
Dim pixelationAmount As Integer = 10
' store average of rgb
Dim pixel As Color
Dim x As Integer = 0
Dim iPixelsInTile As Integer = pixelationAmount * pixelationAmount
While x < Width
Dim y As Integer = 0
While y < Height
Dim bx As Integer = x + pixelationAmount
Dim by As Integer = y + pixelationAmount
If by >= Height Then
by = Height
End If
If bx >= _bmp.Width Then
bx = _bmp.Width
End If
Dim iCountMarkedPixelsInTile As Integer = 0
For xx As Integer = x To bx - 1
For yy As Integer = y To by - 1
pixel = _bmp.GetPixel(xx, yy)
If pixel.GetBrightness = 0 Then
iCountMarkedPixelsInTile += 1
End If
Next
Next
Dim iPercent As Integer = CInt(Math.Round(100 / iPixelsInTile * iCountMarkedPixelsInTile, 0))
For xx As Integer = x To bx - 1
For yy As Integer = y To by - 1
If iPercent >= 1 Then
bmOut.SetPixel(xx, yy, Color.Black)
Else
bmOut.SetPixel(xx, yy, Color.White)
End If
Next
Next
y += pixelationAmount
End While
x += pixelationAmount
End While
Return bmOut
End Function
[/vbnet]

Also eine Funktion die alle 20px die Quersumme der Farbwerte(bzw. S/W) nimmt und entweder schwarz oder weiß überwiegt!

Hier das Original:

Spoiler anzeigen

Quellcode

Public Shared Function getBinaryTiles(ByVal bmp As Bitmap, ByVal iRowCount As Integer, ByVal iColumnCount As Integer, ByVal iPercentNeeded As Integer) As Boolean(,)
Dim iTileWidth As Integer = CInt(bmp.Width / iColumnCount)
Dim iTileHeight As Integer = CInt(bmp.Height / iRowCount)
Dim iPixelsInTile As Integer = iTileHeight * iTileWidth
Dim bBinary(iColumnCount - 1, iRowCount - 1) As Boolean
Dim iTileX As Integer = 0
Dim iTileY As Integer = 0
For iX = 0 To bmp.Width - 1 Step iTileWidth
For iY = 0 To bmp.Height - 1 Step iTileHeight
Dim iCountMarkedPixelsInTile As Integer = 0
For x = iX To iX + iTileWidth - 1
For y = iY To iY + iTileHeight - 1
If bmp.GetPixel(x, y).GetBrightness = 0 Then
iCountMarkedPixelsInTile += 1
End If
Next
Next
Dim iPercent As Integer = CInt(Math.Round(100 / iPixelsInTile * iCountMarkedPixelsInTile, 0))
If iPercent >= iPercentNeeded Then
bBinary(iTileX, iTileY) = True
Else
bBinary(iTileX, iTileY) = False
End If
iTileY += 1
Next
iTileX += 1
iTileY = 0
Next
Return bBinary
End Function

ErfinderDesRades · 25. April 2016, 16:22

Morrison schrieb:

...Tiles generiert..aber nur Boolean(,) akzeptiert.

Solch scheint mir abstrus.
Sieh besser zu, dass du eine vernünftige Tiles-Generier-Funktion zustande bringst.
Oder zeig die Methode mal - ich kann mir kaum vorstellen, dass jmd sowas komisches veröffentlicht.

Morrison schrieb:

Also eine Funktion die alle 20px die Quersumme der Farbwerte(bzw. S/W) nimmt und entweder schwarz oder weiß überwiegt!

Sowas ist nicht wirklich eine Tiles-Generierung.
Das wäre eher eine Rasterung, aber auch nicht wirklich, denn bei einer Rasterung stellt man aus den Bool-Informationen dann eine Schwarz-Weiß-Bitmap her.

Aber ist mir immer noch nicht klar, was du damit vor hast - was willst du mit dem Bool(,)?

Morrison · 26. April 2016, 10:22

OK, also diese Funktion funktioniert (lol):

Spoiler anzeigen

Quellcode

Private Function _BMPpixel(ByVal _bmp As Bitmap) As Bitmap
Dim bmOut As Bitmap = New Bitmap(_bmp.Width, _bmp.Height, _bmp.PixelFormat)
Dim pixelationAmount As Integer = 8
' store average of rgb
Dim pixel As Color
Dim x As Integer = 0
Dim iPixelsInTile As Integer = pixelationAmount * pixelationAmount
While x < _bmp.Width
Dim y As Integer = 0
While y < _bmp.Height
Dim bx As Integer = x + pixelationAmount
Dim by As Integer = y + pixelationAmount
If by >= _bmp.Height Then
by = _bmp.Height
End If
If bx >= _bmp.Width Then
bx = _bmp.Width
End If
Dim iCountMarkedPixelsInTile As Integer = 0
For xx As Integer = x To bx - 1
For yy As Integer = y To by - 1
pixel = _bmp.GetPixel(xx, yy)
If pixel.GetBrightness = 0 Then
iCountMarkedPixelsInTile += 1
End If
Next
Next
Dim iPercent As Integer = CInt(Math.Round(100 / iPixelsInTile * iCountMarkedPixelsInTile, 0))
For xx As Integer = x To bx - 1
For yy As Integer = y To by - 1
If iPercent >= 1 Then
bmOut.SetPixel(xx, yy, Color.Black)
Else
bmOut.SetPixel(xx, yy, Color.White)
End If
Next
Next
y += pixelationAmount
End While
x += pixelationAmount
End While
Return bmOut
End Function

Nur brauch ich jetzt als Rückgabewert dein Byte()! (*lol*)

Edit:
..natürlich "ein" Byte()-Array..als Rückgabewert, kein Bitmap.
Ich weiß nur leider nicht wie das mit dem "Stride" funktioniert!

Wenn ich die Bitmap mit Schleifen durchlaufe habe ich die x und y Werte..wie mache ich daraus die Position des Bytes im Array?

ErfinderDesRades · 26. April 2016, 10:36

Morrison schrieb:

Nur brauch ich jetzt als Rückgabewert dein Byte()!

Was meinst du damit? ( - soll ich dir meine Festplatte schicken?

)

Versuch mal eine Fragestellung, die eher Sinn ergibt - irgendetwas brauchst du, aber es ist nicht "mein Byte()" - was immer damit gemeint sein mag.

Morrison · 27. April 2016, 00:41

Wenn ich die Bitmap mit Schleifen durchlaufe habe ich die x und y Werte..wie mache ich daraus die Position des Bytes im Array?

Plexian · 27. April 2016, 01:04

Wenn du horizontal die Pixel durchgehst, ist dein Index i = y * width + x, ansonsten i = x * height + y

ErfinderDesRades · 27. April 2016, 08:52

Morrison schrieb:

Wenn ich die Bitmap mit Schleifen durchlaufe habe ich die x und y Werte..wie mache ich daraus die Position des Bytes im Array?

Das ist jetzt wieder was ganz anderes, als was du je gefragt hast, in diesem Thread.
Aber es ist verständlich - ich hoffe nur, es ist wirklich, was du wissen willst.

Ich formuliere dein Anliegen nochmal um, und du sagst mir, ob ich richtig verstanden habe:
Du möchtest das Byte-Array erhalten mit den Pixel-Daten der Bitmap.

Dabei meint "Pixel-Daten" die Farb-Kanäle rgb, (rot grün blau).

Dazu ist zu sagen, dass hauptsächlich zweierlei Bitmapse üblich sind: Manche Bitmaps haben 3 Bytes per Pixel, andere haben 4 Bytes per Pixel, nämlich zusätzlich den Alpha-Kanal ("argb" -> alpha red green blue) . Man notiert diese Einstellung aber nicht "Bytes per Pixel", sondern Bitweise.
Also
System.Drawing.Imaging.PixelFormat.Format24bppRgb bedeutet, diese Bitmap hat 3 Bytes per Pixel, und
System.Drawing.Imaging.PixelFormat.Format32bppArgb bedeutet, die Bitmap hat 4 Bytes per Pixel

Also je nachdem, aus welcher Art Bitmap deine Pixeldaten sind, musst du in 3er-Schritten durch die Pixel iterieren oder in 4ern.

Und Stride gibt die Anzahl der Bytes pro Bildzeile an - ist also abhängig sowohl von Höhe, Breite des Bildes, sowie vom Pixelformat.

Ist es das, womit du arbeiten willst?

Morrison · 27. April 2016, 13:23

@EdR: Jup, damit will/muss ich arbeiten!!

Jetzt habe ich zwei Funktionen, die eine macht mir ein Byte() zum speichern der Daten, die andere soll des Array wieder zu nem Bild machen

Bitmap to Byte (mit Tiles):

Spoiler anzeigen

Quellcode

Private Function _BMPtoByte(ByVal _bmp As Bitmap) As Byte()
' Dim bmOut As Bitmap = New Bitmap(_bmp.Width, _bmp.Height, _bmp.PixelFormat)
Dim pixelationAmount As Integer = 8
' store average of rgb
Dim pixel As Color
Dim x As Integer = 0
Dim iPixelsInTile As Integer = pixelationAmount * pixelationAmount
Dim _lbBMP As New LockBits(_bmp)
_lbBMP.LockBits()
Dim _byte(40000) As Byte
While x < _lbBMP.Width
Dim y As Integer = 0
While y < _lbBMP.Height
Dim bx As Integer = x + pixelationAmount
Dim by As Integer = y + pixelationAmount
If by >= _lbBMP.Height Then
by = _lbBMP.Height
End If
If bx >= _lbBMP.Width Then
bx = _lbBMP.Width
End If
Dim iCountMarkedPixelsInTile As Integer = 0
For xx As Integer = x To bx - 1
For yy As Integer = y To by - 1
pixel = _lbBMP.GetPixel(xx, yy)
If pixel.GetBrightness = 0 Then
iCountMarkedPixelsInTile += 1
End If
Next
Next
Dim iPercent As Integer = CInt(Math.Round(100 / iPixelsInTile * iCountMarkedPixelsInTile, 0))
For xx As Integer = x To bx - 1
For yy As Integer = y To by - 1
If iPercent >= 1 Then
_byte(yy * _lbBMP.Width + xx) = 0
Else
_byte(yy * _lbBMP.Width + xx) = 255
End If
Next
Next
y += pixelationAmount
End While
x += pixelationAmount
End While
_lbBMP.UnlockBits()
Return _byte
End Function

Byte to Bitmap:

Spoiler anzeigen

Nur gibt die zweite Funktion den Fehler: Ungültiger Parameter

ErfinderDesRades · 27. April 2016, 13:31

Die erste macht noch allerlei andere Sachen, als nur Bitmap to Byte()
Wo ich allerdings nicht durchblicke.

Die zweite wird mit den Bytes, die die erste erzeugt, glaub nicht klarkommen.

Aber wenn du damit zufrieden bist, ist ja gut.

Morrison · 27. April 2016, 13:58

Nee, bin nich zufrieden...
...ich kann ja auch nicht prüfen ob das Byte-Array korrekt ist weil die ByteToBitmap-Funktion ja nicht funktioniert!

Die erste Funktion soll mir die Bytes auslesen und gleichzeitig das Bitmap "pixelieren", also in inem Rechteck von 8px den Schwarzwert messen und wenn Schwarz überwiegt die 8*8px schwarz machen!

ErfinderDesRades · 27. April 2016, 14:07

och die 2. Methode funktioniert. Man muss ihr nur ein Byte geben, aus einer Bitmap, die regulär in einen Stream abgespeichert wurde - dann kann sie das auch lesen.

Aber ich hab eine neue Idee, was du wohl wollen magst:
Du möchtest eine Bitmap rastern, und zwar in 8*8 - Raster.
Da solltest du besser nicht von Tiles reden, denn Tiles sind was ganz anderes - das sind Teil-Ausschnitte einer Bitmap de.wikipedia.org/wiki/Kachelgrafik.

Ich find, du hast ein erhebliches Problem, zu erklären, was du eiglich machen willst - seit drei tagen versuche ich das nun herauszubekommen, und sicher bin ich immer noch nicht.

~blaze~ · 27. April 2016, 14:42

Ich find's ja ehrlich gesagt auch nicht gerade höflich, die anderen Hilfestellungen einfach zu übergehen. Verstehst du nicht, was wir dir sagen oder wo liegt da das Problem?

Viele Grüße
~blaze~

Morrison · 28. April 2016, 17:49

Hier habe ich jetzt etwas was funktioniert!

Ich habe eine Form mit zwei PictureBoxes und einem Button:

Spoiler anzeigen

Quellcode

Option Strict On
Imports System.Drawing.Text
Public Class Form1
Dim _Pattern As String = "abcdefghijklmnopqrstuvwxyzäöüßABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ1234567890"
Dim _FontCollection As New InstalledFontCollection() 'Installierte Fonts
Dim sf As New StringFormat With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center} 'PictureBox Ausrichtug mittig setzen
Dim middleBox As Size
Private Sub bGO_Click(sender As Object, e As EventArgs) Handles bGO.Click
_getFontCharBitmaps()
End Sub
Private Sub _getFontCharBitmaps()
For Each _font As FontFamily In _FontCollection.Families
Application.DoEvents()
Dim tempFont As Font = Nothing
If _font.IsStyleAvailable(FontStyle.Regular) Then
tempFont = New Font(_font, 64, FontStyle.Regular)
ElseIf _font.IsStyleAvailable(FontStyle.Bold) Then
tempFont = New Font(_font, 64, FontStyle.Bold)
ElseIf _font.IsStyleAvailable(FontStyle.Italic) Then
tempFont = New Font(_font, 64, FontStyle.Italic)
End If
For Each _char As Char In _Pattern
Application.DoEvents()
If tempFont IsNot Nothing Then
Dim _bmp As Bitmap = _draw(PictureBox1, _char, tempFont)
PictureBox1.Image = _bmp
PictureBox1.Refresh()
PictureBox2.Image = _BMPpixel(_bmp)
PictureBox2.Refresh()
End If
Next
Next
End Sub
Public Function _draw(ByVal _pb1 As PictureBox, ByVal _string As String, ByVal _actFont As Font) As Bitmap
Dim img = New Bitmap(_pb1.Width, _pb1.Height, Imaging.PixelFormat.Format32bppArgb)
Dim gr As Graphics = Graphics.FromImage(img)
middleBox = New Size(CInt(_pb1.Width / 2), CInt(_pb1.Height / 2))
gr.Clear(Color.White) '(_pb1.BackColor)
Try
gr.DrawString(_string, _actFont, Brushes.Black, middleBox.Width, middleBox.Height, sf)
Catch ex As Exception
End Try
gr.Dispose()
Return img
End Function
Private Function _BMPpixel(ByVal _bmp As Bitmap) As Bitmap
Dim bmOut As Bitmap = New Bitmap(_bmp.Width, _bmp.Height, _bmp.PixelFormat)
Dim pixelationAmount As Integer = 8
Dim pixel As Color
Dim x As Integer = 0
Dim iPixelsInTile As Integer = pixelationAmount * pixelationAmount
While x < _bmp.Width
Dim y As Integer = 0
While y < _bmp.Height
Dim bx As Integer = x + pixelationAmount
Dim by As Integer = y + pixelationAmount
If by >= _bmp.Height Then
by = _bmp.Height
End If
If bx >= _bmp.Width Then
bx = _bmp.Width
End If
Dim iCountMarkedPixelsInTile As Integer = 0
For xx As Integer = x To bx - 1
For yy As Integer = y To by - 1
pixel = _bmp.GetPixel(xx, yy)
If pixel.GetBrightness = 0 Then
iCountMarkedPixelsInTile += 1
End If
Next
Next
Dim iPercent As Integer = CInt(Math.Round(100 / iPixelsInTile * iCountMarkedPixelsInTile, 0))
For xx As Integer = x To bx - 1
For yy As Integer = y To by - 1
If iPercent >= 1 Then
bmOut.SetPixel(xx, yy, Color.Black)
Else
bmOut.SetPixel(xx, yy, Color.White)
End If
Next
Next
y += pixelationAmount
End While
x += pixelationAmount
End While
Return bmOut
End Function
End Class

In der ersten PB ist das Originalbild und in PB2 das Ergebnis!
Nur möchte ich als Ausgabe kein Bitmap haben sondern ein Byte()!

~blaze~ · 28. April 2016, 18:13

Na dann immer munter in die Datenbank damit! Der Code ist übrigens... nicht gerade der Bringer.

Viele Grüße
~blaze~

Morrison · 29. April 2016, 04:02

Also so sollte das eigentlich aussehen...nun feil ich das nochn bissl Rund!!

Spoiler anzeigen

VB.NET-Quellcode

Option Strict On
Imports System.Drawing.Imaging
Imports System.Drawing.Text
Public Class Form1
Dim _Pattern As String = "abcdefghijklmnopqrstuvwxyzäöüßABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ1234567890"
Dim _FontCollection As New InstalledFontCollection() 'Installierte Fonts
Dim sf As New StringFormat With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center} 'PictureBox Ausrichtug mittig setzen
Dim middleBox As Size
Private Sub bGO_Click(sender As Object, e As EventArgs) Handles bGO.Click
_getFontCharBitmaps()
End Sub
Private Sub _getFontCharBitmaps()
For Each _font As FontFamily In _FontCollection.Families
Application.DoEvents()
Dim tempFont As Font = Nothing
If _font.IsStyleAvailable(FontStyle.Regular) Then
tempFont = New Font(_font, 72, FontStyle.Regular)
ElseIf _font.IsStyleAvailable(FontStyle.Bold) Then
tempFont = New Font(_font, 72, FontStyle.Bold)
ElseIf _font.IsStyleAvailable(FontStyle.Italic) Then
tempFont = New Font(_font, 72, FontStyle.Italic)
End If
For Each _char As Char In _Pattern
Application.DoEvents()
If tempFont IsNot Nothing Then
Dim _bmp As Bitmap = _draw(PictureBox1, _char, tempFont)
PictureBox1.Image = _getRect(_bmp)
PictureBox1.Refresh()
Dim _bool As Boolean()() = Image2Bool(_bmp)
Dim _bbmp As Bitmap = CType(Bool2Image(ZhangSuenThinning(_bool)), Bitmap) '_BMPpixel(CType(Bool2Image(ZhangSuenThinning(_bool)), Bitmap))
PictureBox2.Image = _getRect(_bbmp)
PictureBox2.Refresh()
End If
Next
Next
End Sub
Public Function _draw(ByVal _pb1 As PictureBox, ByVal _string As String, ByVal _actFont As Font) As Bitmap
Dim img = New Bitmap(_pb1.Width, _pb1.Height, Imaging.PixelFormat.Format32bppArgb)
Dim gr As Graphics = Graphics.FromImage(img)
middleBox = New Size(CInt(_pb1.Width / 2), CInt(_pb1.Height / 2))
gr.Clear(Color.White) '(_pb1.BackColor)
Try
gr.DrawString(_string, _actFont, Brushes.Black, middleBox.Width, middleBox.Height, sf)
Catch ex As Exception
End Try
gr.Dispose()
Return img
End Function
Private Function _BMPpixel(ByVal _bmp As Bitmap) As Bitmap
Dim bmOut As Bitmap = New Bitmap(_bmp.Width, _bmp.Height, _bmp.PixelFormat)
Dim pixelationAmount As Integer = 4
Dim pixel As Color
Dim x As Integer = 0
Dim iPixelsInTile As Integer = pixelationAmount * pixelationAmount
Dim _lbIn As New LockBits(_bmp)
Dim _lbOut As New LockBits(bmOut)
_lbIn.LockBits()
_lbOut.LockBits()
While x < _lbIn.Width
Dim y As Integer = 0
While y < _lbIn.Height
Dim bx As Integer = x + pixelationAmount
Dim by As Integer = y + pixelationAmount
If by >= _lbIn.Height Then
by = _lbIn.Height
End If
If bx >= _lbIn.Width Then
bx = _lbIn.Width
End If
Dim iCountMarkedPixelsInTile As Integer = 0
For xx As Integer = x To bx - 1
For yy As Integer = y To by - 1
pixel = _lbIn.GetPixel(xx, yy)
If pixel.GetBrightness = 0 Then
iCountMarkedPixelsInTile += 1
End If
Next
Next
Dim iPercent As Integer = CInt(Math.Round(100 / iPixelsInTile * iCountMarkedPixelsInTile, 0))
For xx As Integer = x To bx - 1
For yy As Integer = y To by - 1
If iPercent >= 1 Then
_lbOut.SetPixel(xx, yy, Color.Black)
Else
_lbOut.SetPixel(xx, yy, Color.White)
End If
Next
Next
y += pixelationAmount
End While
x += pixelationAmount
End While
_lbIn.UnlockBits()
_lbOut.UnlockBits()
Return bmOut
End Function
Public Shared Function _getRect(ByVal bmp As Bitmap) As Bitmap
Dim xCropLeft As Integer = -1
Dim xCropRight As Integer = -1
Dim yCropTop As Integer = -1
Dim yCropBottom As Integer = -1
Dim bEnd As Boolean = False
Dim _lbBMP As New LockBits(bmp)
_lbBMP.LockBits()
For x = 0 To _lbBMP.Width - 1
For y = 0 To _lbBMP.Height - 1
If _lbBMP.GetPixel(x, y).GetBrightness = 0 Then 'Erstes schwarz von links
If xCropLeft = -1 Then
xCropLeft = x
bEnd = True
Exit For
End If
End If
Next
If bEnd = True Then
Exit For
End If
Next
bEnd = False
For x = _lbBMP.Width - 1 To 0 Step -1
For y = 0 To _lbBMP.Height - 1
If _lbBMP.GetPixel(x, y).GetBrightness = 0 Then 'Erstes schwarz von rechts
If xCropRight = -1 Then
xCropRight = x
bEnd = True
Exit For
End If
End If
Next
If bEnd = True Then
Exit For
End If
Next
bEnd = False
For y = 0 To _lbBMP.Height - 1
For x = 0 To _lbBMP.Width - 1
If _lbBMP.GetPixel(x, y).GetBrightness = 0 Then 'Erstes schwarz von oben
If yCropTop = -1 Then
yCropTop = y
bEnd = True
Exit For
End If
End If
Next
If bEnd = True Then
Exit For
End If
Next
bEnd = False
For y = _lbBMP.Height - 1 To 0 Step -1
For x = 0 To _lbBMP.Width - 1
If _lbBMP.GetPixel(x, y).GetBrightness = 0 Then 'Erstes schwarz von unten
If yCropBottom = -1 Then
yCropBottom = y
bEnd = True
Exit For
End If
End If
Next
If bEnd = True Then
Exit For
End If
Next
Dim _rect As New Rectangle(xCropLeft, yCropTop, xCropRight - xCropLeft + 0, yCropBottom - yCropTop + 0)
_lbBMP.UnlockBits()
Dim bmpScaled As Bitmap = New Bitmap(150, 150) '' Wenn gezeichnetes Bitmap gleich null tritt exeption auf!!!
Using grp = Graphics.FromImage(bmpScaled)
grp.DrawImage(bmp, New Rectangle(0, 0, 150, 150), _rect, GraphicsUnit.Pixel)
End Using
Return bmpScaled
End Function
Public Shared Function Image2Bool(img As Image) As Boolean()()
'Dim bmp As New Bitmap(img)
Dim bmp As New LockBits(CType(img, Bitmap))
bmp.LockBits()
Dim s As Boolean()() = New Boolean(bmp.Height - 1)() {}
For y As Integer = 0 To bmp.Height - 1
s(y) = New Boolean(bmp.Width - 1) {}
For x As Integer = 0 To bmp.Width - 1
s(y)(x) = bmp.GetPixel(x, y).GetBrightness() < 0.3
Next
Next
bmp.UnlockBits()
Return s
End Function
Public Shared Function Bool2Image(s As Boolean()()) As Image
Dim bmp As New Bitmap(s(0).Length, s.Length)
Using g As Graphics = Graphics.FromImage(bmp)
g.Clear(Color.White)
End Using
Dim _LB As New LockBits(bmp)
_LB.LockBits()
For y As Integer = 0 To _LB.Height - 1
For x As Integer = 0 To _LB.Width - 1
If s(y)(x) Then
_LB.SetPixel(x, y, Color.Black)
End If
Next
Next
_LB.UnlockBits()
Return DirectCast(bmp, Bitmap)
End Function
Public Shared Function ZhangSuenThinning(s As Boolean()()) As Boolean()()
Dim temp As Boolean()() = ArrayClone(s)
' make a deep copy to start..
Dim count As Integer = 0
Do
' the missing iteration
count = [step](1, temp, s)
temp = ArrayClone(s)
' ..and on each..
count += [step](2, temp, s)
' ..call!
temp = ArrayClone(s)
Loop While count > 0
Return s
End Function
Private Shared Function [step](stepNo As Integer, temp As Boolean()(), s As Boolean()()) As Integer
Dim count As Integer = 0
For a As Integer = 1 To temp.Length - 2
For b As Integer = 1 To temp(0).Length - 2
If SuenThinningAlg(a, b, temp, stepNo = 2) Then
' still changes happening?
If s(a)(b) Then
count += 1
End If
s(a)(b) = False
End If
Next
Next
Return count
End Function
Private Shared Function SuenThinningAlg(x As Integer, y As Integer, s As Boolean()(), even As Boolean) As Boolean
Dim p2 As Boolean = s(x)(y - 1)
Dim p3 As Boolean = s(x + 1)(y - 1)
Dim p4 As Boolean = s(x + 1)(y)
Dim p5 As Boolean = s(x + 1)(y + 1)
Dim p6 As Boolean = s(x)(y + 1)
Dim p7 As Boolean = s(x - 1)(y + 1)
Dim p8 As Boolean = s(x - 1)(y)
Dim p9 As Boolean = s(x - 1)(y - 1)
Dim bp1 As Integer = NumberOfNonZeroNeighbors(x, y, s)
If bp1 >= 2 AndAlso bp1 <= 6 Then
'2nd condition
If NumberOfZeroToOneTransitionFromP9(x, y, s) = 1 Then
If even Then
If Not ((p2 AndAlso p4) AndAlso p8) Then
If Not ((p2 AndAlso p6) AndAlso p8) Then
Return True
End If
End If
Else
If Not ((p2 AndAlso p4) AndAlso p6) Then
If Not ((p4 AndAlso p6) AndAlso p8) Then
Return True
End If
End If
End If
End If
End If
Return False
End Function
Private Shared Function NumberOfZeroToOneTransitionFromP9(x As Integer, y As Integer, s As Boolean()()) As Integer
Dim p2 As Boolean = s(x)(y - 1)
Dim p3 As Boolean = s(x + 1)(y - 1)
Dim p4 As Boolean = s(x + 1)(y)
Dim p5 As Boolean = s(x + 1)(y + 1)
Dim p6 As Boolean = s(x)(y + 1)
Dim p7 As Boolean = s(x - 1)(y + 1)
Dim p8 As Boolean = s(x - 1)(y)
Dim p9 As Boolean = s(x - 1)(y - 1)
Dim A As Integer = Convert.ToInt32((Not p2 AndAlso p3)) + Convert.ToInt32((Not p3 AndAlso p4)) + Convert.ToInt32((Not p4 AndAlso p5)) + Convert.ToInt32((Not p5 AndAlso p6)) + Convert.ToInt32((Not p6 AndAlso p7)) + Convert.ToInt32((Not p7 AndAlso p8)) + Convert.ToInt32((Not p8 AndAlso p9)) + Convert.ToInt32((Not p9 AndAlso p2))
Return A
End Function
Private Shared Function NumberOfNonZeroNeighbors(x As Integer, y As Integer, s As Boolean()()) As Integer
Dim count As Integer = 0
If s(x - 1)(y) Then
count += 1
End If
If s(x - 1)(y + 1) Then
count += 1
End If
If s(x - 1)(y - 1) Then
count += 1
End If
If s(x)(y + 1) Then
count += 1
End If
If s(x)(y - 1) Then
count += 1
End If
If s(x + 1)(y) Then
count += 1
End If
If s(x + 1)(y + 1) Then
count += 1
End If
If s(x + 1)(y - 1) Then
count += 1
End If
Return count
End Function
Public Shared Function ArrayClone(Of T)(A__1 As T()()) As T()()
Return A__1.[Select](Function(a__2) a__2.ToArray()).ToArray()
End Function
Public Function getPointerTo(ByRef obj As Object) As Object
Return obj
End Function
End Class

LockBits-Klasse:

Spoiler anzeigen

VB.NET-Quellcode

Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices
Public Class LockBits
Implements IDisposable
Private source As Bitmap = Nothing
Private Iptr As IntPtr = IntPtr.Zero
Private bitmapData As BitmapData = Nothing
Private m_Pixels As Byte()
Private m_Depth As Integer
Private m_Width As Integer
Private m_Height As Integer
Public Property Pixels() As Byte()
Get
Return m_Pixels
End Get
Set(value As Byte())
m_Pixels = value
End Set
End Property
Public Property _BitmapData() As BitmapData
Get
Return bitmapData
End Get
Set(value As BitmapData)
bitmapData = value
End Set
End Property
Private Property Depth() As Integer
Get
Return m_Depth
End Get
Set(value As Integer)
m_Depth = value
End Set
End Property
Public Property Width() As Integer
Get
Return m_Width
End Get
Set(value As Integer)
m_Width = value
End Set
End Property
Public Property Height() As Integer
Get
Return m_Height
End Get
Set(value As Integer)
m_Height = value
End Set
End Property
Public ReadOnly Property Bitmap() As Bitmap
Get
Return source
End Get
End Property
Public Sub New(source As Bitmap)
Me.source = source
End Sub
''' <summary>
''' Lock bitmap data
''' </summary>
Public Sub LockBits()
Try
' Get width and height of bitmap
Width = source.Width
Height = source.Height
' get total locked pixels count
Dim PixelCount As Integer = Width * Height
' Create rectangle to lock
Dim rect As New Rectangle(0, 0, Width, Height)
' get source bitmap pixel format size
Depth = System.Drawing.Bitmap.GetPixelFormatSize(source.PixelFormat)
' Check if bpp (Bits Per Pixel) is 8, 24, or 32
If Depth <> 8 AndAlso Depth <> 24 AndAlso Depth <> 32 Then
Throw New ArgumentException("Only 8, 24 and 32 bpp images are supported.")
End If
' Lock bitmap and return bitmap data
bitmapData = source.LockBits(rect, ImageLockMode.ReadWrite, source.PixelFormat)
'Debug.WriteLine(bitmapData.Stride)
' create byte array to copy pixel values
Dim [step] As Integer = Depth \ 8
Pixels = New Byte(PixelCount * [step] - 1) {}
Iptr = bitmapData.Scan0
' Copy data from pointer to array
Marshal.Copy(Iptr, Pixels, 0, Pixels.Length)
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try
End Sub
''' <summary>
''' Unlock bitmap data
''' </summary>
Public Sub UnlockBits()
Try
' Copy data from byte array to pointer
Marshal.Copy(Pixels, 0, Iptr, Pixels.Length)
' Unlock bitmap data
source.UnlockBits(bitmapData)
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try
End Sub
''' <summary>
''' Get the color of the specified pixel
''' </summary>
''' <param name="x"></param>
''' <param name="y"></param>
''' <returns></returns>
Public Function GetPixel(x As Integer, y As Integer) As Color
Dim clr As Color = Color.Empty
' Get color components count
Dim cCount As Integer = Depth \ 8
' Get start index of the specified pixel
Dim i As Integer = ((y * Width) + x) * cCount
If i > Pixels.Length - cCount Then
Throw New IndexOutOfRangeException()
End If
If Depth = 32 Then
' For 32 bpp get Red, Green, Blue and Alpha
Dim b As Byte = Pixels(i)
Dim g As Byte = Pixels(i + 1)
Dim r As Byte = Pixels(i + 2)
Dim a As Byte = Pixels(i + 3)
' a
clr = Color.FromArgb(a, r, g, b)
End If
If Depth = 24 Then
' For 24 bpp get Red, Green and Blue
Dim b As Byte = Pixels(i)
Dim g As Byte = Pixels(i + 1)
Dim r As Byte = Pixels(i + 2)
clr = Color.FromArgb(r, g, b)
End If
If Depth = 8 Then
' For 8 bpp get color value (Red, Green and Blue values are the same)
Dim c As Byte = Pixels(i)
clr = Color.FromArgb(c, c, c)
End If
Return clr
End Function
''' <summary>
''' Set the color of the specified pixel
''' </summary>
''' <param name="x"></param>
''' <param name="y"></param>
''' <param name="color"></param>
Public Sub SetPixel(x As Integer, y As Integer, color As Color)
' Get color components count
Dim cCount As Integer = Depth \ 8
' Get start index of the specified pixel
Dim i As Integer = ((y * Width) + x) * cCount
If Depth = 32 Then
' For 32 bpp set Red, Green, Blue and Alpha
Pixels(i) = color.B
Pixels(i + 1) = color.G
Pixels(i + 2) = color.R
Pixels(i + 3) = color.A
End If
If Depth = 24 Then
' For 24 bpp set Red, Green and Blue
Pixels(i) = color.B
Pixels(i + 1) = color.G
Pixels(i + 2) = color.R
End If
If Depth = 8 Then
' For 8 bpp set color value (Red, Green and Blue values are the same)
Pixels(i) = color.B
End If
End Sub
#Region "IDisposable Support"
Private disposedValue As Boolean ' So ermitteln Sie überflüssige Aufrufe
' IDisposable
Protected Overridable Sub Dispose(disposing As Boolean)
If Not Me.disposedValue Then
If disposing Then
' TODO: Verwalteten Zustand löschen (verwaltete Objekte).
End If
' TODO: Nicht verwaltete Ressourcen (nicht verwaltete Objekte) freigeben und Finalize() unten überschreiben.
' TODO: Große Felder auf NULL festlegen.
End If
Me.disposedValue = True
End Sub
' TODO: Finalize() nur überschreiben, wenn Dispose(ByVal disposing As Boolean) oben über Code zum Freigeben von nicht verwalteten Ressourcen verfügt.
'Protected Overrides Sub Finalize()
' ' Ändern Sie diesen Code nicht. Fügen Sie oben in Dispose(ByVal disposing As Boolean) Bereinigungscode ein.
' Dispose(False)
' MyBase.Finalize()
'End Sub
' Dieser Code wird von Visual Basic hinzugefügt, um das Dispose-Muster richtig zu implementieren.
Public Sub Dispose() Implements IDisposable.Dispose
' Ändern Sie diesen Code nicht. Fügen Sie oben in Dispose(disposing As Boolean) Bereinigungscode ein.
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class

Boolean(,) to Byte() / 2-dim Array in 1-dim Array konvertieren

Boolean(,) to Byte() / 2-dim Array in 1-dim Array konvertieren

Quellcode

Quellcode

Quellcode

Quellcode

Morrison schrieb:

Morrison schrieb:

Quellcode

Morrison schrieb:

Morrison schrieb:

Quellcode

Quellcode

Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

Ähnliche Themen

5 Benutzer haben hier geschrieben