Combine 2 picture boxes into a new picture box - vb.net

I have my pixBox1 which is fix, and unable to change the image
and pixBox2 is not fix which can change there color and rotate in here
i use OpenFileDialog function to put image inside those pixbox
so now how can i combine those two pixbox into my pixbox3?
i try this but it doesn't look like it's going to work:
Dim image As New Bitmap(pixBox1.Image)
Dim image2 As New Bitmap(pixBox2.Image)
Dim Image3 As New Bitmap(300, 300)
Dim g As Graphics = Graphics.FromImage(Image3)
g.DrawImage(image1, New Point(300, 300))
g.DrawImage(image2, New Point(300, 300))
g.Dispose()
g = Nothing
pixBox3.Image = Image3

This is kinda ugly and slow, but it basically sets all the pixels in image2 to be 50% transparent then draws it over the top of Image.
Dim image As New Bitmap(pixBox1.Image)
Dim image2 As New Bitmap(pixBox2.Image)
Dim Image3 As New Bitmap(300, 300)
Using g As Graphics = Graphics.FromImage(Image3)
'make 2nd bmp translucent
For Integer Xcount = 0 To image2.Width - 1
For Integer Ycount = 0 To image2.Height - 1
Dim c as Color = image2.GetPixel(Xcount, Ycount)
c = Color.FromARGB(125, c.R, c.G, c.B) '50% alpha
image2.SetPixel(Xcount, Ycount, c)
Next
Next
g.DrawImage(image1, New Point(0, 0))
g.DrawImage(image2, New Point(0, 0))
End Using
pixBox3.Image = Image3
As a side note, the Using block makes sure g is disposed no matter what happens.

Related

The cropping area has an x and y offset in the new bitmap, but only if the original has been scaled

