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
Please bear with me I´m a newbie in programming and I´m trying to learn how to rotate a 3D point (XYZ) around 0,0,0 and later I´ll try to improve my code to allow rotation around an arbitrary point (XYZ).
I´m starting with VB and after extensive searches here and in the Web, I could not find an explanation for my problem. I´m an almost 40 years old trying to learn math and programming, so please bear with me because it will take time for me to digest all the math side for these problems.
Basically, I´m trying to write an algorithm to rotate a 3D point, however, while it seems that with some angles my code works, with some others I just get weird funky numbers that are probable correct in some aspect, but I can´t find the flaw in the code. I´ve been looking into this for days and tried multiple approaches, but I´m just not being able to spot the error.
This is the UI for my little app. The original coordinates are entered in the top of the form, and in the bottom of the form I show the rotated coordinates.
Notice that in the image below, a simple rotation of a coordinate of Y10.0 around Z axis by 90 degrees return a correct X value (-10), but Y shows a funky number (6.1230...)... However if I change the rotation angle around Z to 45, the results seems to be correct...
I don´t know what I´m doing wrong to get this weird Y. Because of this error, I´m not trusting in the results of this algorithm at all but I´m currently in a blindspot...
This is the code of the calculate button:
Private Sub BtnCompute_Click(sender As Object, e As EventArgs) Handles BtnCompute.Click
'Capture the values from the text boxes and parse then to doubles
ValidateAllFieldsWithDoubleValues()
'Rotate the coordinates
RotateXYZCoordinates(dblOriginalCoordX, dblOriginalCoordY, dblOriginalCoordZ, dblCurrentRotationAroundX, dblCurrentRotationAroundY, dblCurrentRotationAroundZ)
'Update the text boxes for the rotated coordinates for XYZ
txtResultX.Text = dblResultX.ToString
txtResultY.Text = dblResultY.ToString
txtResultZ.Text = dblResultZ.ToString
End Sub
And this is the code of the function that calculates the rotations:
Private Function RotateXYZCoordinates(ByVal XCoord As Double, ByVal YCoord As Double, ByVal ZCoord As Double, ByVal Pitch As Double, ByVal Roll As Double, ByVal Yaw As Double)
'X Rotation
Dim RadPitch As Double = 0
Dim CosPitch As Double = 0
Dim SinPitch As Double = 0
Dim XRotatedAroundX As Double = 0
Dim YRotatedAroundX As Double = 0
Dim ZRotatedAroundX As Double = 0
RadPitch = Pitch * Math.PI / 180
CosPitch = Math.Cos(RadPitch)
SinPitch = Math.Sin(RadPitch)
XRotatedAroundX = XCoord
YRotatedAroundX = YCoord * CosPitch - ZCoord * SinPitch
ZRotatedAroundX = YCoord * SinPitch + ZCoord * CosPitch
'Y Rotation
Dim RadRoll As Double = 0
Dim CosRoll As Double = 0
Dim SinRoll As Double = 0
Dim XRotatedAroundY As Double = 0
Dim YRotatedAroundY As Double = 0
Dim ZRotatedAroundY As Double = 0
RadRoll = Roll * Math.PI / 180
CosRoll = Math.Cos(RadRoll)
SinRoll = Math.Sin(RadRoll)
XRotatedAroundY = ZRotatedAroundX * CosRoll - XRotatedAroundX * SinRoll
YRotatedAroundY = YRotatedAroundX
ZRotatedAroundY = ZRotatedAroundX * SinRoll + XRotatedAroundX * CosRoll
'Z Rotation
Dim RadYaw As Double = 0
Dim CosYaw As Double = 0
Dim SinYaw As Double = 0
Dim XRotatedAroundZ As Double = 0
Dim YRotatedAroundZ As Double = 0
Dim ZRotatedAroundZ As Double = 0
RadYaw = Yaw * Math.PI / 180
CosYaw = Math.Cos(RadYaw)
SinYaw = Math.Sin(RadYaw)
XRotatedAroundZ = XRotatedAroundY * CosYaw - YRotatedAroundY * SinYaw
YRotatedAroundZ = XRotatedAroundY * SinYaw + YRotatedAroundY * CosYaw
ZRotatedAroundZ = ZRotatedAroundY
'Final result
dblResultX = XRotatedAroundZ
dblResultY = YRotatedAroundZ
dblResultZ = ZRotatedAroundZ
Return Nothing
End Function
I know this is not an elegant code but it is what I can code for now... I´d appreciate if someone could take a look at this and point me to the source of error... I´ve been watching videos and did an extensive search in this website before I posted... But it seems some things are still very advanced to me for now... I´m not lazy and I´m willing to learn if someone point me towards something I could digest for now...
If someone could share a hint about how to make this rotate function to support rotation around a point other than 0,0,0 I´d appreciate.
Thank you,
Daniel
The answer is correct. Due to double precision math and a 90 degree rotation there is a limit to the accuracy. The answer is really 6.12303176911189E-16 or .000000000000000612303176911189. Round the number off to a realistic value of decimal points. This is also why 1+1 is not equal to 2 but 1.999999999999999999999999999999 in floating point math.
I have a parent window that has a panel on the left hand side into which some buttons are placed. There is also a splitter added, so that the user can adjust the size of this panel. When a user presses one of the buttons, a form should appear on the right hand size - defaulting to the width of the remaining area of the window. In order to work out how wide this child form needs to be, I have taken the client width and subtracted the width of the panel and the splitter from this, however it is always slightly too big. I can simply subtract an additional 4 from the calculation to get it to work - but this feels unstable to me, as I don't know where those 4 pixels have come form! How do I calculate this correctly. My Code is below.
Dim xPos As Integer = Me.Panel1.Width + Me.Splitter1.Width
Dim yPos As Integer = 0
Dim childFormWidth As Integer = Me.ClientSize.Width - xPos
Dim childFormHeight As Integer = 200
myChildForm.Show()
myChildForm.Location = New Point(xPos, yPos)
myChildForm.Size = New Size(ChildFormWidth, myHeight)
Thanks Paul.
I need to add a half inch of white space at the bottom of an image and the draw a string to the bottom left and bottom right (within the newly added white space). Everything seems to work fine but the font sometime appears way too small or too large.
I think I need to somehow scale the drawstring font to the size of the image? I have exhausted myself trying to figure this out... Please help!!
See code below ----
Imports System.IO
Imports System.Drawing.Graphics
Imports System.Drawing
Imports System.Drawing.Bitmap
Imports System.Drawing.Imaging
Public Class Form1
Dim ofilepath As String = "C:\temp\20141022\TEST0000001.tif"
Dim nfilepath As String = "C:\temp\20141022\new.tif"
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dim newbm As New Bitmap(AddBorderAndStamp(Bitmap.FromFile(ofilepath), Color.White, 50, Path.GetFileNameWithoutExtension(ofilepath), "CONFIDENTIAL"))
newbm.Save(nfilepath, Imaging.ImageFormat.Tiff)
Me.Close()
End Sub
Public Function AddBorderAndStamp(ByVal bm As Bitmap, ByVal borderColor As System.Drawing.Color, ByVal borderWidthInPixels As Integer, ByVal bates As String, ByVal designation As String) As Bitmap
Dim voffset As Integer = 75
Dim hoffset As Integer = 15
Dim newBitmap As New Bitmap(bm.Width, bm.Height + (borderWidthInPixels * 2))
Dim mfont As Font = New Font("Arial", 32, FontStyle.Bold)
For x As Integer = 0 To newBitmap.Width - 1
For y As Integer = newBitmap.Height - 1 To (newBitmap.Height - 1) - borderWidthInPixels Step -1
newBitmap.SetPixel(x, y, borderColor)
Next
Next
Dim gr As System.Drawing.Graphics = Graphics.FromImage(newBitmap)
gr.Clear(Color.White)
gr.DrawImage(bm, 0, 0, bm.Width, bm.Height)
Dim textSize As SizeF = gr.MeasureString(bates, mfont)
gr.DrawString(bates, mfont, Brushes.Black, bm.Width - textSize.Width - hoffset, newBitmap.Height - voffset)
gr.DrawString(designation, mfont, Brushes.Black, hoffset, newBitmap.Height - voffset)
gr.Dispose()
Return newBitmap
End Function
End Class
When you're about to know the size (width) of your bates string at this line :
Dim textSize As SizeF = gr.MeasureString(bates, mfont)
and before drawing your string on the bitmap, you'll have to compute the scaling to perform on your font size to make sure your text gets shrinked (if too long) or stretched (if too narrow) while not excessively stretched in height-mean to be drawn over the image.
Then, only when you have a valid font size, you draw your text as you do with the following lines
gr.DrawString(bates, mfont, Brushes.Black, bm.Width - textSize.Width - hoffset, newBitmap.Height - voffset)
gr.DrawString(designation, mfont, Brushes.Black, hoffset, newBitmap.Height - voffset)
To know what's the correct font size to use, have a look on this SO Question Page.
I know it's C#, but this is basically what you'll have to do before drawing your bates and designation text. The difference lies in two points :
you have two String to scale in a clip rectangle (bates and designation) instead of one.
you have to take account of a (default) separation between designation on the left, and bates on the right.
But these two points can be easily worked around. This also means that your question could be a duplicate (StackOverflow doesn't recommend multiple variants of the same question as the purpose of SO is to bring you directly to a page asking a question AND its answer - if answered - but not to flood you with dozens copies of the same subject)
But IMHO, the two-string (designation and bates) is enough to consider this as a new question, because the code handling that is not covered by the other topics.
Here is saeed's function converted to vb.Net
Private Function FindFont( _
ByRef rg As Graphics, _
ByVal testString as String, _
ByVal clipRoom As Size, _
ByVal preferedFont As Font) As Font
' You should perform some scale functions...
Dim realSize As SizeF = rg.MeasureString(testString, PreferedFont)
Dim heightScaleRatio As Double = clipRoom.Height / realSize.Height
Dim widthScaleRatio As Double = clipRoom.Width / realSize.Width
Dim scaleRatio As Double
Dim newFontSize As Single ' I'm used to declare everything on top.
If heightScaleRatio < widthScaleRatio Then
scaleRatio = heightScaleRatio
Else
scaleRatio = widthScaleRatio
End If
newFontSize = CSng(preferedFont.Size * ScaleRatio)
Return New Font(preferedFont.FontFamily, newFontSize, preferedFont.Style)
End Function
Credits goes to saeed first for providing the code, but if saeed used code from someone else that I'm not aware of, credits to original author supersede saeed's.
The required parameters for that Function to work are :
rg As Graphics. You already have it, namely rg in your AddBorderAndStamp Function.
testString As String. You also have it, it is simply testString = designation + bates
clipRoom As Size. You don't have that variable yet. You'll have to declare it in your AddBorderAndStamp Function, and use some logic to define its .Width and .Height values.
and preferedFont As Font. You also have that already, which is mfont As Font = New Font("Arial", 32, FontStyle.Bold)
The declarations to add to your AddBorderAndStamp Function are :
Dim clipRoom As Size ' Declare it.
Dim stampSeparation As Integer = 80 ' why 80 ? dunno ! it's an arbitrary value..
stampSeparation is an arbitraty variable that represents the Width IN
PIXELs between designation and bates. Basically, it looks like this :
'< - - - - - - - total Bitmap width - - - - - - - >
'| |designation|_____________|bates| |
'| | | | | ^ Right Image boder
'| | | | ^ Right margin
'| | | ^ Left plot of your bates String
'| | <-------------> Length or Width of stampSeparation
'| ^ Left plot of your designation String
'^ Left image border
Your available room to write text is the sum of
designation.Width
bates.Width
stampSeparation
But because you want designation and bates beeing separated by stampSeparation, stampSeparation must be substracted from the available clip width. So :
clipRoom.Width = newBitmap.Width - (hOffset * 2) - stampSeparation
' newBitmap.Width - 30 - 80
' newBitmap.Width - 110
' CAREFULL !!! clipRoom.Width MUST be positive !!!
' Check your bm is wide enough, say at least 200 pixels Width...
The room you have at the bottom is a sightly different story : Your AddBorderAndStamp Function has one borderWidthInPixels (as Integer) parameter that define the room you add in top/bottom mean. Then you use voffset (as Integer) variable to shift your stamp upward.. That means your available room in terms of heigth at the bottom of your image to plot text in is :
clipRoom.Height = vOffset ' ?
' 75 ?
' (CAREFULL !!! clipRoom.Height MUST be positive !!!)
If I were you, I would dynamically define clipRoom.Height based on a fraction of AddBorderAndStamp and dynamically calculate vOffset after knowing the final heigth of designation and bates heights using MeasureString... But that would be an overkill...
' perhaps one simple logic like the following would suffice
' clipRoom.Height = CInt(vOffset * 4 / 5)
Now you have clipRoom and everything else required to call FindFont(...) Function.
So :
Public Function AddBorderAndStamp(...) As Bitmap
' Dim vOffset ' ...
' Dim hOffset ' ...
' ...
' add the following declarations :
Dim clipRoom As Size
Dim stampSeparation As Integer = 80 ' or 60 as you like but small enough
' ...
' ... your function block code goes here until the following line :
gr.DrawImage(bm, 0, 0, bm.Width, bm.Height)
' Calculate the available clip room...
clipRoom.Width = newBitmap.Width - (hOffset * 2) - stampSeparation
clipRoom.Height = vOffset
' ^^ remember : the logic to handle valid Width and Height is up to you
' I know how to handle that, but you should aswell, or try at least.
' Now, update the size of your font...
mFont = FindFont(rg, designation + bates, clipRoom, mFont)
' then continue with the rest of the code...
Dim textSize As SizeF = gr.MeasureString(bates, mfont)
gr.DrawString(bates, mfont, Brushes.Black, bm.Width - textSize.Width - hoffset, newBitmap.Height - voffset)
gr.DrawString(designation, mfont, Brushes.Black, hoffset, newBitmap.Height - voffset)
gr.Dispose()
Return newBitmap
End Function
by the way :
Hello. You should add [vb.Net] tag to the post and either remove
[image] or [bitmap] since those are synonyms.
It's hard to spot code typos without the formatting. But since you're new on StackOverflow (SO) I don't want to downvote or flag you, but I insist : update the tags of your question.
Remark 1 :
You wrote :
For x As Integer = 0 To newBitmap.Width - 1
For y As Integer = newBitmap.Height - 1 To (newBitmap.Height - 1) - borderWidthInPixels Step -1
newBitmap.SetPixel(x, y, borderColor)
Next
Next
Dim gr As System.Drawing.Graphics = Graphics.FromImage(newBitmap)
gr.Clear(Color.White)
You're changing the color of newBitmap pixel by pixel from the bottom. I'm OK with that but there are better ways to achieve that.
However, you're declaring a Graphics to handle drawings on newBitmap, then you call gr.Clear(Color.White) ???
Isn't that supposed to entirely paint your newBitmap with white, thus, destroing the purpose of your SetPixel loop just above ?
I don't understand. Perhaps you want the function to waste time, so just use
System.Threading.Thread.Sleep(X) ' where X is an Integer variable in miliseconds
Otherwise, I would recommend you to get rid of the SetPixel and its encosing For loops, and just fill a Rectangle using your gr Graphics :
' ...
Dim gr As System.Drawing.Graphics = Graphics.FromImage(newBitmap)
gr.Clear(Color.White)
gr.FillRectangle( _
New SolidBrush(borderColor), _
0, newBitmap.Height - borderWidthInPixels, _
newBitmap.Width, borderWidthInPixels)
gr.DrawImage(bm, 0, 0, bm.Width, bm.Height)
' ...
Remark 2 :
' you've set newBitmap to have
' bm.Heigth expanded by two times the value of borderWidthInPixels
Dim newBitmap As New Bitmap(bm.Width, bm.Height + (borderWidthInPixels * 2))
' ...
' Then you plot bm at the very top of newBitmap
gr.DrawImage(bm, 0, 0, bm.Width, bm.Height)
' that means you have a blank space at the bottom
' that height twice the value of borderWidthInPixels
' ...
' But you plot bates and designation
' at a fixed vOffset from the bottom of newBitmap
gr.DrawString(bates, , , , newBitmap.Height - voffset)
gr.DrawString(designation, , , , newBitmap.Height - voffset)
The relation between borderWidthInPixels and voffset remains unclear to me, that may mislead the formulation of clipRoom.Height above.
However, I think I've given enough material to get you where you want, and even if the clipRoom.Height formulation above is wrong, it would be very easy to fix it.
You also have to understand that I used saeed approach by default, but by reading the post I linked, you'll find other approaches, iteratives ones, which I don't like much because they are iterations CPU heavy without always beeing more precise. You can even find hints about TextToBitmap; have a try if more suitable for you, but it's more complex too.. For what you're doing, I think one or two pixels displaced outputs is not a problem.
For the vertical placement, you said ".. but the font sometime appears way too small or too large.." That's not precise enough to get a full picture of the issue. You should have posted two images samples of the "too small" case and the "too large" case. Since you didn't change Font Size in your code, I assumed the too small problem was a too large space between designation and bates, and the too large is overlapping text. There is not a single reference to a possible vertical laying out issue, so my answer doesn't elaborate on that side. That's why I don't introduce multiline logic here, which would stand for another question (if none available on SO)
So I have a picture box with an image. I have coordinates to draw certain boxes (as in multiple rectangles) on the image (from a device).
Dim rectPoint_Start As Point =
New Point((newStartPoint_X * pbZoneImage.Width / resWidth),
newStartPoint_Y * pbZoneImage.Height / resHeight)
Dim rectPoint_End As Point =
New Point((newEndPoint_X * pbZoneImage.Width / resWidth),
newEndPoint_Y * pbZoneImage.Height / resHeight)
Dim rectangleHeight As Integer = (rectPoint_End.Y - rectPoint_Start.Y)
Dim rectangleWidth As Integer = (rectPoint_End.X - rectPoint_Start.X)
'localize
camRect1 = New Rectangle(rectPoint_Start.X, rectPoint_Start.Y, _
rectangleWidth, rectangleHeight)
If camRect1 <> Nothing Then g.DrawRectangle(Pens.Blue, camRect1)
The rect coordinates are coming in scaled with a resolution, so you see me there changing it to a relative point value for the pbZoneImage picture box. The problem I am having is that the coordinates I'm receiving (from the device) are assuming the (0,0) point is in the bottom left, where the PB draws these boxes starting from the top left. Is there a way to change the orientation of the starting point being drawn in the g.drawRectangle()? Or another method.
What I have tried so far is to add (pbzoneImage.bottom) - ((newEndPoint_X * pbZoneImage.Width ....) in the rectPoint_End and rectPoint_Start points. It doesn't seem to work and gives me negative values.
Update:
So this is what I ended up doing to fix it. I ended up drawing out a coordinate system and doing some old school algebra based on some of the answers I received. (Reminder, pbZoneImage is a picture box, startpoint x and y along with endpoint x and y are the values from the device)
Dim rectangleHeight As Integer = Math.Floor((newEndPoint_Y - newStartPoint_Y) * pbZoneImage.Height)
Dim rectangleWidth As Integer = Math.Floor((newEndPoint_X - newStartPoint_X) * pbZoneImage.Height)
'flip rectangle
Dim rectPoint_Start As New Point((newStartPoint_X * pbZoneImage.Width), _
pbZoneImage.Height - (newStartPoint_Y * pbZoneImage.Height) - rectangleHeight)
Dim rectPoint_End As Point = New Point((newEndPoint_X * pbZoneImage.Width), _
pbZoneImage.Height - (newEndPoint_Y * pbZoneImage.Height) - rectangleHeight)
'localize
camRect1 = New Rectangle(rectPoint_Start.X, rectPoint_Start.Y, _
rectangleWidth, rectangleHeight)
Upon receiving newStartPoint_Y and newEndPoint_Y values from the device, do the following :
newStartPoint_Y = resHeight - newStartPoint_Y
newEndPoint_Y = resHeight - newEndPoint_Y
assuming your device gives you coordinates on a zero-based reference (where the point at the lower left corner has the coordinate (0,0) which would fit with the zero-based coordinates of the top left corner of a PictureBox)
If I understand well, newStartPoint_X/Y and newEndPoint_X/Y are coordinates directly from the device ?
I suggest you to take the habit to use either CInt() when using Point with integer X and Y values, or better : CSng() with PointF, since you're scaling coordinates anyway.
I believe you are forgetting to also adjust for the rectangle height. If the rectangle origin is the lower left and its position was mapped to the resized image coordinate system based upon image lower left origin then you must adjust for the resized image height and the mapped rectangle height. Sketch it out on paper to get the relationships right.