I have a lot of pictures (about 10.000) and would need to paint with Pink on every pixel that is white.
I found multiple threads on getting the color of a pixel, but they require me to go over every pixel of every image and verify if it is white. On the other hand in python it can be done extremely quickly with numpy.
Is there a way to select only the white pixels quickly and paint over them in vb.net? maybe using gr.ExcludeClip() or something like that?
any help appreciated.
UPDATE with the current code
Dim im As Image = Image.FromFile(imagepath & "\" & imagename)
Dim palette = im.Palette
Dim c As Color = Color.FromArgb(R, G, B)
Dim mapWhite = New Imaging.ColorMap() With {
.OldColor = Color.White,
.NewColor = c
}
For i As Integer = 0 To palette.Entries.Length - 1
If palette.Entries(i) = mapWhite.OldColor Then
palette.Entries(i) = mapWhite.NewColor
End If
Next
im.Palette = palette
Related
A snippet of my code:
Dim G As Graphics
Dim BBG As Graphics
Dim BB As Bitmap
Dim R As Rectangle
..................................................................
picMainScreen.Visible = True
G = picMainScreen.CreateGraphics
BB = New Bitmap(picMainScreen.Width, picMainScreen.Height)
For x = 0 To 256 * 3 - 1 Step 24
For y = 0 To 240 * 3 - 1 Step 24
R = New Rectangle(New Point(x, y), New Point(24, 24))
G.DrawRectangle(Pens.Black, R)
Next
Next
In this snippet of code, picMainScreen was a PictureBox that was originally not supposed to be visible.
Then through some conditions, picMainScreen was SUPPOSED to TURN Visible.
And THEN, the code draws all the rectangles onto the picture.
However, that isn't the case: the rectangles are first drawn onto the picture, and THEN the picture becomes visible.
Why does this happen? And what's the remedy?
Your rectangle instantiation is interesting since you are using two parameters of type Point.
R = New Rectangle(New Point(x, y), New Point(24, 24))
The Microsoft Docs show these parameter types;
Rectangle(Point, Size)
Initializes a new instance of the Rectangle class with the specified location and size.
https://learn.microsoft.com/en-us/dotnet/api/system.drawing.rectangle.-ctor?view=netframework-4.7.2
I'm not sure if the parameter types are the problem; however you are mixing drawing graphics with a picture control and they might not cohabitate in the same space well.
You could try calling DoEvents() after making the picture control visible to force it to be displayed first.
I would like a notification to be triggered when part the screen starts to flash. This notification can be a msgbox for now, but I will eventually evolve it into an audible sound.
The purpose of this is we have a dashboard that displays various cells throughout the company. When a cell needs assistance, its spot on the dashboard starts to flash. The cells are displayed in horizontally stackedboxes like this;
Cell 1
Cell 2
Cell 3
Ect...
I would like to build an application that scans the screen, lets say every second, and gets each cells pixel intensity.
The notification will be triggered if/when the cells pixel intensity changes each scan for three consecutive scans in a row (ie. the cell must be flashing).
I am hoping that you guys can help me find a way to scan the screen an return a regions average pixel intensity to which I can then replicate and do the comparison to find out if it is flashing.
Thank you in advance, I am using VB.Net.
I was able to accomplish what I was asking by using this:
Private Sub AvgColors(ByVal InBitmap As Bitmap)
Dim btPixels(InBitmap.Height * InBitmap.Width * 3 - 1) As Byte
Dim hPixels As GCHandle = GCHandle.Alloc(btPixels, GCHandleType.Pinned)
Dim bmp24Bpp As New Bitmap(InBitmap.Width, InBitmap.Height, InBitmap.Width * 3,
Imaging.PixelFormat.Format24bppRgb, hPixels.AddrOfPinnedObject)
Using gr As Graphics = Graphics.FromImage(bmp24Bpp)
gr.DrawImageUnscaledAndClipped(InBitmap, New Rectangle(0, 0,
bmp24Bpp.Width, bmp24Bpp.Height))
End Using
Dim sumRed As Int32
Dim sumGreen As Int32
Dim sumBlue As Int32
For i = 0 To btPixels.Length - 1 Step 3
sumRed += btPixels(i)
sumGreen += btPixels(i + 1)
sumBlue += btPixels(i + 2)
Next
hPixels.Free()
Dim avgRed As Byte = CByte(sumRed / (btPixels.Length / 3))
Dim avgGreen As Byte = CByte(sumGreen / (btPixels.Length / 3))
Dim avgBlue As Byte = CByte(sumBlue / (btPixels.Length / 3))
MsgBox(avgRed & vbCrLf & avgGreen & vbCrLf & avgBlue)
End Sub
Private Function Screenshot() As Bitmap
Dim b As Bitmap = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
Using g As Graphics = Graphics.FromImage(b)
g.CopyFromScreen(0, 0, 0, 0, b.Size, CopyPixelOperation.SourceCopy)
g.Save()
End Using
Return b
End Function
and from here I can just adjust the range of bitmap to what I need, add a timer to tick every second, and keep a variable to compare average RGB's to.
Most of the code found from here:
http://www.vbforums.com/showthread.php?776021-RESOLVED-Getting-Average-RGB-Color-Value-of-Entire-Screen
I'm designing a macro to check all the shapes, charts and smart art on a given PowerPoint slide and print it's font colour and style.
The line that is (indirectly) giving me problems is
MsgBox .TextFrame.TextRange.Font.Color.RGB
The colour is outputted, but it is giving the MSaccess colour which is not as useful as the RGB colour. For example, a white block of text would be displayed as "16777215", whereas I would like to see "255,255,255"
I've indicated in the line that I want .color.rgb but this doesn't seem to make a difference.
I'd appreciate any help very much! Thank you!
You can convert this "colorInt" to RGB using something like
B = floor(colorInt / (256*256))
G = floor((colorInt - B*256*256)/256)
R = colorInt - B*256*256 - G*256
To format an RGB color with Excel:
Const color = vbMagenta
Dim r&, g&, b&
r = color And 255
g = color \ 256 And 255
b = color \ 65536
Debug.Print Format(r * 1000000 + g * 1000& + b, "000,000,000")
My Goal is to create a maze in VS using VB.net, I currently have managed to make a random Generator that makes the "maze" and shows the location of the last wall made.
Horizontalwalls = Randomizer.Next(60, 91) 'Makes 60 - 90 Horizontal Walls
VirticalWalls = Randomizer.Next(60, 91) 'Makes 60 -90 Vertical Walls
Dim HLoops = 0 'counter for Horizontal walls
Dim VLoops = 0
lbxHorizontal.Items.Clear() 'empties the list box i have which stores the walls location
lbxvertical.Items.Clear()
Do While HLoops < (Horizontalwalls)
HLoops += 1 'adds to the counter
lbxHorizontal.Items.Insert(0, Randomizer.Next(0, 10))
lbxHorizontal.Items.Insert(0, Randomizer.Next(0, 10))
'Attempt at making visable walls
pbxhorizontalwall.Top = (lbxHorizontal.Items.Item(0) * GridSize - 2) 'This and next line puts the wall in desired location
pbxhorizontalwall.Left = (lbxHorizontal.Items.Item(1) * GridSize - 2)
Loop
however the only way i know to make all the walls visible is to make 90 horizontal wall pictures, go though naming them all, then GLaaa... there must be a easier way to copy the same image over the screen at the desired location.
At the moment, all i really want to know is the line of code that will copy the image (and maybe a way to mass clear them all when the maze is reset) and then i'll work out how to get it into place...
You first create the list of images with:
Dim imageList As New List(Of Bitmap)
imageList.Add("image to add") 'do it for all the images you have
Then create a bitmap:
Dim bitmapWall as Bitmap = New Bitmap(widthOfbitmap, heightofbitmap, Drawing.Imaging.PixelFormat.Format24bppRgb)
Draw the list of images to the bimap:
Dim objGraphics As Graphics = Graphics.FromImage(bitmapWall)
For i = 0 To imageList.Count
objGraphics.DrawImage(imageList(i), x, y, imageList(i).Width, imageList(i).Height)
Next
objGraphics.Dispose()
x,y is the coordinates of where your images are drawn (you should change them for every iteration)
Lastly:
Me.BackgroundImage = bitmapWall
Me.Invalidate()
Dont forget to dispose the list and the bitmap in the end.
valter
I've got a list of System.Drawing.RectangleF objects that all overlap the same RectangleF object. In my picture below, the 3 overlapping rectangles would be the pink, yellow, and red rectangles. My main rectangle in question is the light blue rectangle.
Second Image:
I know that with RectangleF objects I can use the Intersect() method that will return me another RectangleF object representing the overlap. But as far as I can tell, this only really works when comparing two rectangles.
My question is: How could I determine the TOTAL area/percentage (i.e. the combined total overlap of the red, yellow, and pink rectangles when compared to the light blue rectangle - but it would need to be smart enough to not count the area in which the red and yellow overlaps twice, and same for the pink and yellow)?
NOTE: The green lines represent the area I'm looking for, just the total area of the blue rectangle that is not visible.
UPDATE: I've added a 2nd image to further demonstrate what I'm looking for. In the second image, the presence of the burgundy rectangle should have no affect on the total percent covered because that area is already covered by the yellow and green rectangles.
OK I think I found a solution using a Region that seems to be working for both of my example images above:
Private Function TotalCoveredAreaPercent(ByVal oRectToCheck As RectangleF, ByVal oOverlappingRects As List(Of RectangleF)) As Double
Dim oRegion As New Region(oRectToCheck)
Dim dTotalVisibleArea As Double = 0
Dim dTotalCoveredArea As Double = 0
'now we need to exclude the intersection of our
'overlapping rectangles with our main rectangle:
For Each oOverlappingRect As RectangleF In oOverlappingRects
oRegion.Exclude(RectangleF.Intersect(oRectToCheck, oOverlappingRect))
Next
'now we have access to the non-overlapping
'rectangles that make up the visible area of our main rectangle:
Dim oVisibleRects As RectangleF()
oVisibleRects = oRegion.GetRegionScans(New Drawing2D.Matrix())
'add the area of the visible rectangles together
'to find the total visible area of our main rectangle:
For Each oVisibleRect As RectangleF In oVisibleRects
dTotalVisibleArea += AreaOf(oVisibleRect)
Next
Dim dPercentVisible As Double = dTotalVisibleArea / AreaOf(oRectToCheck) * 100
'percent covered is 100 - the visible percentage:
Return (100 - dPercentVisible)
End Function
This seems to be working pretty well, and is quite simple.
Here is my algorithm. The key point is that we are subtracting out overlaps of overlaps.
Dim baseRect As New RectangleF(10, 10, 20, 20)
Dim otherRectList As New List(Of RectangleF)
otherRectList.Add(New RectangleF(5, 5, 10, 10))
otherRectList.Add(New RectangleF(20, 20, 10, 10))
otherRectList.Add(New RectangleF(10, 5, 10, 10))
Dim overlapRectList As New List(Of RectangleF)
For Each otherRect As RectangleF In otherRectList
If RectangleF.Intersect(otherRect, baseRect) <> RectangleF.Empty Then
overlapRectList.Add(RectangleF.Intersect(otherRect, baseRect))
End If
Next
Dim totalArea As Single = 0
For Each overlapRect As RectangleF In overlapRectList
totalArea += overlapRect.Width * overlapRect.Height
Next
'Subtract out any overlaps that overlap each other
For i = 0 To overlapRectList.Count - 2
For j = i+1 To overlapRectList.Count - 1
If i <> j Then
If RectangleF.Intersect(overlapRectList(i), overlapRectList(j)) <> RectangleF.Empty Then
Dim dupeRect As RectangleF = RectangleF.Intersect(overlapRectList(i), overlapRectList(j))
totalArea -= dupeRect.Width * dupeRect.Height
End If
End If
Next
Next
I amended the code to take into account tcarvin's note. However, I have not plotted out the results on graph paper to see if this is fully correct. I will look at it as soon as I have additional time. Also note that I have not included any code to handle a situation with less than 2 intersections.