a strange phenomenon occurs.
With my edge detection program, I can transfer the inside of the GraphicsPath to a new image.
It always works great – except when I scale the original image with GIMP and Word (aspect ratio remains, only the dimensions are changed). Then the area is shifted. To the left and up. See attachement. In line 68, I looked what is in rectCutout. Everything OK.
Does this have anything to do with GIMP? The dots per inch are the same (72). The compression quality of the JPEG also (100%).
I just realized: if I scale an image larger, the result is completely black.
The strange thing is: I'm not saying: the picture that is drawn on is larger than the picture that is saved. Then it would be logical that the path is not in the same position. It's about the fact that the loaded image is just smaller.
I would be happy if someone could tell me why. 😄
this is the scaled image which is loaded
Here you see the GUI, ready to save
cropped image, area has x and y offset
#Disable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
Imports System.Drawing.Drawing2D
Imports Microsoft.WindowsAPICodePack.Dialogs
Public NotInheritable Class AllesGrafische
Public Shared Sub Paint_the_Rectangle(ByVal g As Graphics, ByVal recta As Rectangle)
If g IsNot Nothing Then
g.SmoothingMode = SmoothingMode.AntiAlias
g.CompositingQuality = CompositingQuality.HighQuality
g.PixelOffsetMode = PixelOffsetMode.HighQuality
g.InterpolationMode = InterpolationMode.HighQualityBilinear
Using Pen_Hellblau As Pen = New Pen(Color.FromArgb(0, 200, 255), 1.0F)
g.DrawRectangle(Pen_Hellblau, recta)
End Using
End If
End Sub
Public Shared Sub Draw_Curve(ByVal g As Graphics, ByVal theList As List(Of Point))
If theList IsNot Nothing AndAlso theList.Count > 0 AndAlso g IsNot Nothing Then
g.SmoothingMode = SmoothingMode.AntiAlias
g.CompositingQuality = CompositingQuality.HighQuality
g.PixelOffsetMode = PixelOffsetMode.HighQuality
g.InterpolationMode = InterpolationMode.HighQualityBilinear
Dim theList_neu As New List(Of Point)
Using gp As New GraphicsPath
For i As Integer = 1 To theList.Count - 1 Step 1
Dim a As Integer = theList(i).X
Dim b As Integer = theList(i).Y
Dim c As Integer = theList(i - 1).X
Dim d As Integer = theList(i - 1).Y
Dim Entfernungsbetrag As Double = Math.Sqrt(Math.Pow(a, 2) + Math.Pow(b, 2) + Math.Pow(c, 2) + Math.Pow(d, 2) - 2 * a * c - 2 * b * d)
If Entfernungsbetrag < Form1.erlaubte_Entfernung Then
theList_neu.Add(theList(i))
End If
Next
If theList_neu.Count = 0 Then Return
gp.AddLines(theList_neu.ToArray())
Using Pen_hellrosa As Pen = New Pen(Color.FromArgb(255, 64, 239), 1.0F)
g.DrawPath(Pen_hellrosa, gp)
End Using
If Form1.ClosePath Then
gp.CloseFigure()
End If
If Form1.CheckBox1.Checked Then
Dim Speicherpfad As String
Using SFD1 As New CommonSaveFileDialog
SFD1.Title = "Wo soll das Bild gespeichert werden?"
SFD1.Filters.Add(New CommonFileDialogFilter("PNG", ".png"))
If System.IO.Directory.Exists("C:\Users\...\source\repos\VB.NET\Get mouse position and draw rectangle on screen") Then
SFD1.InitialDirectory = "C:\Users\...\source\repos\VB.NET\Get mouse position and draw rectangle on screen"
Else
SFD1.InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.Desktop)
End If
If SFD1.ShowDialog = CommonFileDialogResult.Ok Then
Speicherpfad = SFD1.FileName & ".png"
Else
Return
End If
End Using
Using bmpSource As Bitmap = New Bitmap(Form1.Pfad_Bild)
Dim rectCutout As RectangleF = gp.GetBounds()
Using m As Matrix = New Matrix()
m.Translate(-rectCutout.Left, -rectCutout.Top)
gp.Transform(m)
End Using
Using bmpCutout As Bitmap = New Bitmap(CInt(Math.Round(rectCutout.Width, 0)), CInt(Math.Round(rectCutout.Height, 0)))
Using graphicsCutout As Graphics = Graphics.FromImage(bmpCutout)
graphicsCutout.Clip = New Region(gp)
graphicsCutout.DrawImage(bmpSource, CInt(-rectCutout.Left), CInt(-rectCutout.Top))
bmpCutout.Save(Speicherpfad, Imaging.ImageFormat.Png)
Form1.CheckBox1.Checked = False
End Using
End Using
End Using
End If
End Using
End If
End Sub
End Class
#Enable Warning CA1707 ' Bezeichner dürfen keine Unterstriche enthalten
The solution is to use .SetResolution()
Using Original As Bitmap = New Bitmap(Form1.Pfad_Bild)
Dim rectCutout As RectangleF = gp.GetBounds()
Using m As System.Drawing.Drawing2D.Matrix = New System.Drawing.Drawing2D.Matrix()
m.Translate(-rectCutout.Left, -rectCutout.Top)
gp.Transform(m)
End Using
Using bmpCutout As Bitmap = New Bitmap(CInt(Math.Round(rectCutout.Width, 0)), CInt(Math.Round(rectCutout.Height, 0)))
bmpCutout.SetResolution(Original.HorizontalResolution, Original.VerticalResolution)
.
.
.
.
.

TabControl_DrawItem tab color from Right to left

