I have a VB.Net PictureBox floorPlanImage on a form form1.
I load a picture into the picturebox:
floorPlanImage.image = my.resources.ResourceManager.GetObject("level8") 'this is actually dynamic, and this part works
I am trying to create an overlay to highlight a region of the image:
Public Sub highlightPrintArea(ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)
'**** DOES NOT WORK
Dim g As Graphics = Me.CreateGraphics
Dim r As Rectangle = New Rectangle(x1, y1, x2 - x1, y2 - y1) 'these are args passed in to the function
Dim pen As Pen = New Pen(Color.FromArgb(128, 32, 100, 200), 1) 'semi-transparent
Dim b As Brush = New SolidBrush(pen.Color)
g.FillRectangle(b, r)
end sub
I need to do this dynamically at runtime, say, on button click. The above function does not seem to draw the rectangle.
However, if I have a function that Handles floorPlanImage.Paint like follows, then the rectangle is drawn as I expect it to:
Private Sub floorPlanImage_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles floorPlanImage.Paint
'**** Works, but does not suit my workflow
Dim g As Graphics = e.Graphics
Dim r As Rectangle = New Rectangle(100, 100, 100, 100)
Dim pen As Pen = New Pen(Color.FromArgb(128, 32, 100, 200), 1)
Dim b As Brush = New SolidBrush(pen.Color)
g.FillRectangle(b, r)
End Sub
The Question (finally)
How can I modify my onclick function to correctly overlay the rectangle over my PictureBox?
In the onclick event you need to save the location/point to a member variable and set a flag so app knows you have a location saved. To update the picture box call Invalidate and Update.
floorPlanImage.Invalidate()
floorPlanImage.Update()
In the onpaint event test the flag that you have a point then use the saved point to draw the overlay.
Private Sub floorPlanImage_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles floorPlanImage.Paint
If hasPoint
'Draw with saved point
End If
End Sub
Related
hey every one I want to make a program that able to draw coordinate graph of Two dimensions of (x-y).when I enter a value in (x) text box and (y) text box and hit draw button it well draw the graph in the blue picture box . I searched in web sit but I found only one method that draw using the mouse and this not what I want .This is the image of the program and and it supposed to draw in white line like this image
Private Sub PictureBox2_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox2.MouseMove
Static last As Point
If e.Button = Windows.Forms.MouseButtons.Left Then
PictureBox2.CreateGraphics.DrawLine(Pens.White, last.X, last.Y, e.X, e.Y)
End If
last = e.Location
End Sub
this is the code that I found that draw using the mouse
You should use the Graphic class inside the panel's Paint event
Private Sub Panel1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs)
' Create pen.
Using blackPen As New Pen(Color.Black, 3)
' Create points that define line.
Dim point1 As New Point(100, 100)
Dim point2 As New Point(500, 100)
' Draw line to screen.
e.Graphics.DrawLine(blackPen, point1, point2)
End Using
End Sub
Then call Panle1.Invalidate() to fire the Paint event
It would be good to have a bit more details of your code, especially how and in what class you store the X and Y coordinate. By the way you draw a line between 2 points so you would need two sets of X and Y coordinate boxes on your form.
After that it is as easy as what you found on the internet using the DrawLine method (https://msdn.microsoft.com/en-us/library/system.drawing.graphics.drawline(v=vs.110).aspx), you just needs to fire it from the Click event of your "draw" button.
Hi again Ahmed
Here is a simple sample of a form that would draw a line when button is clicked. Of course it would need more bootstrapping to make sure user only enter integer value for the number of pixels and in its basic form, (0,0) is the top left of the panel but it can easily be converted for a bottom left approach...
and
Class Form1
Private Sub cmdDraw_Click(sender As Object, e As EventArgs) Handles cmdDraw.Click
Dim x1 As Integer = Integer.Parse(txtX1.Text)
Dim y1 As Integer = Integer.Parse(txtY1.Text)
Dim x2 As Integer = Integer.Parse(txtX2.Text)
Dim y2 As Integer = Integer.Parse(txtY2.Text)
pnlMap.CreateGraphics.DrawLine(New Pen(Color.Black), x1, y1, x2, y2)
End Sub
End Class
I'm writing a full screen program for windows tablets that needs to resize all of its controls to fit the screen, regardless of rotation.
right now i'm using the following:
Private Sub CreateOrder_Resize(sender As Object, e As EventArgs) Handles MyBase.Resize
Dim widthMultiplier As Decimal = (Me.Width * 0.99) / itemsPanel.Width 'this panel is 99% as tall as the form initially, and 80% as tall
Dim heightMultiplier As Decimal = (Me.Height * 0.8) / itemsPanel.Height
resizeEverything(Me.Controls, widthMultiplier, heightMultiplier)
End Sub
Private Sub resizeEverything(ByRef container As Object, ByVal widthMultiplier As Decimal, ByVal heightMultiplier As Decimal)
For Each screenItem In container
screenItem.location = New Point(screenItem.location.x * widthMultiplier, screenItem.location.y * heightMultiplier)
screenItem.size = New Size(screenItem.width * widthMultiplier, screenItem.height * heightMultiplier)
checkIfFont(screenItem, widthMultiplier)
If screenItem.GetType() = (New Panel).GetType Then
resizeEverything(screenItem.controls, widthMultiplier, heightMultiplier)
End If
Next
End Sub
Private Sub checkIfFont(ByRef viewObject As Object, ByVal multiplier As Decimal)
Dim fontCarriers() As Object = {New RichTextBox, New Label, New TextBox, New ListBox, New DateTimePicker, New ComboBox}
For Each controlType In fontCarriers
If viewObject.GetType = controlType.GetType Then
controlType = viewObject
Dim myFont As Font = controlType.font
Dim newFont As Font = New Font(myFont.Name, myFont.Size * multiplier, myFont.Style)
viewObject.font = newFont
Exit For
End If
Next
End Sub
This has proven to be far too resource intensive for some of the tablets I've had to put it on.
I havent used Autoscale because the form needs to 'squish' a bit when the tablet is used in portrait mode, and as far as i'm aware, autoscale maintains aspect ratio.
So how can i do this without grinding through and resizing each control?
Any help would be appreciated. How do I create a colored dot on a panel on where a user clicks his mouse? I can get the coordinates of the mouse click and output it through a message box but I can't draw the dot on the panel where the user clicked. I have these codes tried.
Private Sub createDot(x, y)
MsgBox(x & " " & y)
Dim myGraphics As Graphics = Me.CreateGraphics
Dim myPen As Pen
myPen = New Pen(Drawing.Color.Maroon, 20)
myGraphics.DrawRectangle(myPen, x, y, 1, 1)
End Sub
Private Sub Panel1_MouseClick(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Panel1.MouseClick
missed += 1
lblMissed.Text = missed
Dim x, y As Integer
x = e.X.ToString
y = e.Y.ToString
createDot(x, y)
End Sub
Thanks!
Three things:
1.If you draw on panel you should use Panel1.CreateGraphics not Me.CreateGraphics
2.The width of the pen is to large for a dot. Use 1 instead
3.Do not convert x, y to strings and pass it to createDot
Caution:
As soon as the panel is invalidated (for example you move another window over it) the dot will disappear. The drawing code should be in the Panel1_Paint event` (Scott Chamberlain)
Private Sub createDot(ByVal x As Integer, ByVal y As Integer)
MsgBox(x.ToString & " " & y.ToString)
Dim myGraphics As Graphics = Panel.CreateGraphics
Dim myPen As Pen
myPen = New Pen(Drawing.Color.Maroon, 1)
myGraphics.DrawRectangle(myPen, x, y, 1, 1)
End Sub
Private Sub Panel1_MouseClick(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Panel1.MouseClick
missed += 1
lblMissed.Text = missed
createDot(e.x, e.y)
End Sub
If you want to create dot on panel you should change Me.CreateGraphics to Panel1.CreateGraphics
Remove ToString from
x=e.X
y=e.Y
I try to achieve to paint a form with a gradient backcolor and overlap an image with transparency.
This is possible?
I want using a tile background image with transparent background and paint the background with a custom linear gradient.
I do it!, I want share my solution with you (It's pretty easy):
External help: Tile a Shape with an Image
Private Sub BackgroundGradient(ByRef Control As Object, _
ByVal Color1 As Drawing.Color, _
ByVal Color2 As Drawing.Color)
Dim vLinearGradient As Drawing.Drawing2D.LinearGradientBrush = _
New Drawing.Drawing2D.LinearGradientBrush(New Drawing.Point(Control.Width, Control.Height), _
New Drawing.Point(Control.Width, 0), _
Color1, _
Color2)
Dim vGraphic As Drawing.Graphics = Control.CreateGraphics
' To tile the image background - Using the same image background of the image
Dim vTexture As New Drawing.TextureBrush(Control.BackgroundImage)
vGraphic.FillRectangle(vLinearGradient, Control.DisplayRectangle)
vGraphic.FillRectangle(vTexture, Control.DisplayRectangle)
vGraphic.Dispose() : vGraphic = Nothing : vTexture.Dispose() : vTexture = Nothing
End Sub
Here's how to draw the gradient background. Tiling the image will be slow unless you use the windows API or something.
Imports System.Drawing
Public Class frmBG
Private Sub frmBG_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
Dim g As Graphics = e.Graphics
Dim p1 As Point = Me.ClientRectangle.Location
Dim p2 As Point = New Point(Me.ClientRectangle.Right, Me.ClientRectangle.Bottom)
Using brsGradient As New System.Drawing.Drawing2D.LinearGradientBrush(p1, p2, Color.Red, Color.Blue)
g.FillRectangle(brsGradient, e.ClipRectangle)
g.DrawImage(My.Resources.demoImage, Me.ClientRectangle.Location)
End Using
End Sub
Private Sub frmBG_ResizeEnd(sender As Object, e As System.EventArgs) Handles Me.ResizeEnd
Me.Invalidate()
End Sub
End Class
I'm writing a program that (amongst other things) provides an IDE-like environment for the user where they can select one or more objects with a rectangualr selection tool.
All selections will be a simple rectangle, and all selectable objects will be simple rectangles as well.
I already have the code (VB.Net) to create the rubber-banding effect visually - what I need is an efficient algorithm that will tell me what objects have at least a portion of their area within the final selection rectangle.
If it helps to visualize, what I want to do would be identical to dragging a selection box over icons on the Windows desktop... whichever icons have even a portion of their areas located within that selection marquee are highlighted (selected).
Any help would be appreciated... thank you in advance
Dim Rect1 As New Rectangle(10, 10, 20, 20)
Dim Rect2 As New Rectangle(5, 5, 20, 20)
Debug.Print(Rect1.IntersectsWith(Rect2))
IntersectsWith works as BigFunger already has mentioned. But aditionally you should check if a rectangle contains another rectangle(intersectsWith only checks for intersection).
A small sample-form that demonstrates it:
Public Class SelectionRectangle
Private first As Point
Private allRectangles As New List(Of RectangleF)
Private Sub form_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseDown
first = New Point(e.X, e.Y)
End Sub
Private Sub form_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseUp
Dim p As New Pen(Brushes.Black, 2)
Dim g As Graphics
Dim second As New Point(e.X, e.Y)
Dim x, y, w, h As Int32
x = DirectCast(IIf(first.X > second.X, second.X, first.X), Int32)
y = DirectCast(IIf(first.Y > second.Y, second.Y, first.Y), Int32)
w = Math.Abs(second.X - first.X)
h = Math.Abs(second.Y - first.Y)
Dim nextRec As New RectangleF(x, y, w, h)
Dim intersects As Boolean = False
For Each rec As RectangleF In allRectangles
If rec.Contains(nextRec) OrElse rec.IntersectsWith(nextRec) Then
intersects = True
Exit For
End If
Next
If Not intersects Then
p.DashStyle = System.Drawing.Drawing2D.DashStyle.Dot
g = Me.CreateGraphics()
g.DrawLine(p, first.X, first.Y, second.X, first.Y)
g.DrawLine(p, second.X, second.Y, first.X, second.Y)
g.DrawLine(p, first.X, first.Y, first.X, second.Y)
g.DrawLine(p, second.X, second.Y, second.X, first.Y)
allRectangles.Add(nextRec)
Else
Beep()
End If
End Sub
End Class
UPDATE: changed this code to 1.first check in both directions and 2. and more important for you: checks also if one rectangle not only intersects another but additionally if it contains another.