Q> If showing all the RGB pixel value of a 60*66 PNG image takes 10-34 seconds then how Image Viewer shows image instantly ?
Dim clr As Integer ' or string
Dim xmax As Integer
Dim ymax As Integer
Dim x As Integer
Dim y As Integer
Dim bm As New Bitmap(dlgOpen.FileName)
xmax = bm.Width - 1
ymax = bm.Height - 1
For y = 0 To ymax
For x = 0 To xmax
With bm.GetPixel(x, y)
clr = .R & .G & .B
txtValue.AppendText(clr)
End With
Next x
Next y
Edit
Dim bmp As New Bitmap(dlgOpen.FileName)
Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
Dim bmpData As System.Drawing.Imaging.BitmapData = bmp.LockBits(rect,Drawing.Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat)
Dim ptr As IntPtr = bmpData.Scan0
Dim bytes As Integer = Math.Abs(bmpData.Stride) * bmp.Height
Dim rgbValues(bytes - 1) As Byte
System.Runtime.InteropServices.Marshal.Copy(ptr, rgbValues, 0, bytes)
For counter As Integer = 0 To rgbValues.Length - 1
txtValue.AppendText(rgbValues(counter))
Next
System.Runtime.InteropServices.Marshal.Copy(rgbValues, 0, ptr, bytes)
bmp.UnlockBits(bmpData)
The first code takes 10 seconds and the 2nd one around 34 seconds for showing all the value in a textbox for a 59*66 PNG image on AMD A6 3500 with 4 GB RAM !
The problem exist when reading from file and writing to a textbox takes place in same time !
The problem is that the feature you're using, GetPixel, is very slow if you need to access a lot of pixels. Try using LockBits. You can use that to gather image data nearly instantly.
Using the LockBits method to access image data.
Related
Given an jpg image slightly larger than 19" x 23" I need to crop it to exactly 19" x 23" and preserve the original quality using VB.NET.
I can do this in MS paint, If I open a 2851 x 4651 200 DPI jpg and use the Image Properties dialog I can change the width and Height to 3800 x 4600 (exactly 19" x 23" # 200 DPI).
The resultant image is identical to the original in quality and compression but is cropped on the right and bottom by the 51 pixels. The file size is slightly smaller as expected.
When I use the many techniques I have found on SO to crop/resize an image when I save the image it always saves as 96 DPI. I can adjust the width and height to accommodate the 96 DPI so the end result is exactly 19" x 23", however the resulting pixilation is higher than the original, and the files size is considerably smaller, so obvious quality loss.
What I want is to do is (a simple?) crop like MS paint does. Just take a little off the side and bottom, but I cannot seem to save an image with anything other than 96 DPI.
If I can figure out how to the save the cropped file at 200 DPI (or whatever the original image was) I think what I have will work fine.
I am willing to use an external library if that is what it takes.
Here is one example that works in the sense that the resulting image is 19" x 23" and the image is actually scaled preserving the aspect ratio, however the quality is less than the original.
This code is from another SO answer with some minor modifications.
Public Shared Function ResizeImage(SourceImage As Drawing.Image, TargetWidthIn As Decimal, TargetHeightIn As Decimal) As Drawing.Bitmap
'Dim TargetWidth As Integer = TargetWidthIn * SourceImage.HorizontalResolution
'Dim TargetHeight As Integer = TargetHeightIn * SourceImage.VerticalResolution
Dim TargetWidth As Integer = TargetWidthIn * 96
Dim TargetHeight As Integer = TargetHeightIn * 96
Dim bmSource = New Drawing.Bitmap(SourceImage)
Dim bmDest As New Drawing.Bitmap(TargetWidth, TargetHeight, Drawing.Imaging.PixelFormat.Format32bppArgb)
Dim nSourceAspectRatio = bmSource.Width / bmSource.Height
Dim nDestAspectRatio = bmDest.Width / bmDest.Height
Dim NewX = 0
Dim NewY = 0
Dim NewWidth = bmDest.Width
Dim NewHeight = bmDest.Height
If nDestAspectRatio = nSourceAspectRatio Then
'same ratio
ElseIf nDestAspectRatio > nSourceAspectRatio Then
'Source is taller
NewWidth = Convert.ToInt32(Math.Floor(nSourceAspectRatio * NewHeight))
NewX = Convert.ToInt32(Math.Floor((bmDest.Width - NewWidth) / 2))
Else
'Source is wider
NewHeight = Convert.ToInt32(Math.Floor((1 / nSourceAspectRatio) * NewWidth))
NewY = Convert.ToInt32(Math.Floor((bmDest.Height - NewHeight) / 2))
End If
Using grDest = Drawing.Graphics.FromImage(bmDest)
With grDest
.CompositingQuality = Drawing.Drawing2D.CompositingQuality.HighQuality
'.InterpolationMode = Drawing.Drawing2D.InterpolationMode.HighQualityBicubic
.InterpolationMode = Drawing.Drawing2D.InterpolationMode.NearestNeighbor
.PixelOffsetMode = Drawing.Drawing2D.PixelOffsetMode.HighQuality
.CompositingMode = Drawing.Drawing2D.CompositingMode.SourceCopy
'.SmoothingMode = Drawing.Drawing2D.SmoothingMode.AntiAlias
'.CompositingMode = Drawing.Drawing2D.CompositingMode.SourceOver
.DrawImage(bmSource, NewX, NewY, NewWidth, NewHeight)
End With
End Using
Return bmDest
End Function
I found a solution on SO here
I modifyed my original code above to keep the DPI of the original image:
Dim TargetWidth As Integer = TargetWidthIn * SourceImage.HorizontalResolution
Dim TargetHeight As Integer = TargetHeightIn * SourceImage.VerticalResolution
Then after the call to ResizeImage:
Select Case imageType.ToLower
Case "jpg"
Dim jpgEncoder As ImageCodecInfo = GetEncoder(ImageFormat.Jpeg)
Dim myEncoder As System.Drawing.Imaging.Encoder = System.Drawing.Imaging.Encoder.Quality
Dim myEncoderParams As New EncoderParameters(1)
Dim myEncoderQuality As New EncoderParameter(myEncoder, CType(98L, Int32)) '98%
myEncoderParams.Param(0) = myEncoderQuality
bm.SetResolution(img.HorizontalResolution, img.VerticalResolution)
bm.Save(tempfile, jpgEncoder, myEncoderParams)
Case "png", "gif"
bm.Save(tempfile, System.Drawing.Imaging.ImageFormat.Png)
Case "tiff", "tif"
bm.Save(tempfile, System.Drawing.Imaging.ImageFormat.Tiff)
Case Else
bm.Save(tempfile, System.Drawing.Imaging.ImageFormat.Png)
End Select
bm.Dispose()
I only use jpg now so I don't know if the tiff and png parts work, but it seems using the jpeg encoder allowed me to save the file with 200 DPI and maintain the original quality.
Here is the GetEncoder part that is missing from the other post:
Private Shared Function GetEncoder(f As Drawing.Imaging.ImageFormat) As ImageCodecInfo
Dim myEncoders() As ImageCodecInfo
myEncoders = ImageCodecInfo.GetImageEncoders()
Dim numEncoders As Integer = myEncoders.GetLength(0)
Dim strNumEncoders As String = numEncoders.ToString()
' Get the info. for all encoders in the array.
If numEncoders > 0 Then
Dim myEncoderInfo(numEncoders * 10) As String
For i As Integer = 0 To numEncoders - 1
If myEncoders(i).FilenameExtension.Contains(f.ToString.ToUpper) Then
Return myEncoders(i)
End If
Next
End If
Return Nothing
I'm using Logo right now and i'm making a project and basically i want to turn your recorded voice into something visual, only problem is when i go to find code it re that works it requires 1: A picture box and 2: to manually grab the sound .wav file and place it. I already made code to record my voice and to make it into a .Wav file and i already have code to visualize it, just when i run it it appears as a thick square of lines rather than the example i shown. Note: I'm not drawing into a picturebox, i'm drawing directly into the Form by using g.drawline(bleh,bleh,bleh,bleh).
(Example: http://static1.1.sqspcdn.com/static/f/335152/16812948/1330286658510/76_dsc3616.jpeg?token=R1zPNnr9PAoB3WvnDxfFFFvzkMw%3D )
The code im trying to run:
Public Sub DrawSound(x As Integer, y As Integer)
Dim samplez As New List(Of Short)
Dim maxamount As Short
Dim pic As New Bitmap(x, y)
Dim ratio As Integer = (samplez.Count - 1) / (y - 1) 'If there are 10000 samples and 200 pixels, this would be every 50th sample is shown
Dim halfpic As Integer = (x / 2) 'Simply half the height of the picturebox
GC.Collect()
Dim wavefile() As Byte = IO.File.ReadAllBytes("C:\Users\" & Environ$("Username") & "\Documents\Sounds\Mic.wav")
GC.Collect()
Dim memstream As New IO.MemoryStream(wavefile)
Dim binreader As New IO.BinaryReader(memstream)
Dim ChunkID As Integer = binreader.ReadInt32()
Dim filesize As Integer = binreader.ReadInt32()
Dim rifftype As Integer = binreader.ReadInt32()
Dim fmtID As Integer = binreader.ReadInt32()
Dim fmtsize As Integer = binreader.ReadInt32()
Dim fmtcode As Integer = binreader.ReadInt16()
Dim channels As Integer = binreader.ReadInt16()
Dim samplerate As Integer = binreader.ReadInt32()
Dim fmtAvgBPS As Integer = binreader.ReadInt32()
Dim fmtblockalign As Integer = binreader.ReadInt16()
Dim bitdepth As Integer = binreader.ReadInt16()
If fmtsize = 18 Then
Dim fmtextrasize As Integer = binreader.ReadInt16()
binreader.ReadBytes(fmtextrasize)
End If
Dim DataID As Integer = binreader.ReadInt32()
Dim DataSize As Integer = binreader.ReadInt32()
samplez.Clear()
For i = 0 To (DataSize - 3) / 2
samplez.Add(binreader.ReadInt16())
If samplez(samplez.Count - 1) > maxamount Then 'Using this for the pic
maxamount = samplez(samplez.Count - 1)
End If
Next
For i = 1 To x - 10 Step 2 'Steping 2 because in one go, we do 2 samples
Dim leftdata As Integer = Math.Abs(samplez(i * ratio)) 'Grabbing that N-th sample to display. Using Absolute to show them one direction
Dim leftpercent As Single = leftdata / (maxamount * 2) 'This breaks it down to something like 0.0 to 1.0. Multiplying by 2 to make it half.
Dim leftpicheight As Integer = leftpercent * x 'So when the percent is tied to the height, its only a percent of the height
g.DrawLine(Pens.LimeGreen, i, halfpic, i, leftpicheight + halfpic) 'Draw dat! The half pic puts it in the center
Dim rightdata As Integer = Math.Abs(samplez((i + 1) * ratio)) 'Same thing except we're grabbing i + 1 because we'd skip it because of the 'step 2' on the for statement
Dim rightpercent As Single = -rightdata / (maxamount * 2) 'put a negative infront of data so it goes down.
Dim rightpicheight As Integer = rightpercent * x
g.DrawLine(Pens.Blue, i, halfpic, i, rightpicheight + halfpic)
Next
End Sub
X and Y is the middle of the form. And i also would link where i got the code but i forgot where and also, i modified it in attempt to run it directly into he form rather than a picturebox. It worked sorta haha (And there is so many unused dims but all i know is, once i remove one none of the code works haha) So could anyone help?
I'm writing a Visual Basic application that takes a screenshot of the desktop and crops it down to a 200px by 200px image around the center of the screen. One part of the application would iterate through each pixel and check if the RGB of that pixel is a certain color (this is meant to take under a second for it to be efficient), and unfortunately Bitmap.Getpixel is not doing me any good whether or not It's being loaded into the memory via Bitmap.Lock or not.
Is there a faster (almost instantaneous) way of doing so? Thanks.
Sure there is. Typically what you do is :
for each pixel
Get device contex
Read Pixel
Release device contex (unless you want memory leak)
For this to work you need few external windows library calls, ex :
[DllImport("user32.dll")]
static extern IntPtr GetDC(IntPtr hwnd);
[DllImport("user32.dll")]
static extern Int32 ReleaseDC(IntPtr hwnd, IntPtr hdc);
[DllImport("gdi32.dll")]
static extern uint GetPixel(IntPtr hdc, int nXPos, int nYPos);
static public System.Drawing.Color getPixelColor(int x, int y) {
IntPtr hdc = GetDC(IntPtr.Zero);
uint pixel = GetPixel(hdc, x, y);
ReleaseDC(IntPtr.Zero, hdc);
Color color = Color.FromArgb((int)(pixel & 0x000000FF),
(int)(pixel & 0x0000FF00) >> 8,
(int)(pixel & 0x00FF0000) >> 16);
return color;
}
It would be much better to
GetDC
for each pixel
read pixel and store value
ReleaseDC
However I have found that get pixel method itself is slow. Therefore to get better performance just grab the entire screen into a bitmap and get the pixels from there.
Here is some sample code in c#, you can convert it in VB.net if you want using online converters:
var maxX=200;
var maxY=200;
var screensize = Screen.PrimaryScreen.Bounds;
var xCenterSub100 = (screensize.X-maxX)/2;
var yCenterSub100 = (screensize.Y-maxY)/2;
Bitmap hc = new Bitmap(maxX, maxY);
using (Graphics gf = Graphics.FromImage(hc)){
gf.CopyFromScreen(xCenterSub100, yCenterSub100, 0, 0, new Size(maxX, maxY), CopyPixelOperation.SourceCopy);
//...
for (int x = 0; x < maxX; x++){
for (int y = 0; y < maxY; y++){
var pColor = hc.GetPixel(x, y);
//do something with the color...
}
}
}
In Vb.net (using http://converter.telerik.com/) :
Dim maxX = 200
Dim maxY = 200
Dim screensize = Screen.PrimaryScreen.Bounds
Dim xCenterSub100 = (screensize.X - maxX) / 2
Dim yCenterSub100 = (screensize.Y - maxY) / 2
Dim hc As New Bitmap(maxX, maxY)
Using gf As Graphics = Graphics.FromImage(hc)
gf.CopyFromScreen(xCenterSub100, yCenterSub100, 0, 0, New Size(maxX, maxY), CopyPixelOperation.SourceCopy)
'...
For x As Integer = 0 To maxX - 1
For y As Integer = 0 To maxY - 1
Dim pColor = hc.GetPixel(x, y)
'do something with the color...
Next
Next
End Using
With c# on my old computer i got around 30 fps, run time is about 35ms. There are faster ways, but they start to abuse several things to get that speed. Note that you do not use the getPixelColor, it is here just for reference. You instead use the screen scraped image method.
If you don't wish to resort to p/invoke, you can use the LockBits method. This code sets each component of a 200 x 200 area at the center of a bitmap in a PictureBox to a random value. It runs in about 100 milliseconds (not counting the refresh of the PictureBox).
EDIT: I realized you were trying to read pixels, so I added a line to show how to do that.
Private Sub DoGraphics()
Dim x As Integer
Dim y As Integer
'PixelSize is 4 bytes for a 32bpp Argb image.
'Change this value appropriately
Dim PixelSize As Integer = 4
Dim rnd As New Random()
'This code uses a bitmap that is loaded in a picture box.
'Any bitmap should work.
Dim bm As Bitmap = Me.PictureBox1.Image
'lock an area of the bitmap for editing that is 200 x 200 pixels in the center.
Dim bmd As BitmapData = bm.LockBits(New Rectangle((bm.Width - 200) / 2, (bm.Height - 200) / 2, 200, 200), System.Drawing.Imaging.ImageLockMode.ReadOnly, bm.PixelFormat)
'loop through the locked area of the bitmap.
For y = 0 To bmd.Height - 1
For x = 0 To bmd.Width - 1
'Get the various pixel locations This calculation is for a 32bpp Argb bitmap
Dim blue As Integer = (bmd.Stride * y) + (PixelSize * x)
Dim green As Integer = blue + 1
Dim red As Integer = green + 1
Dim alpha As Integer = red + 1
'Set each component of the pixel to a random rgb value.
'There are 4 bytes that make up each pixel (32bpp Argb)
Marshal.WriteByte(bmd.Scan0, red, CByte(rnd.Next(0, 256)))
Marshal.WriteByte(bmd.Scan0, blue, CByte(rnd.Next(0, 256)))
Marshal.WriteByte(bmd.Scan0, green, CByte(rnd.Next(0, 256)))
Marshal.WriteByte(bmd.Scan0, alpha, 255)
'Use the ReadInt32() method to read back the entire pixel
Dim intColor As Integer = Marshal.ReadInt32(bmd.Scan0)
If intColor = Color.Blue.ToArgb() Then
'The pixel is blue
Else
'The pixel is not blue
End If
Next
Next
'Important!
bm.UnlockBits(bmd)
Me.PictureBox1.Refresh()
End Sub
I was tasked today after creating a program to Add watermarks to also create one to remove that same watermark.
My thoughts are that it is now part of the image and can't be removed so easily.
Is this accurate or is the actually a way? ( that doesnt take 10 years)
thanks for any hints
Here is my code to add the watermarks:
Dim watermark_bm As Bitmap = Global.AnchorAuditor.My.Resources.Logo_White
Dim watermark_bm2 As Bitmap = Global.AnchorAuditor.My.Resources.CLS_Logo_White_Engineering
'watermark_bm2.MakeTransparent()
' WATERMARK IMAGE 1 - AA
Using str As Stream = File.OpenRead(s)
Dim or_bm As Bitmap = Image.FromStream(str)
'''''''''''''''''''''''''START IMAGE 1''''''''''''''''''''''''''
or_bm.SetResolution(20, 20)
Dim x1 As Integer = or_bm.Width - 300
Dim Y As Integer = or_bm.Height - 300
Const ALPHA As Byte = 128
' Set the watermark's pixels' Alpha components.
Dim clr As Color
For py As Integer = 0 To watermark_bm.Height - 1
For px As Integer = 0 To watermark_bm.Width - 1
clr = watermark_bm.GetPixel(px, py)
watermark_bm.SetPixel(px, py, _
Color.FromArgb(ALPHA, clr.R, clr.G, clr.B))
Next px
Next py
' Set the watermark's transparent color.
watermark_bm.MakeTransparent(watermark_bm.GetPixel(0, _
0))
' Copy onto the result image.
Dim gr As Graphics = Graphics.FromImage(or_bm)
gr.DrawImage(watermark_bm, x1, Y)
'''''''''''''''''''''''''END IMAGE 1 START IMAGE 2''''''''''''''''''''''''''
or_bm.SetResolution(60, 60)
Dim x2 As Integer = 75
Dim Y1 As Integer = 75
Const ALPHA1 As Byte = 128
' Set the watermark's pixels' Alpha components.
Dim clr1 As Color
For py As Integer = 0 To watermark_bm2.Height - 1
For px As Integer = 0 To watermark_bm2.Width - 1
clr1 = watermark_bm2.GetPixel(px, py)
watermark_bm2.SetPixel(px, py, _
Color.FromArgb(ALPHA1, clr1.R, clr1.G, clr1.B))
Next px
Next py
' Set the watermark's transparent color.
watermark_bm2.MakeTransparent(watermark_bm2.GetPixel(0, _
0))
' Copy onto the result image.
Dim gr1 As Graphics = Graphics.FromImage(or_bm)
gr1.DrawImage(watermark_bm2, x2, Y1)
''''''''''''''''''''''''END IMAGE 2'''''''''''''''''''''''''''
or_bm.Save(s & "deleteme.jpg", _
System.Drawing.Imaging.ImageFormat.Jpeg)
End Using
You're correct - adding a watermark is far easier than removing it. The standard approach is to keep a copy of the original someplace and use that instead of trying to manipulate the image afterwards.
Having a problem with the amount of memory being used going up and up, and expanding until there is no memory left. I'm using the GHeat.Net plugin to build images. Here is the full code:
Dim pm As New gheat.PointManager()
Dim g As Graphics
Dim startZoom As Integer = 2
Dim maxZoom As Integer = 17
gheat.Settings.BaseDirectory = "C:\\gheatWeb\\__\\etc\\"
pm.LoadPointsFromFile("C:\\points.txt")
For zoom As Integer = startZoom To maxZoom
Dim startX As Integer = 0
Dim startY As Integer = 0
Dim maxX As Integer = 2 ^ zoom
Dim maxY As Integer = 2 ^ zoom
For x As Integer = startX To maxX
For y As Integer = startY To maxY
Dim filename As String = "C:\\images\\" + zoom.ToString + "\\x" + x.ToString + "y" + y.ToString + "zoom" + zoom.ToString + ".gif"
gheat.GHeat.GetTile(pm, "classic", zoom, x, y).Save(filename, System.Drawing.Imaging.ImageFormat.Gif)
Next
Next
Next
For some reason, when I hit the for loops, the amount of memory used just goes up and up and up, until it hits a ceiling. Even then, the program keeps running, but the amount of memory doesn't go up. The program generates fine at 20Mb, so I can't figure out why it just keeps going up.
I've also tried GC.Collect at the end of the innermost loop, to no avail. Any ideas?
GHeat.GetTile returns a Bitmap which must be disposed.
Also, there's no need to escape paths like that in VB.
For x As Integer = startX To maxX
For y As Integer = startY To maxY
Dim filename As String = String.Format("C:\images\{0}\x{1}y{2}zoom{3}.gif", zoom, x, y, zoom)
Using img = gheat.GHeat.GetTile(pm, "classic", zoom, x, y)
img.Save(filename, System.Drawing.Imaging.ImageFormat.Gif)
End Using
Next
Next