I'm trying to change tab control tab color by OwnerDrawFixed and I have this code bellow working perfectly, but I have multiple language application and I need to change the layout from lift to right and from right to left depends on application language, I need help to make this code drowse from right to left when the RightToLiftLayout = true, and from left to right (current code) when its false.
thank you .
'Firstly we'll define some parameters.
Dim CurrentTab As TabPage = TabControl1.TabPages(e.Index)
Dim ItemRect As Rectangle = TabControl1.GetTabRect(e.Index)
Dim FillBrush As New SolidBrush(Color.Red)
Dim TextBrush As New SolidBrush(Color.White)
Dim sf As New StringFormat
sf.Alignment = StringAlignment.Center
sf.LineAlignment = StringAlignment.Center
'If we are currently painting the Selected TabItem we'll
'change the brush colors and inflate the rectangle.
If CBool(e.State And DrawItemState.Selected) Then
FillBrush.Color = Color.White
TextBrush.Color = Color.Red
ItemRect.Inflate(2, 2)
End If
'Set up rotation for left and right aligned tabs
If TabControl1.Alignment = TabAlignment.Left Or TabControl1.Alignment = TabAlignment.Right Then
Dim RotateAngle As Single = 90
If TabControl1.Alignment = TabAlignment.Left Then RotateAngle = 270
Dim cp As New PointF(ItemRect.Left + (ItemRect.Width \ 2), ItemRect.Top + (ItemRect.Height \ 2))
e.Graphics.TranslateTransform(cp.X, cp.Y)
e.Graphics.RotateTransform(RotateAngle)
ItemRect = New Rectangle(-(ItemRect.Height \ 2), -(ItemRect.Width \ 2), ItemRect.Height, ItemRect.Width)
End If
'Next we'll paint the TabItem with our Fill Brush
e.Graphics.FillRectangle(FillBrush, ItemRect)
'Now draw the text.
e.Graphics.DrawString(CurrentTab.Text, e.Font, TextBrush, RectangleF.op_Implicit(ItemRect), sf)
'Reset any Graphics rotation
e.Graphics.ResetTransform()
'Finally, we should Dispose of our brushes.
FillBrush.Dispose()
TextBrush.Dispose()
This is untested but I think that you should be able to change this:
Dim sf As New StringFormat
to this:
Dim sf = If(RightToLeft,
New StringFormat(StringFormatFlags.DirectionRightToLeft),
New StringFormat)
You may need to use RightToLeftLayout rather than RightToLeft. I'm not sure as it's not something that I've ever done.

How can I copy a graphic drawn on a PictureBox to clipboard?

I have a software that builds a 3D text by using grafx.DrawString() and I need to copy this graphic to clipboard. When I try to do so, it throws a NullReferenceException.
How can I copy the graphics drawn on a PictureBox?
This is the code to draw the text:
Dim grafx As Graphics
Private Sub draw_block_text10()
Dim text_size As SizeF
Dim back_brush As Brush = Brushes.Black 'COLOR FOR THE BOARDER TEXT
Dim fore_brush As Brush = Brushes.Blue 'COLOR FOR THE MAIN TEXT
Dim fnt As New Font("Microsoft Sans Serif", NumericUpDown1.Value, FontStyle.Regular)
Dim location_x, location_y As Single 'USED IT FOR THE LOCATION
Dim i As Integer
'CREATE A GRAPHIC OBJECT IN THE PICTUREBOX.
grafx = Me.PictureBox2.CreateGraphics()
'CLEAR THE PICTUREBOX
grafx.Clear(Color.White)
'LOOK THE REQUIRED SIZE TO DRAW THE TEXT
text_size = grafx.MeasureString(Me.TextBox1.Text, fnt)
'ELIMINATE THE REDUNDANT CAlCULATION AFTER GETTING THE LOCATION.
location_x = (Me.PictureBox2.Width - text_size.Width) / 2
location_y = (Me.PictureBox2.Height - text_size.Height) / 2
'FIRST, DRAW THE BLACK BACKGROUND TO GET THE EFFECT,
'AND THE TEXT MUST BE DRAWN REAPETEDLY FROM THE OFFSET RIGHT, UP TO THE MAIN TEXT IS DRAWN.
For i = CInt(nupDepth.Value) To 0 Step -1
grafx.DrawString(TextBox1.Text, fnt, back_brush, _
location_x - i, location_y + i)
Next
Dim mydataandtimeforsave = DateTime.Now.ToString("yyyyMMddHHmmss")
'DRAW THE ROYAL BLUE FOR THE MAIN TEXT OVER THE BLACk TEXT
grafx.DrawString(TextBox1.Text, fnt, fore_brush, location_x, location_y)
Dim bmp As New Bitmap(Me.PictureBox2.Width, Me.PictureBox2.Height)
Dim g As Graphics = Graphics.FromImage(bmp)
g.Clear(Color.Transparent)
''Perform Drawing here
End Sub
This is the code to copy to clipboard:
Clipboard.SetDataObject( _
DirectCast(PictureBox2.Image.Clone, Bitmap), _
True)
Beep()
Using a Graphics object created from a PictureBox control (PictureBox.CreateGraphics()) to draw on doesn't actually set/change the Image property of the PictureBox. You can confirm that by checking for PictureBox2.Image Is Nothing, which will return true if the PictureBox had no image before drawing on it.
Instead, create an Image with the dimensions of the PictureBox, use Graphics.FromImage() to create your Graphics object, draw what you need to draw, and then assign the image to the PictureBox.Image property.
Something like this should work fine:
Dim bmp As New Bitmap(PictureBox2.Width, PictureBox2.Height)
Using g As Graphics = Graphics.FromImage(bmp)
g.Clear(Color.White)
text_size = g.MeasureString(Me.TextBox1.Text, fnt)
location_x = (Me.PictureBox2.Width - text_size.Width) / 2
location_y = (Me.PictureBox2.Height - text_size.Height) / 2
For i = CInt(nupDepth.Value) To 0 Step -1
g.DrawString(TextBox1.Text, fnt, back_brush, location_x - i, location_y + i)
Next
g.DrawString(TextBox1.Text, fnt, fore_brush, location_x, location_y)
End Using
PictureBox2.Image = bmp
Note: Always remember to dispose the created Graphics object when you finish using it either by calling .Dispose() or by wrapping it in a Using statement like what I did above.
Instead of
Clipboard.SetDataObject(DirectCast(PictureBox2.Image.Clone, Bitmap), True)
Use
Clipboard.SetDataObject(PictureBox2.Image, 2)

