I am struggling with the following problem: I have a small picture with is painted in red. This color must be changed to another color (users'choice). I used msdn and some googling did the following:
Private Function GetPicture(Iterator As Integer, tempfile As String) As String
Dim Rstring = ""
If Colors.Count = 0 OrElse Iterator >= Colors.Count Then
Rstring = tempfile
Else
Dim NewPicture = My.Computer.FileSystem.GetTempFileName()
My.Computer.FileSystem.CopyFile(tempfile, NewPicture, True)
Dim mypict = New Bitmap(NewPicture)
Dim ColorList As New List(Of Color)
For x = 0 To mypict.Width - 1
For y = 0 To mypict.Height - 1
Dim mypixel = mypict.GetPixel(x, y)
If ColorList.Contains(mypixel) = False Then
ColorList.Add(mypixel)
End If
Next
Next
Dim NewColor = Color.FromArgb(255, 0, 0, 255)
Dim ListOfColorMaps As New List(Of ColorMap)
For Each elem In ColorList
Dim newcolormap = New ColorMap
newcolormap.OldColor = elem
newcolormap.NewColor = NewColor
ListOfColorMaps.Add(newcolormap)
Next
Dim imageAttributes As New ImageAttributes()
Dim width As Integer = mypict.Width
Dim height As Integer = mypict.Height
Dim colorMap As New ColorMap()
'colorMap.OldColor = Color.FromArgb(255, 0, 0, 0) ' opaque red
'colorMap.NewColor = Color.FromArgb(255, 0, 0, 255) ' opaque blue
Dim remapTable As ColorMap() = ListOfColorMaps.ToArray
imageAttributes.SetRemapTable(remapTable, ColorAdjustType.Bitmap)
Dim tempBmp = New Bitmap(width, height)
Dim g = Graphics.FromImage(tempBmp)
g.DrawImage(tempBmp, New Rectangle(0, 0, width, height), 0, 0, width, height, GraphicsUnit.Pixel, imageAttributes)
g.Save()
g.Dispose()
mypict.Dispose()
Dim NewFileName = NewPicture.Remove(NewPicture.IndexOf("."c) - 1) & ".png"
tempBmp.Save(NewFileName, Imaging.ImageFormat.Png)
My.Computer.FileSystem.DeleteFile(NewPicture)
tempBmp.Dispose()
Rstring = NewPicture
End If
Return Rstring
The Code runs without exceptions, and it seems to find the desired colors but the saved tempbmp contains no picture. Does this happen because the code runs in a dll without graphic?
You can pretty much ignore the "IF" part - that has something to do with another usecase.
Greetings and sincere thanks
Christian Sauer
You are getting no picture displayed because you are drawing an empty bitmap.
Your problem starts here:
Dim tempBmp = New Bitmap(width, height)
Dim g = Graphics.FromImage(tempBmp)
g.DrawImage(tempBmp, New Rectangle(0, 0, width, height), 0, 0, width, height, _
GraphicsUnit.Pixel, imageAttributes)
You create a new bitmap (probably with a white background).
Then you create a new Graphics object from your empty bitmap.
Then you draw the empty bitmap onto itself.
What you should be doing is drawing the mypict object (which is the bitmap whose colors you want to change). Thus your third line should be as follows:
g.DrawImage(mypict, New Rectangle(0, 0, width, height), 0, 0, width, height, _
GraphicsUnit.Pixel, imageAttributes)
Since the Graphics object g is associated with tempBmp (which is empty prior to the DrawImage operation) drawing mypict will draw to it with your parameters.
One other recommendation is that you remove the g.Save() line. You save a graphics object when you plan to restore it later. Doing a Graphics.Save() does not save a picture. What really saves the changes you have made is the tempBmp.Save() line.
Related
I use this function
Public Shared Function ChangeOpacity(ByVal img As Image, ByVal opacityvalue As Single) As Bitmap
Dim bmp As New Bitmap(img.Width, img.Height)
Dim graphics__1 As Graphics = Graphics.FromImage(bmp)
Dim colormatrix As New colormatrix
colormatrix.Matrix33 = opacityvalue
Dim imgAttribute As New ImageAttributes
imgAttribute.SetColorMatrix(colormatrix, ColorMatrixFlag.[Default], ColorAdjustType.Bitmap)
graphics__1.DrawImage(img, New Rectangle(0, 0, bmp.Width, bmp.Height), 0, 0, img.Width, img.Height, _
GraphicsUnit.Pixel, imgAttribute)
graphics__1.Dispose()
Return bmp
End Function
I use this command
picturebox.Image = ChangeOpacity(picturebox.Image, 0.3)
This is work ,The picturebox's opacity is fade out.
but when I try this
picturebox.Image = ChangeOpacity(picturebox.Image, 1.0)
It is nothing happen , The picture is still fade out I want to return picture into default
How to fix this ?
Thank you very much
Load the image form file like this
PictureBox1.Image = Image.FromFile("C:\Documents and
Settings\User3\Desktop\Sathish\image\calendar-icon-reportdate.png")
And use the call opacity like this
PictureBox1.Image.Dispose()
PictureBox1.Image = ChangeOpacity(Image.FromFile("C:\Documents and
Settings\User3\Desktop\Sathish\image\calendar-icon-reportdate.png"), 0.3)
PictureBox1.Image.Dispose()
PictureBox1.Image = ChangeOpacity(Image.FromFile("C:\Documents and
Settings\User3\Desktop\Sathish\image\calendar-icon-reportdate.png"), 1)
The second parameter in ChangeOpacity() function is the Opacity Percentage or factor of the picture in first parameter.
So (1.0) will not change the Opacity, it will return the picture without changes.
You have to multiply the previous opacity value to have (1) and return the picture into default OR reload your image from the source with the default opacity to first parameter.
In your example
The_Current_Opacity * Opacity_Factor = 1
0.3 * Opacity_Factor = 1
use: picturebox.Image = ChangeOpacity(picturebox.Image, 3.3)
I prefer the division (1/0.3). It's more accurate than ( 3.3).
Here is the code and you can do the math
dim OpacityPercentage as Single
OpacityPercentage = 0.3
'To fade out the picturebox's opacity
picturebox1.Image = ChangeOpacity(picturebox1.Image, OpacityPercentage )
'To return picture into default
picturebox1.Image = ChangeOpacity(picturebox1.Image, 1/OpacityPercentage )
Goal
To create an Ellipse in AutoCAD 2014 with the possibility of rotating it horizontally (as seen in the red rectangle below).
Attempt
I was able to create the Ellipse but I cannot seem to find how to rotate it horizontally.
CreateEllipse(AcadDoc)
Public Function CreateEllipse(ByRef AcadDoc As Document) As ObjectId
Dim returnId As ObjectId
Dim db As Database = AcadDoc.Database
Dim x As Vector3d = db.Ucsxdir
Dim y As Vector3d = db.Ucsydir
Dim normalVec As Vector3d = x.CrossProduct(y)
Dim axisvec As Vector3d = normalVec.GetNormal()
Dim CenterPoint As New Point3d(Me.StartPoint.X + 50, Me.StartPoint.Y + 40, 0)
Dim aEllipse As New Ellipse(CenterPoint, axisvec, New Vector3d(0, 20, 0), 0.5, 0, Math.PI * 2)
returnId = Utils.CreateAcadObject(AcadDoc, aEllipse)
aEllipse.Dispose()
Utils.regenLayers()
Return returnId
End Function
Utils.CreateAcadObject(AcadDoc, aEllipse)
Public Function CreateAcadObject(ByRef acDoc As Document, ByRef acObj As Object) As ObjectId
Dim objId As ObjectId
Dim acCurDb As Database = acDoc.Database 'Get the current database
Dim acBlkTbl As BlockTable
Dim acBlkTblRec As BlockTableRecord
Using lock As DocumentLock = acDoc.LockDocument
'Start a transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
'Open Model space for write
acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, OpenMode.ForRead)
acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
acObj.SetDatabaseDefaults()
'Add the object to the drawing
objId = acBlkTblRec.AppendEntity(acObj)
acTrans.AddNewlyCreatedDBObject(acObj, True)
'Commit the changes and dispose of the transaction
acTrans.Commit()
End Using
End Using
Return objId
End Function
This is the result I get:
I'll keep trying to figure it out and I'll post my answer when I end up doing so.
On the line where you create the ellipse:
Dim aEllipse As New Ellipse(CenterPoint, axisvec, New Vector3d(0, 20, 0), 0.5, 0, Math.PI * 2)
You need to change the coordinates of the major axis like this:
Dim aEllipse As New Ellipse(CenterPoint, axisvec, New Vector3d(20, 0, 0), 0.5, 0, Math.PI * 2)
i want to make an image in vb.net which is a string
it should be made of 2 colors one as forecolor the other as a color surrounding the first one
how should i make it using code?
my result must be some thing like this image(yellow as forecolor and red! as background)
[the string is in persian]
right now i first make the string using
Dim result As New Bitmap(100, 100)
Dim g As Graphics = Graphics.FromImage(result)
g.DrawString("My string", New Font("Arial", 40), New SolidBrush(Color.yellow), 22, 22)
and then process this image by checking every single pixel and if they are close to the string i color them as red , the code is this
kr = font_color.R
kg = font_color.G
kb = font_color.B
For i = 0 To (img.Height - 1) Step 1
prg.Value = prg.Value + 1
For j = 0 To (img.Width - 1)
If (kr = img.GetPixel(j, i).R And kg = img.GetPixel(j, i).G And kb = img.GetPixel(j, i).B) Then
'some code
ElseIf (isnabor(j, i) = True) Then'checks if it is close enough or not
img.SetPixel(j, i, back_color)
Else
img.SetPixel(j, i, Color.Transparent)
End If
Next
Next
The problem is that it takes a long time for a large image
any better way?
Try using GraphicsPath. Check the following links for more information
www.codeproject.com/Articles/42529/Outline-Text
www.java2s.com/Tutorial/VB/0300__2D-Graphics/Textoutline.htm
www.java2s.com/Tutorial/VB/0300__2D-Graphics/AddstringtoGraphicsPath.htm
Bob Powell: Text Effects
by the help of my friend i found the answer here it is:
Dim result As New Bitmap(1000, 1000)
Dim grp As Graphics = Graphics.FromImage(result)
Dim gp As New Drawing2D.GraphicsPath
Dim useFont As Font = New Font("IranNastaliq", 100, FontStyle.Regular)
grp.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
grp.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
gp.AddString(rr.Lines(aa), useFont.FontFamily, FontStyle.Regular, 100, New Point(0, 0), StringFormat.GenericTypographic)
useFont.Dispose()
grp.FillPath(Brushes.White, gp)
grp.DrawPath(Pens.Black, gp)
gp.Dispose()
pic.Image = result
I've been working on obtaining the ROI of an image, I'm trying to get a square shaped box that will hoover around the region an be able to click and get the standard deviation. I'm familiar with c so i used the c to VB converter, but im getting errors that the statement is not valid in namespace. Everything seems to compatible to VB code. I will be grateful for any suggestions on this matter. Thanks
Private Function DrawRoi(Image As Bitmap, rect As RectangleF) As oid
Dim roi As New Rectangle()
roi.X = CInt(CSng(Image.Width) * rect.X)
roi.Y = CInt(CSng(Image.Height) * rect.Y)
roi.Width = CInt(CSng(Image.Width) * rect.Width)
roi.Height = CInt(CSng(Image.Height) * rect.Height)
Dim timer As New Stopwatch()
timer.Start()
' graphics manipulation takes about 240ms on 1080p image
Using roiMaskImage As Bitmap = CreateRoiMaskImage(ImageWithRoi.Width, ImageWithRoi.Height, roi)
Using g As Graphics = Graphics.FromImage(ImageWithRoi)
g.DrawImage(Image, 0, 0)
g.DrawImage(roiMaskImage, 0, 0)
Dim borderPen As Pen = CreateRoiBorderPen(ImageWithRoi)
g.DrawRectangle(borderPen, roi)
End Using
End Using
Debug.WriteLine("roi graphics: {0}ms", timer.ElapsedMilliseconds)
Me.imagePictureBox.Image = ImageWithRoi
End Function
Private Function CreateRoiMaskImage(width As Integer, height As Integer, roi As Rectangle) As Bitmap
Dim image As New Bitmap(width, height, PixelFormat.Format32bppArgb)
Using g As Graphics = Graphics.FromImage(image)
Dim dimBrush As New SolidBrush(Color.FromArgb(64, 0, 0, 0))
g.FillRectangle(dimBrush, 0, 0, width, height)
Dim roiBrush As New SolidBrush(Color.Red)
g.FillRectangle(roiBrush, roi)
image.MakeTransparent(Color.Red)
Return image
End Using
End Function
I have problem with Graphics.RotateTransfrom() with the following code :
Dim newimage As Bitmap
newimage = System.Drawing.Image.FromFile("C:\z.jpg")
Dim gr As Graphics = Graphics.FromImage(newimage)
Dim myFontLabels As New Font("Arial", 10)
Dim myBrushLabels As New SolidBrush(Color.Black)
Dim a As String
'# last 2 number are X and Y coords.
gr.DrawString(MaskedTextBox2.Text * 1000 + 250, myFontLabels, myBrushLabels, 1146, 240)
gr.DrawString(MaskedTextBox2.Text * 1000, myFontLabels, myBrushLabels, 1146, 290)
a = Replace(Label26.Text, "[ mm ]", "")
gr.DrawString(a, myFontLabels, myBrushLabels, 620, 1509)
a = Replace(Label5.Text, "[ mm ]", "")
gr.DrawString(a, myFontLabels, myBrushLabels, 624, 548)
gr.RotateTransform(90.0F)
gr.DrawString(a, myFontLabels, myBrushLabels, 0, 0)
PictureBox1.Image = newimage
I dont know why but my image in pictureBox1 is not rotated. Someone known solution ?
The issue at hand is that the RotateTransform method does not apply to the existing image.
Instead, it applies to the transformation matrix of the graphics object. Basically, the transformation matrix modifies the coordinate system used to add new items.
Try the following :
Dim gfx = Graphics.FromImage(PictureBox1.Image)
gfx.DrawString("Test", Me.Font, Brushes.Red, New PointF(10, 10))
gfx.RotateTransform(45)
gfx.DrawString("Rotate", Me.Font, Brushes.Red, New PointF(10, 10))
The first string is drawn normally, while the second is drawn rotated.
So what you need to do is create a new graphics object, apply your rotation, draw your source image onto the graphics (graphics.DrawImage), and then draw all your text :
' Easy way to create a graphisc object
Dim gfx = Graphics.FromImage(PictureBox1.Image)
gfx.Clear(Color.Black)
gfx.RotateTransform(90) ' Rotate by 90°
gfx.DrawImage(Image.FromFile("whatever.jpg"), New PointF(0, 0))
gfx.DrawString("Test", Me.Font, Brushes.Red, New PointF(10, 10))
gfx.DrawString("Rotate", Me.Font, Brushes.Red, New PointF(10, 10))
But beware of rotation, you'll find that you need to change the coordinates at which you draw your image (Or change the RenderingOrigin property of the graphics, setting it to the center of the image makes it easier to handle rotations), otherwise your picture won't be visible (it will be drawn, but off the visible part of the graphics).
Hope that helps