Imports System.Drawing.Imaging
Public Class Form1
Public Shared Function SetImgOpacity(ByVal imgPic As Image, ByVal imgOpac As Single) As Image
Dim bmpPic As New Bitmap(imgPic.Width, imgPic.Height)
Dim gfxPic As Graphics = Graphics.FromImage(bmpPic)
Dim cmxPic As New ColorMatrix()
Dim iaPic As New ImageAttributes()
cmxPic.Matrix33 = imgOpac
iaPic.SetColorMatrix(cmxPic, ColorMatrixFlag.[Default], ColorAdjustType.Bitmap)
gfxPic.DrawImage(imgPic, New Rectangle(0, 0, bmpPic.Width, bmpPic.Height), 0, 0, imgPic.Width, imgPic.Height, GraphicsUnit.Pixel, iaPic)
gfxPic.Dispose()
iaPic.Dispose()
Return bmpPic
End Function
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim a As Image = bmpPic.Image
SetImgOpacity(a, 50)
End Sub
End Class
When I click the button nothing happens. What am I doing wrong here ?
I believe that the color matrix values range from 0 to 1, so you should probably use 0.5 instead of 50.
You might want to set the bmpPic.Image to the value returned from your function.
Something like
Dim a As Image = bmpPic.Image
bmpPic.Image = SetImgOpacity(a, 50)
Related
I'm drawing lines in a picturebox inside a form, when I maximize the form the picturebox change height and width automatically because of anchor bounds.
Problem is that the lines are rendered in wrong way on the maximized window,and lines that should be 1 pixel width seem bigger. I'm missing some zoom proprety in picturebox control?
There is a way to avoid that?
I'm using XNA 4.0, here the basic code where pbGame is my picturebox.
Imports Microsoft.Xna.Framework
Imports Microsoft.Xna.Framework.Graphics
Private quit As Boolean = False
Public grafix As GraphicsDevice
Private Function initialize(ByRef surface As PictureBox) As Boolean
Try
Dim pparam As New PresentationParameters
pparam.DeviceWindowHandle = surface.Handle
pparam.IsFullScreen = False
Dim grafixAdapt As GraphicsAdapter = GraphicsAdapter.DefaultAdapter
grafix = New GraphicsDevice(grafixAdapt, GraphicsProfile.HiDef, pparam)
initialize = True
Catch ex As Exception
initialize = False
End Try
End Function
Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
'Set up the initialize function found above
If InitializeGraphics(pbGame) AndAlso InitializeEffect(grafix) Then
BackgroundWorker1.RunWorkerAsync()
Else
MessageBox.Show("There was a problem initializing XNA.")
Me.Close()
End If
End Sub
Private effect As BasicEffect
Private Function InitializeEffect(ByVal graphics As GraphicsDevice) As Boolean
effect = New BasicEffect(graphics)
Try
effect.VertexColorEnabled = True
effect.Projection = Matrix.CreateOrthographicOffCenter(0, graphics.Viewport.Width, graphics.Viewport.Height, 0, 0, 1)
InitializeEffect = True
Catch ex As Exception
InitializeEffect = False
End Try
End Function
Private Function Set2dLine(ByVal x1 As Integer, ByVal y1 As Integer, ByVal z1 As Integer, _
ByVal x2 As Integer, ByVal y2 As Integer, ByVal z2 As Integer, _
ByVal color As Color) As VertexPositionColor()
Dim vertices1, vertices2 As New VertexPositionColor
vertices1.Position = New Vector3(x1, y1, z1)
vertices1.Color = color
vertices2.Position = New Vector3(x2, y2, z2)
vertices2.Color = color
Return {vertices1, vertices2}
End Function
Private Sub BackgroundWorker1_DoWork(sender As System.Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
Do Until quit = True
grafix.Clear(Color.CornflowerBlue)
effect.CurrentTechnique.Passes(0).Apply()
Dim newline() As VertexPositionColor = Set2dLine(50, 10, 0, 150, 10, 0, Color.Black)
grafix.DrawUserPrimitives(PrimitiveType.LineList, newline, 0, 1)
grafix.Present()
Loop
End Sub
I am trying to write (type) directly onto a bitmap. I need to be able to type at the mouse position, so where ever on the screen i click the mouse, I can start typing text with the keyboard.
Here is a working VS 2017 VB Win Form code that will print "Hello World" at the mousedown position. But it only works with predetermined text. I would like to be able to just type at that spot. I feel I am so close, just can't get it to work.
Imports System.IO
Imports System.Windows.Forms.DataVisualization.Charting
Public Class Form1
Dim WithEvents Chart1 As New Chart
Private Structure TextPoints
Dim MPos As Point
Dim Txt As String
End Structure
Private TextList As New List(Of TextPoints)
Private TempPoint As Point
Private FirstPoint As Point
Dim xcnt As Integer = -1
Dim ycnt As Integer = -1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load
Me.Size = New Size(1100, 700)
Me.Location = New Point(10, 10)
MakeBackImage()
With Chart1
.Name = "Chart1"
.Location = New System.Drawing.Point(40, 40)
.Size = New System.Drawing.Size(1010, 610)
.BackImage = "BackImg.jpg"
.Parent = Me
End With
End Sub
Private Sub Chart1_MouseDown(ByVal sender As Object,
ByVal e As System.Windows.Forms.MouseEventArgs) _
Handles Chart1.MouseDown
FirstPoint = New Point(e.X, e.Y)
TempPoint = New Point(e.X, e.Y)
Me.Refresh()
End Sub
Private Sub Chart1_MouseUp(ByVal sender As Object,
ByVal e As System.Windows.Forms.MouseEventArgs) _
Handles Chart1.MouseUp
Dim T As New TextPoints With {
.MPos = TempPoint,
.Txt = "Hello World"}
TextList.Add(T)
Me.Refresh()
End Sub
Private Sub MakeBackImage()
Dim x, y As Integer
Dim img As Image = New Bitmap(1020, 620)
Dim graphics As Graphics = Graphics.FromImage(img)
graphics.Clear(Drawing.Color.White)
For x = 0 To 1000 Step 20
graphics.DrawLine(Pens.Black, x, 0, x, 600)
xcnt += 1
Next
For y = 0 To 600 Step 20
ycnt += 1
graphics.DrawLine(Pens.Black, 0, y, 1000, y)
Next
img.Save("BackImg.jpg", Imaging.ImageFormat.Jpeg)
End Sub
Private Sub Chart1_Paint(ByVal sender As Object,
ByVal e As System.Windows.Forms.PaintEventArgs) _
Handles Chart1.Paint
Dim drawString As String = "Hello World"
Dim drawFont As New Font("Arial", 14)
Dim drawBrush As New SolidBrush(Color.Black)
For Each t As TextPoints In TextList
e.Graphics.DrawString(t.Txt, drawFont,
drawBrush, t.MPos.X, t.MPos.Y)
Next
End Sub
End Class
This is a simplified code. Actually, the background image is only created once, but I added code to dynamically create it here to make the demo better.
I'm experimenting on paint event in Windows Form, what I want to achieved is to repaint the colors of the arrow. I think I successfully did that, I just have a question on whether should I use the Me.Invalidate or Me.Refresh when performing the repaint event on the form? Both of them are working.
Note that I will create many objects later so one of my goals is to lessen the performance issues.
When you clicked the button 1 it will change the color of the line 1 to yellow using the Me.Invalidate, when you clicked the button 2 it will change the line 1 to blue using the Me.Refresh. Both of them are working.
This is my whole code:
Public Class Form1
Private Sub Form1_Paint(sender As Object, e As PaintEventArgs) Handles MyBase.Paint
drawLeftArrow(e, "a", 100, 250, 400, 50)
End Sub
Dim aPen As Pen = New Pen(Color.Red, 8)
Dim bPen As Pen
Dim cPen As Pen
Dim line1 As Point()
Dim line2 As Point()
Dim line3 As Point()
Sub drawLeftArrow(e As PaintEventArgs, letterPosition As String, startPointX As Integer, startPointY As Integer, endPointX As Integer, endPointY As Integer)
bPen = New Pen(Color.Green, 8)
cPen = New Pen(Color.Yellow, 8)
Dim mycap As Drawing2D.CustomLineCap = New Drawing2D.AdjustableArrowCap(5, 5)
' Create points that define curve.
Dim startPoint As New Point(startPointX, startPointY)
Dim endPoint As New Point(endPointX, endPointY)
Select Case letterPosition
Case "a"
Dim middlePoint1 As New Point(startPointX + 250, startPointY)
Dim middlePoint2 As New Point(startPointX + 300, endPointY + 150)
line1 = {startPoint, middlePoint1}
line2 = {middlePoint1, middlePoint2}
line3 = {middlePoint2, endPoint}
cPen.CustomEndCap = mycap
' Draw lines between original points to screen.
e.Graphics.DrawLines(aPen, line1)
e.Graphics.DrawLines(bPen, line2)
e.Graphics.DrawLines(cPen, line3)
Exit Select
End Select
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
aPen = New Pen(Color.Yellow, 8)
Me.Invalidate()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
aPen = New Pen(Color.Blue, 8)
Me.Refresh()
End Sub
End class
Output:
I'm creating a little snipping tool-like program in VB.NET and I can screenshot any area I want provided it is a rectangle area. I select the area in the screen and save it as an image. That's easy.
My problem is that I want to be able to screenshot not only a rectangular (standard rectangle shape area), but selecting/drawing an ellipse and screenshot the inside part of it. See the image below:
is there any way to achieve this or any library I can use for that?
Here's my current code:
Public Class Form3
Private _bRubberBandingOn As Boolean = False
Private _pClickStart As New Point
Private _pClickStop As New Point
Private _pNow As New Point
Private Sub Form3_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown
Me._bRubberBandingOn = Not _bRubberBandingOn
If Me._bRubberBandingOn Then
If _pClickStart = Nothing Then _pClickStart = New Point
_pClickStart.X = e.X
_pClickStart.Y = e.Y
_pNow.X = e.X
_pNow.Y = e.Y
End If
Me.Invalidate()
End Sub
Private Sub Form3_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseMove
If Me._bRubberBandingOn Then
If _pNow = Nothing Then _pNow = New Point
Me._pNow.X = e.X
Me._pNow.Y = e.Y
Me.Invalidate()
End If
End Sub
Private Sub Form3_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp
Me._bRubberBandingOn = Not Me._bRubberBandingOn
If Not Me._bRubberBandingOn Then
If _pClickStop = Nothing Then _pClickStop = New Point
_pClickStop.X = e.X
_pClickStop.Y = e.Y
Me.Invalidate()
End If
End Sub
Private Sub Form3_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim _rRectangle As New Rectangle
Dim _penNew As New Pen(Color.Black, 2)
_rRectangle.X = _pClickStart.X
_rRectangle.Y = _pClickStart.Y
If Me._bRubberBandingOn Then
_rRectangle.Width = Me._pNow.X - _pClickStart.X
_rRectangle.Height = Me._pNow.Y - _pClickStart.Y
Else
_rRectangle.Width = Me._pClickStop.X - _pClickStart.X
_rRectangle.Height = Me._pClickStop.Y - _pClickStart.Y
End If
_penNew.DashStyle = Drawing2D.DashStyle.Solid
e.Graphics.DrawEllipse(_penNew, _rRectangle)
End Sub
End Class
Is there any way to achieve this or any library I can use for that?
Is it any way to get a handle of that painted line/shape and then use it to create a screenshot? I actually searched about this but didn't found anything meaningful yet.
thanks in advance for your time.
Take the image that you are drawing the ellipse on top of and do the following:
Dim theBitmap As Bitmap = DirectCast(Image.FromFile("PathToFileYouAreDrawingEllipseOn.bmp"), Bitmap)
Dim theEllipseBitmap As New Bitmap(theBitmap.Width, theBitmap.Height)
Dim theGraphics As Graphics = Graphics.FromImage(theEllipseBitmap)
Dim theGraphicsPath As New GraphicsPath()
' The (10,10) coordinates here are made up, you will need to take what is drawn by the user (starting x,y; ending x,y, etc.)
theGraphicsPath.AddEllipse(10, 10, theBitmap.Width - 20, theBitmap.Height - 20)
theGraphics.Clear(Color.Magenta)
theGraphics.SetClip(theGraphicsPath)
theGraphics.DrawImage(theBitmap, New Rectangle(0, 0, theBitmap.Width, theBitmap.Height), 0, 0, theBitmap.Width, theBitmap.Height, _
GraphicsUnit.Pixel)
theGraphics.Dispose()
theEllipseBitmap.MakeTransparent(Color.Magenta)
' Save the ellipse bitmap to a PNG file format
string fileName = "PathToYourDesiredOutput.png"
theEllipseBitmap.Save(fileName, System.Drawing.Imaging.ImageFormat.Png)
Looking for help here, i have a transparent picturebox (using fucshia as transparencyKey) named PB1 with PB1.Location.X = 145 , PB1.Location Y = 7 and a button named btnTakePic. The codes are as follows :
Private Sub btnTakePic_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTakePic.Click
Dim Bound As Rectangle
Dim Pic As Graphics
Dim screenshot As System.Drawing.Bitmap
Bound = Screen.PrimaryScreen.Bounds
screenshot = New System.Drawing.Bitmap(PB1.Bounds.Width, PB1.Bounds.Height, System.Drawing.Imaging.PixelFormat.Format32bppPArgb)
Pic = Graphics.FromImage(screenshot)
Pic.CopyFromScreen(CInt(LocPBX.Text), CInt(LocPBY.Text), 0, 0, Bounds.Size, CopyPixelOperation.SourceCopy)
PB1.Image = screenshot
PB1.SizeMode = PictureBoxSizeMode.StretchImage
End Sub
Private Sub Main_LocationChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.LocationChanged
LocX.Text = Me.Location.X
LocY.Text = Me.Location.Y
LocPBX.Text = Val(PB1.Location.X) + Val(LocX.Text) + 3
LocPBY.Text = Val(PB1.Location.Y) + Val(LocY.Text + 25)
End Sub
Now the question is : it produces screenshot as exactly what i want, but when i click the btnTakePic , The picture will overlap the old one, I want to erase the old picture screenshot from memory and substituting it with a new one, how to do that ?
Clear out the previous image and refresh the picturebox before taking a new shot:
Private Sub btnTakePic_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnTakePic.Click
PB1.Image = Nothing
PB1.Refresh()
Dim pt As Point = PB1.PointToScreen(New Point(0, 0))
Dim screenshot As New System.Drawing.Bitmap(PB1.Size.Width, PB1.Size.Height, System.Drawing.Imaging.PixelFormat.Format32bppPArgb)
Using Pic As Graphics = Graphics.FromImage(screenshot)
Pic.CopyFromScreen(pt.X, pt.Y, 0, 0, PB1.Size, CopyPixelOperation.SourceCopy)
End Using
PB1.Image = screenshot
PB1.SizeMode = PictureBoxSizeMode.StretchImage
End Sub
How do you know what you're taking a picture of, though, if you already have a screenshot displayed?