|
Pro obraznost jde o něco na tento způsob, všimnul jsem si v druhém vlákně, že je potřeba to patřičně rozvést... ;) Vypadá, že hodnoty pro každý pixel (24bit/pixel) jsou v poli za sebou r,b,g první , pak r,b,g druhý atd. Nepotřebuji ořízlou image ukládat, jde mi pouze o to za běhu zobrazit z obrázku maximum na minimálním prostoru v přiměřeném čase. Prvopokusy trvaly nekonečně dlouho, tohle je trochu lepší. A tak přikládám pokus s ořezáním obrázku v pictureboxu :
Sub CropImage(ByVal pb As PictureBox)
Dim sw As Stopwatch = Stopwatch.StartNew
Dim bmp As Bitmap = pb.Image
Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
Dim bmpData As System.Drawing.Imaging.BitmapData = bmp.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadOnly, PixelFormat.Format24bppRgb)
' Get the address of the first line.
Dim ptr As IntPtr = bmpData.Scan0
' Declare an array to hold the bytes of the bitmap.
' This code is specific to a bitmap with 24 bits per pixels.
Dim bytes As Integer = bmp.Width * bmp.Height * 3
Dim rgbValues As Byte() = New Byte(bytes - 1) {}
' Copy the RGB values into the array.
System.Runtime.InteropServices.Marshal.Copy(ptr, rgbValues, 0, bytes)
bmp.UnlockBits(bmpData)
Dim points As New List(Of Point)
'Add points of all colors except white.
For y As Integer = 0 To bmp.Height - 1
For x As Integer = 0 To bmp.Width - 1
' Process the pixel's bytes.
Dim r, b, g As Byte
Dim i As Integer = (x + y * bmp.Width) * 3
r = rgbValues(i)
b = rgbValues(i + 1)
g = rgbValues(i + 2)
If Not (r = 255 And b = 255 And g = 255) Then
points.Add(New Point(x, y))
End If
Next x
Next y
If Not points.Count > 0 Then Exit Sub
'Get bounding box for list of points.
Dim rct As Rectangle = BoundingBox(points)
'Crop original image.
Dim bmpc = New Bitmap(rct.Width, rct.Height)
Using g As Graphics = Graphics.FromImage(bmpc)
g.DrawImage(pb.Image, 0, 0, rct, GraphicsUnit.Pixel)
End Using
pb.Image = bmpc
sw.Stop()
Debug.Print("Finished at " & sw.Elapsed.TotalSeconds.ToString("0.0s"))
sw = Nothing
End Sub
Myslím si, že je to lepší, než čtyři cykly z každé strany, jak jsem psal výše. Inspirováno dle link pod kódem, pro vb.net by to mohlo vypadat nějak takhle:
' Find the list's bounding box.
Private Function BoundingBox(ByVal points As IEnumerable(Of Point)) As Rectangle
Dim x_query = From p In points Select p.X
Dim xmin As Integer = x_query.Min()
Dim xmax As Integer = x_query.Max()
Dim y_query = From p In points Select p.Y
Dim ymin As Integer = y_query.Min()
Dim ymax As Integer = y_query.Max()
Return New Rectangle(xmin, ymin, xmax - xmin, ymax - ymin)
End Function
Inspirace dle C# linq tip jak najít obdélník, který orámuje všechny nalezené body : http://csharphelper.com/blog/2014/11/use... Nejsem si jist, doufám, že mám LockBits a UnlockBits použito správně, možná existuje i jiný způsob? Takhle by mělo být stále rychlejší než pomocí GetPixel(x,y). Obrázky 640x480 mi ořízne v rozmezí 0,2-0,4s zřejmě v závislosti na počtu nebílých bodů. Vaše postřehy a připomínky vítány.
|