How to get rid of pixelated edges of a jpg?

For my student project, I’ve a vb.net code snippet that downloads a jpg file from a website and then sets all its pixels, which are almost white, entirely white:
Dim oColor As Color
Dim bRed As Byte
Dim bGreen As Byte
Dim bBlue As Byte
Dim imgTemp As Image = Image.FromFile("C:\DownloadedImage.jpg")
Dim bmpTemp As New Bitmap(imgTemp.Width, imgTemp.Height, Imaging.PixelFormat.Format32bppArgb)
Using gfx As Graphics = Graphics.FromImage(bmpTemp)
gfx.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
gfx.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
gfx.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
gfx.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
gfx.DrawImage(imgTemp, 0, 0)
End Using
For x = 0 To bmpTemp.Width - 1
For y = 0 To bmpTemp.Height - 1
oColor = bmpTemp.GetPixel(x, y)
bRed = oColor.R
bGreen = oColor.G
bBlue = oColor.B
If bRed <= 254 AndAlso bRed >= 254 - 20 Then '20 = White Tolerance'
bmpTemp.SetPixel(x, y, Color.White)
End If
If bGreen <= 254 AndAlso bGreen >= 254 - 20 Then
bmpTemp.SetPixel(x, y, Color.White)
End If
If bBlue <= 254 AndAlso bBlue >= 254 - 20 Then
bmpTemp.SetPixel(x, y, Color.White)
End If
Next
Next
Dim newForm As New Form With {.BackgroundImage = bmpTemp, .TransparencyKey = Color.White, .BackgroundImageLayout = ImageLayout.Zoom, .BackColor = Color.White}
newForm.Show()
The bitmap created in this way is then set as the BackgroundImage of a form whose TransparencyKey property is white. The result is not a complete failure, but the edges of the isolated object are still white and pixelated:
The result in two different sizes (left) and what I'm trying to achieve (right)
I’m now looking for a way to get rid of those ragged edges, something like Photoshop’s “Refine Edge” function.
Many thanks in advance!

string with surrounding color

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