vb.net Image Manipulation - vb.net

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.

Related

VB.net crop an image (jpg) like ms paint with no quality loss

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

Using Logo to draw sound

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?

Attribute a code for every color

Is there any way to attribute a code for every color, and be able to read them? Programatically I mean.
My target is to convert an image into code, then convert it back to image.
Each color has 4 fields (For some images, you only have 3 fields with meaningful information)
These fields include:
Alpha (A) (This represents opacity of the pixel)
Red (R) (Red intensity)
Green (G) (Green intensity)
Blue (B) (Blue intensity)
What you would do is read them and generate a code string for each one by concatenating the values to one another.
This can most likely be considered pseudo-code as I did not check if it compiles, but you should be doing something along the lines of this.
Dim pixelColor As Color
Dim image As BitMap = New BitMap("your_image.png")
Dim a As String
Dim r As String
Dim b As String
Dim g As String
Dim fileString As New StringBuilder()
fileString.AppendLine(image.Size.Width.ToString())
fileString.AppendLine(image.Size.Height.ToString())
' Loop over all pixels
For y As Integer = 0 To image.Size.Height - 1
For x As Integer = 0 To image.Size.Width - 1
pixelColor = image.GetPixel(x, y)
' get ARGB values as strings
a = pixelColor.A.ToString()
r = pixelColor.R.ToString()
g = pixelColor.G.ToString()
b = pixelColor.B.ToString()
' Append the colors, one pixel per line
fileString.AppendLine(a & " " & r & " " & g & " " & b)
Next
Next
Using file As New StreamWriter("image_data.txt")
outfile.Write(fileString.ToString())
End Using
Again, this probably doesn't compile. (I don't have a compiler with me at the moment)
edit:
I realized that the width and height need to be stored as well.
As for reading the file:
Dim file As System.IO.StreamReader
file = File.OpenText("text_file.txt")
Dim width As Integer = Convert.ToInt32(file.ReadLine)
Dim height As Integer = Convert.ToInt32(file.ReadLine)
Dim image As BitMap = New BitMap(width, height)
Dim currentX As Integer = 0
Dim currentY As Integer = 0
Do Until file.EndOfStream
Dim line As String = file.ReadLine
Dim valueArray(4) As String = line.Split(" ")
Dim a As Integer = Convert.ToInt16(valueArray(0))
Dim r As Integer = Convert.ToInt16(valueArray(1))
Dim g As Integer = Convert.ToInt16(valueArray(2))
Dim b As Integer = Convert.ToInt16(valueArray(3))
image.SetPixel(currentX, currentY, Color.FromArgb(a, r, g, b))
currentX = currentX + 1
If currentX == width Then
currentX = 0
currentY = currentY + 1
If currentY == height Then
Exit Do ' We're done here.
End If
End If
Loop
' At this point, you'll have a BitMap with all the pixels set.
Again, consider this pseudo-code.
each color is actually a ARGB color code just get integer value
Dim myColor As Color = Color.Red
Dim Code As Integer = myColor.ToArgb()
Dim myColorBack As Color = Color.FromArgb(Code)

Image Recognition between 2 images vb.net Lockbits

I was in the process of using Pixel to do my search between a large image and a small image. I got that one to successfully work but am having trouble getting the lockbits version to do what I want it to do.
Fist I want to loop through the large image finding the first pixel of the smaller image inside it. Then once finding the first pixel to do a math equation to tell me what percentage of accuracy it got off it. In doing so if it meets the criteria to move my mouse to that location on the screen at the first pixel (top most left) of that small image inside the large image. Which works with a great rate of success and is extremely fast compared to GetPixel format.
Problem Cannot get location on the large image of where the beginning Pixel of the small image is and move the mouse to that location. Below is the code:
Try
Dim ifnd As Boolean = False
Dim PreviousX As Integer
Dim PreviousY As Integer
PreviousX = MousePosition.X
PreviousY = MousePosition.Y
Dim MatchCount As Integer = 0
Dim oX As Integer = 0
Dim oi As Integer = 0
Dim iX As Integer = 0
Dim iY As Integer = 0
Dim bmp_original As Bitmap
Dim ImG As Bitmap
ImG = PictureBox2.BackgroundImage
bmp_original = ImG
Dim bmp_large As Bitmap
Dim SmG As Image
SmG = PictureBox1.BackgroundImage
bmp_large = SmG
Dim bmg As Bitmap
'large image
ImG = BBt
'small image
bmg = Abt
Thread.Sleep(1000)
'large image
If BBt Is Nothing Then
Dim xbit As Bitmap = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
Dim g As Graphics = Graphics.FromImage(xbit)
BBt = xbit
g.CopyFromScreen(0, 0, 0, 0, Screen.PrimaryScreen.Bounds.Size)
g.Dispose()
Thread.Sleep(2000)
End If
'small image
PictureBox5.BackgroundImage = Abt
'large image
PictureBox6.BackgroundImage = BBt
'For value As Integer = 0 To 5
'For value As Integer = 10 To 0 Step -2
Thread.Sleep(1000)
'original image
Dim oRect As New Rectangle(0, 0, bmg.Width, bmg.Height)
Dim oBmpData As BitmapData = bmg.LockBits(oRect, ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Dim oPtr As IntPtr = oBmpData.Scan0
Dim oPixels(99) As Integer
Dim oMaxPix As Integer = bmg.Width + bmg.Height
Marshal.Copy(oPtr, oPixels, 0, oMaxPix)
Dim smWidth As Integer
smWidth = bmg.Width - 1
'small image
PictureBox3.BackgroundImage = bmg
'large image
Dim lRect As Rectangle = New Rectangle(0, 0, bmp_large.Width, bmp_large.Height)
Dim lBmpData As BitmapData = ImG.LockBits(lRect, ImageLockMode.ReadWrite, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Dim lPtr As IntPtr = lBmpData.Scan0
Dim PixelCount As Integer = ImG.Width * ImG.Height
Dim lPixels(PixelCount - 1) As Integer
Marshal.Copy(lPtr, lPixels, 0, PixelCount)
'large image
PictureBox4.BackgroundImage = ImG
Dim MathScore As Integer
Dim MaxScore As Integer = bmg.Height
'beginning of Marshal Loop
For i As Integer = 0 To lPixels.GetUpperBound(0)
If oPixels(0) = lPixels(i) Then
'we have a match for top left pixel - so compare the other pixels
Dim PixelsToLeft As Integer = (i Mod ImG.Width) - 1 'pixels to left of 10by10 section of large image
Dim PixelsToRight As Integer = ImG.Width - PixelsToLeft - smWidth 'pixels to right of 10by10 section of large image
Dim d As Integer = PixelsToLeft + PixelsToRight 'array distance between right edge of 10by10 section and left edge of next row
For y As Integer = 0 To 9
For x As Integer = 0 To 9
Dim oIndex As Integer = (y * 10) + x
Dim lIndex As Integer = (i + (y * (d + smWidth))) + x
If oPixels(oIndex) = lPixels(lIndex) Then
MathScore = MathScore + 1
xx = oPixels(0) + 2
yy = lPixels(i) + 3
SetCursorPos(xx, yy)
End If
Next
Next
If MathScore >= Val(MaxScore / 2.5) Then
SetCursorPos(xx, yy)
Dim percent As String
Dim myDec As Decimal
'inttemp = (intData2 * 100) / intData1
myDec = Val((MathScore * 100) / MaxScore)
myDec = FormatNumber(myDec, 0)
percent = myDec & "%"
Label16.Text = "Match Score: " & percent
Label17.Text = "Math Score: " & MathScore & " out of " & MaxScore
Me.ToolStripStatusLabel2.Text = "Completed"
Me.Button4.Enabled = True
GoTo Foundit
End If
End If
Next
PictureBox1.Image = (Abt)
PictureBox2.Image = (BBt)
ImG.UnlockBits(oBmpData)
bmg.UnlockBits(lBmpData)
Foundit:
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
Catch
End Try
Now if I could figure out how to get the mouse to move on the screen then I would have figured it out. Unfortunately I have been working on this for several days without any success. If you could help I would greatly appreciate it. Thank you in advance.
to move the mouse do this
dim a as new point
a.x = "the number you want"
a.y = "the number you want"
windows.forms.cursor.position = a

Reading pixel value of an image

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.