I was trying to build a custom CheckBox, but I see a black rectangle around it. Why does this happen? And why the second CheckBox has the first overlapped?
It looks like there's a black rectangle in a default position of the control. When I add one more CheckBox, the second looks like 2 CheckBox-es in the same position.
Public Class mycheckbox
Inherits CheckBox
Protected Overrides Sub onpaint(pevent As PaintEventArgs)
pevent.Graphics.FillRectangle(New SolidBrush(BackColor), Location.X, Location.Y, Width, Height)
Dim brsh As New SolidBrush(Color.YellowGreen)
Dim boxside As Integer = CInt(pevent.Graphics.MeasureString(Text, Font, Width).Height)
pevent.Graphics.FillRectangle(brsh, Location.X, Location.Y, Width, Height)
If Checked And Enabled Then
pevent.Graphics.DrawImage(My.Resources.X, Location.X + 1, Location.Y + 1, 18, 18)
pevent.Graphics.DrawRectangle(Pens.Black, New Rectangle(Location.X, Location.Y, 19, 19))
pevent.Graphics.DrawString(Text, Font, Brushes.Black, boxside + 15, 11)
End If
brsh.Dispose()
End Sub
End Class
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim mcb1 As New mycheckbox
Dim mcb2 As New mycheckbox
mcb1.Name = "cb1"
mcb1.Text = "Hello!!!"
mcb1.Location = New Point(10, 10)
mcb1.Size = New Size(300, 30)
mcb2.Name = "cb2"
mcb2.Text = "Hi!!!"
mcb2.Location = New Point(10, 50)
mcb2.Size = New Size(300, 30)
Me.Controls.Add(mcb1)
Me.Controls.Add(mcb2)
End Sub
Related
I am trying to make a game where I bounce a ball off of the ground which is drawn as a closed curve (The green part), I just don't know how I would go about calculating the collision between the ball and curve.
I've drawn both the ball and curve using graphics in a picturebox, I imagine I have to do it mathematically as I can't find any builtin functionality in Visual basic that lets me do it.
My code:
Public Class Form1
Dim BallSpeedY, BallSpeedX As Double
Dim BallLoc As Point
Dim Start As Boolean = False
Dim gameTime As Decimal = 60.1
Dim gameTimeFont As New Font("Arial", 24, FontStyle.Bold)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.WindowState = FormWindowState.Maximized
'Size of the picturebox that is being drawn on
PictureBox1.Width = Me.Width
PictureBox1.Height = Me.Height - 24
DrawGame(False, False, True)
End Sub
Private Sub DrawGame(refreshMap As Boolean, drawBall As Boolean, drawTime As Boolean)
Dim g As Graphics = Graphics.FromImage(PictureBox1.Image)
Static startcornerpt As PointF
Static firstpt As PointF
Static pt2 As PointF
Static pt3 As PointF
Static pt4 As PointF
Static pt5 As PointF
Static lastpt As PointF
Static Endcornerpt As PointF
' Clears the window
g.Clear(Color.White)
If refreshMap Then
Randomize() ' The rnd seed would always be the same if this is not done
' Creates 5 points chosen at random positions on the window within certain parameters
startcornerpt = New PointF(0, Me.Height)
pt2 = New PointF(Me.Width * 0.2, Me.Height * ((39 * Rnd() + 30) / 100))
firstpt = New PointF(0, pt2.Y * 0.5 * 2)
pt3 = New PointF(Me.Width * 0.4, Me.Height * ((39 * Rnd() + 30) / 100))
pt4 = New PointF(Me.Width * 0.6, Me.Height * ((39 * Rnd() + 30) / 100))
pt5 = New PointF(Me.Width * 0.8, Me.Height * ((39 * Rnd() + 30) / 100))
lastpt = New PointF(Me.Width, pt5.Y * 0.5 * 2)
Endcornerpt = New PointF(Me.Width, Me.Height)
End If
' Draws the map with the 5 points
Dim curvepoints As PointF() = {startcornerpt, firstpt, pt2, pt3, pt4, pt5, lastpt, Endcornerpt}
g.FillClosedCurve(Brushes.PaleGreen, curvepoints)
If drawBall Then
' Draws the ball
g.DrawEllipse(Pens.Blue, BallLoc.X, BallLoc.Y, 20, 20)
g.FillEllipse(Brushes.Blue, BallLoc.X, BallLoc.Y, 20, 20)
' Accelerates speed
BallSpeedY = BallSpeedY - 1
' Update position
BallLoc = New Point(BallLoc.X + BallSpeedX, BallLoc.Y - BallSpeedY)
End If
If drawTime Then
gameTime = gameTime - 0.1
gameTime.ToString()
g.DrawString(gameTime, gameTimeFont, Brushes.Black, Me.Width / 2 - 120, Me.Height * 0.025) ' Draws the gametime on screen,
' Width is set to be around the middle of the screen while height is just under the strip menu.
End If
PictureBox1.Refresh()
End Sub
Private Sub StartToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles StartToolStripMenuItem.Click
If Start = False Then
gameTime = 60.1
'Resets ball for testing
BallLoc.X = 800
BallLoc.Y = 300
BallSpeedY = 0
'Starts the timers
Gravity.Start()
Movement.Start()
Start = True
ElseIf Start = True Then
' Resets the ball
Dim ballloc As New Point(800, 300)
Gravity.Stop()
Movement.Stop()
Start = False
End If
End Sub
Private Sub NewMapToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles NewMapToolStripMenuItem.Click
' Creates a new map
DrawGame(True, False, False)
Start = False
End Sub
Private Sub Movement_Tick(sender As Object, e As EventArgs) Handles Movement.Tick
' Starts movement of the ball
DrawGame(False, True, True)
End Sub
End Class
EDIT: Collision now works with these additions:
Dim wider = CType(ground.Clone(), GraphicsPath)
Using widenizer As Pen = New Pen(Color.Black, ballDiameter)
wider.Widen(widenizer)
End Using
And:
If ground.IsVisible(BallLoc) OrElse wider.IsVisible(BallLoc) Then
BallSpeedY = BallSpeedY + 50 ' rebound on collision
End If
The code below illustrates the comment I've added about using Widen() so you can test using the center of the ball.
It has been ages since I've done any VB.NET, but it does show the idea:
Imports System.Drawing.Drawing2D
Partial Public Class Form1
Inherits Form
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim diameter As Integer = 10
Dim path As GraphicsPath = New GraphicsPath()
path.AddCurve(New Point() {New Point(0, 100), New Point(200, 200), New Point(400, 100)})
path.AddLines(New Point() {New Point(400, 400), New Point(0, 400)})
path.CloseAllFigures()
e.Graphics.FillPath(Brushes.Green, path)
Dim wider = CType(path.Clone(), GraphicsPath)
Using widenizer As Pen = New Pen(Color.Black, diameter)
wider.Widen(widenizer)
End Using
For x As Integer = 0 To 400 Step diameter
For y As Integer = 0 To 400 Step diameter
If path.IsVisible(x, y) OrElse wider.IsVisible(x, y) Then
e.Graphics.DrawEllipse(Pens.Red, CType(x - diameter / 2, Single), CType(y - diameter / 2, Single), diameter, diameter)
Else
e.Graphics.DrawEllipse(Pens.Blue, CType(x - diameter / 2, Single), CType(y - diameter / 2, Single), diameter, diameter)
End If
Next y
Next x
End Sub
End Class
It fills the area with circles, where the red ones are "touching" the ground:
I have created a custom trackbar that gives values between 100-1600. The problem is that i havent been able to reduce the size of the trackbar. The trackbar has to have the width as 1600 for a user to be able to access all the values and keep the thumb in the trackbar at the same time. Here is my code :
Public Class myTrackBar
Inherits Control
'Public Value As Integer
Private Pointer As New Bitmap(25, 30)
Private Rect As New Rectangle(100, 0, 20, 30)
Public Event Scroll(ByVal Sender As Object, ByVal e As ValueChangedEventArgs)
Private Moving As Boolean
Private Offset As Integer
Public Sub New()
'Size = New Size(210, 50)
DoubleBuffered = True
Using g As Graphics = Graphics.FromImage(Pointer)
g.Clear(Color.White)
g.FillRectangle(Brushes.DarkBlue, New Rectangle(0, 0, 50, 50))
'g.FillPolygon(Brushes.Blue, New Point() {New Point(0, 15), New Point(5, 20), New Point(10, 15)})
'g.FillEllipse(Brushes.DarkBlue, 0, 0, 19, 19)
End Using
End Sub
Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
e.Graphics.FillRectangle(Brushes.White, New Rectangle(0, 0, Width - 100, Height))
Dim X As Integer = 15
' For count As Integer = 1 To 10
e.Graphics.DrawLine(New Pen(Brushes.Green, 16), New Point(0, 15), New Point(Width - 100, 15))
' X += 20
'Next
' Using P As New Pen(Brushes.Black, 1)
'P.DashStyle = Drawing2D.DashStyle.Dot
'e.Graphics.DrawRectangle(P, New Rectangle(100, 1, Width - 5, Height - 5))
'End Using
e.Graphics.DrawImage(Pointer, Rect)
e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
End Sub
Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
If Rect.Contains(e.Location) Then
Moving = True
Offset = (e.Location.X - Rect.X)
End If
End Sub
Protected Overrides Sub OnMouseup(ByVal e As System.Windows.Forms.MouseEventArgs)
Moving = False
End Sub
Protected Overrides Sub OnMouseMove(ByVal e As System.Windows.Forms.MouseEventArgs)
If Moving Then
Rect.X = Math.Min(Math.Max(e.Location.X - Offset, 0), 1500)
Invalidate()
RaiseEvent Scroll(Me, New ValueChangedEventArgs(Rect.X))
End If
End Sub
Public Property Value As Integer
Get
Return CInt((Rect.X + 100))
End Get
Set(ByVal value As Integer)
Rect.X = CInt(value)
End Set
End Property
End Class
There are various dlls available online for trackbars. If you want to simply use it in a project you can simply import the dll files into the project and use them like any other element.
I am trying to place a custom user control over the top of a PictureBox control but I cannot seem for the life of me how to set the transparency of the user control so it doesn't chop out the PictureBox image.
My User Control consists of a RectangleShape with text in the middle to create a 'Badge' icon on top of an image (see pictures below). The PictureBox and User Control both sit inside a Panel control and I have set the PictureBox.SendToBack() property and UserControl.BringToFront() property.
What I am left with is this:
My Code looks like this:
Option Explicit On
Option Strict On
Imports Microsoft.VisualBasic.PowerPacks
Public Class BadgeIcon
Inherits UserControl
Private _value As Integer
Private canvas As New ShapeContainer
Private Badge_Icon As New RectangleShape
Private rect As New Rectangle
Private m_BorderColor As Color = Color.White
Private m_FillColor As Color = Color.Red
Private m_BorderThickness As Integer = 2
Private m_BadgeFont As New Font("Segoe UI", 7, FontStyle.Bold)
Private m_BadgeText As String
Private m_TextColor As New SolidBrush(Color.White)
Private m_TextSize As Size
Private m_TextPadding As Integer = 5
Public Property Value() As Integer
Get
Return _value
End Get
Set(value As Integer)
_value = value
m_BadgeText = CStr(_value)
m_TextSize = TextRenderer.MeasureText(m_BadgeText, m_BadgeFont)
rect.Width = m_TextSize.Width + m_TextPadding
rect.Height = m_TextSize.Height + m_TextPadding
Me.Refresh()
End Set
End Property
Protected Overrides ReadOnly Property CreateParams() As System.Windows.Forms.CreateParams
Get
Dim cp As CreateParams = MyBase.CreateParams
cp.ExStyle = &H20
Return cp
End Get
End Property
Sub New()
' This call is required by the designer.
InitializeComponent()
SetStyle(ControlStyles.SupportsTransparentBackColor, True)
SetStyle(ControlStyles.Opaque, False)
SetStyle(ControlStyles.DoubleBuffer, True)
SetStyle(ControlStyles.AllPaintingInWmPaint, True)
SetStyle(ControlStyles.UserPaint, True)
Me.BackColor = Color.FromArgb(0, 0, 0, 0)
UpdateStyles()
' Add any initialization after the InitializeComponent() call.
canvas.Parent = Me
Badge_Icon.Parent = canvas
canvas.BackColor = Color.FromArgb(0, 0, 0, 0)
'Create Badge Icon
With Badge_Icon
.BackColor = Color.FromArgb(0, 0, 0, 0)
.BorderColor = m_BorderColor
.BorderWidth = m_BorderThickness
.BorderStyle = Drawing2D.DashStyle.Solid
.CornerRadius = 11
.FillColor = m_FillColor
.FillStyle = FillStyle.Solid
.SelectionColor = Color.Transparent
End With
AddHandler Badge_Icon.Paint, AddressOf BadgeIcon_Paint
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
MyBase.OnPaint(e)
DrawBadgeIcon(e)
End Sub
Public Sub DrawBadgeIcon(e As PaintEventArgs)
Try
'Alter the size of the icon to fix the text
With Badge_Icon
.Location = New Point(rect.Left + 1, rect.Top + 1)
.Size = New Size(rect.Width, rect.Height - 1)
End With
Catch ex As Exception
ErrorTrap(ex, "cls_NotificationBadgeIcon: DrawBadgeIcon()")
End Try
End Sub
Private Sub BadgeIcon_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs)
Dim textRect As New Rectangle(2, 2, m_TextSize.Width + m_TextPadding - 1, m_TextSize.Height + m_TextPadding - 2)
'Draw the Text
Dim flags As New StringFormat
flags.Alignment = StringAlignment.Center
flags.LineAlignment = StringAlignment.Center
e.Graphics.TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit
e.Graphics.DrawString(m_BadgeText, m_BadgeFont, m_TextColor, textRect, flags)
End Sub
End Class
Then to add everything to my main form I call the following:
Dim pic As New PictureBox
pic.Image = My.Resources.Notifications
pic.SizeMode = PictureBoxSizeMode.StretchImage
pic.Location = New Point(21, 221)
pic.Size = New Size(42, 29)
pnlLeftMenuBar.Controls.Add(pic)
pic.SendToBack()
Dim Counter_Notify As New BadgeIcon
Counter_Notify.Location = New Point(50, 240)
pnlLeftMenuBar.Controls.Add(Counter_Notify)
Counter_Notify.BringToFront()
And simply use Counter_Notify.Value = 1 to update the counter value.
How can I remove the square rectangle chopping out the background image? Or should I be setting this up an entirely different way? I'm a little new to User Controls.
Any help appreciated. Thanks
Using the paint event you can draw right on the picturebox itself.
Private Sub pb__Paint(sender As System.Object, e As System.Windows.Forms.PaintEventArgs) Handles pb.Paint
Dim bgRect As New Rectangle({x,y,width,height})
Dim textRect As New Rectangle(bgRect.X - {?}, bgRect.Y = {?}, width, height)
e.Graphics.FillEllipse(New SolidBrush(Color.Red), bgRect)
e.Graphics.DrawEllipse(New Pen(Color.White, 10), bgRect)
Using sf As New StringFormat
sf.LineAlignment = StringAlignment.Center
sf.Alignment = StringAlignment.Center
e.Graphics.DrawString("1", {your font}, {your brush}, textRect, sf)
End Using
End Sub
I want to place my Crop Control on center of image of picture box. I have tried following code
Dim oCropControl As new CropControl
Dim oControlLocation As Point
oControlLocation = New Point(peImageViewer.Width / 2, peImageViewer.Height / 2)
oCropControl.Location = New Point(oControlLocation.X, oControlLocation.Y)
But this is not working well.. :( Crop Control shown in bottom.
Thanks in advance!!
Assuming they are both parented to the same control you could do it like this:
Dim rect1 As Rectangle = Me.myPictureBox.Bounds
Dim rect2 As Rectangle = Me.myCropControl.Bounds
rect2.X = CInt(rect1.X + ((rect1.Width / 2) - (rect2.Width / 2)))
rect2.Y = CInt(rect1.Y + ((rect1.Height / 2) - (rect2.Height / 2)))
Me.myCropControl.Bounds = rect2
Me.myCropControl.BringToFront()
Example
Public Class Form1
Public Sub New()
Me.InitializeComponent()
Me.Size = New Size(400, 400)
Me.StartPosition = FormStartPosition.CenterScreen
Me.myButton = New Button() With {.Location = New Point(3, 3), .Text = "ALIGN!"}
Me.myCropControl = New Label() With {.Bounds = New Rectangle(245, 263, 60, 60), .BackColor = Color.Blue, .ForeColor = Color.White, .Text = "CROP", .TextAlign = ContentAlignment.MiddleCenter}
Me.myPictureBox = New PictureBox() With {.Bounds = New Rectangle(23, 56, 246, 143), .BackColor = Color.Red}
Me.Controls.AddRange({Me.myButton, Me.myCropControl, Me.myPictureBox})
End Sub
Private Sub Align(sender As Object, e As EventArgs) Handles myButton.Click
Dim rect1 As Rectangle = Me.myPictureBox.Bounds
Dim rect2 As Rectangle = Me.myCropControl.Bounds
rect2.X = CInt(rect1.X + ((rect1.Width / 2) - (rect2.Width / 2)))
rect2.Y = CInt(rect1.Y + ((rect1.Height / 2) - (rect2.Height / 2)))
Me.myCropControl.Bounds = rect2
Me.myCropControl.BringToFront()
End Sub
Private WithEvents myButton As Button
Private myCropControl As Label
Private myPictureBox As PictureBox
End Class
I have a problem in flipping text in VB.NET
It is flipped but with no line brake
See the Link:
http://www.spider-news.net/Flip_Text_question.JPG
Imports System.Drawing.Drawing2D
Imports System.Drawing
Public Class Form1
Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
' Draw the text and the surrounding rectangle START.
Dim text1 As String = RichTextBox1.Text
Dim font1 As New Font("Arial", 10, FontStyle.Bold, GraphicsUnit.Point)
Try
Dim rect1 As New Rectangle(10, 10, 1000, 140)
' Create a StringFormat object with the each line of text, and the block
' of text centered on the page.
Dim stringFormat As New StringFormat()
stringFormat.Alignment = StringAlignment.Center
stringFormat.LineAlignment = StringAlignment.Center
' Draw the text and the surrounding rectangle.
e.Graphics.DrawString(text1, font1, Brushes.Blue, rect1, stringFormat)
e.Graphics.DrawRectangle(Pens.Black, rect1)
Finally
font1.Dispose()
End Try
' Draw the text and the surrounding rectangle END.
'' FLIP TEXT ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Draw Flipped Text the text surrounding rectangle START.
Using the_font As New Font("Arial", 20, FontStyle.Bold, GraphicsUnit.Point)
DrawFlippedText(e.Graphics, the_font, Brushes.Black, 10, 10, RichTextBox1.Text, True, False)
Dim txt_size As SizeF
txt_size = e.Graphics.MeasureString(RichTextBox1.Text, the_font)
e.Graphics.DrawRectangle(Pens.Red, 10, 10, txt_size.Width, txt_size.Height)
End Using
' Draw Flipped Text the text surrounding rectangle END.
'' FLIP TEXT ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub
Public Sub DrawFlippedText(ByVal gr As Graphics, ByVal the_font As Font, ByVal the_brush As Brush, ByVal x As Integer, ByVal y As Integer, ByVal txt As String, ByVal flip_x As Boolean, ByVal flip_y As Boolean)
' Save the current graphics state.
Dim state As GraphicsState = gr.Save()
' Set up the transformation.
Dim scale_x As Integer = IIf(flip_x, -1, 1)
Dim scale_y As Integer = IIf(flip_y, -1, 1)
gr.ResetTransform()
gr.ScaleTransform(scale_x, scale_y)
' Figure out where to draw.
Dim txt_size As SizeF = gr.MeasureString(txt, the_font)
If flip_x Then x = -x - RichTextBox1.Size.Width
If flip_y Then y = -y - RichTextBox1.Size.Height
Dim rect1 As New Rectangle(10, 10, 1000, 140)
Dim stringFormat As New StringFormat()
stringFormat.Alignment = StringAlignment.Center
stringFormat.LineAlignment = StringAlignment.Center
' Draw.
gr.DrawString(txt, the_font, the_brush, x, y)
' Restore the original graphics state.
gr.Restore(state)
End Sub
End Class
Please HELP
My guess is that if the linebreaks are not there you have to split the string into single words.
Then concatenate the words one by one and measure the lenght. if it exceeds your line width draw this string and continue with the next words.
The next draw should be on y-coordinate + your line-height.
I did this in a pdf where i place a text to an absolute position which could be more than 1 line:
Dim splitted As String() = text.Split()
Dim tempchunk As Chunk = New Chunk("", pdfFont)
Dim count As Integer = 0
For Each s As String In splitted
Dim chunk2 As Chunk
chunk2 = New Chunk(tempchunk.Content, pdfFont)
chunk2.Append(" " & s)
If chunk2.GetWidthPoint() > 155 Then
cb.SaveState()
cb.BeginText()
cb.MoveText(x, y - (13 * count))
cb.SetFontAndSize(bfont, 11)
cb.ShowText(tempchunk.Content.Trim())
cb.EndText()
cb.RestoreState()
tempchunk = New Chunk(s, pdfFont)
count += 1
Else
tempchunk.Append(" " & s)
End If
Next
If tempchunk.Content <> "" Then
cb.SaveState()
cb.BeginText()
cb.MoveText(x, y - (13 * count))
cb.SetFontAndSize(bfont, 11)
cb.ShowText(tempchunk.Content.Trim())
cb.EndText()
cb.RestoreState()
End If
Its the code for the pdf but maybe it helps
Try this.
I created a bitmap, draw the string and rectangle there, flipped it, then draw the bitmap (with flipped text) on the Form.
Public Class Form1
Private Sub RichTextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RichTextBox1.TextChanged
Dim b As New Bitmap(300, 100)
Dim g As Graphics = Graphics.FromImage(b)
Dim d As Graphics = Me.CreateGraphics
Dim r As New Rectangle(0, 0, b.Width - 1, b.Height - 1)
Dim f As New StringFormat
f.Alignment = StringAlignment.Center
f.LineAlignment = StringAlignment.Center
g.Clear(BackColor)
g.DrawRectangle(Pens.Red, r)
g.DrawString(RichTextBox1.Text, RichTextBox1.Font, Brushes.Blue, r, f)
b.RotateFlip(RotateFlipType.RotateNoneFlipX)
d.DrawImageUnscaled(b, 10, 10)
g.Dispose()
b.Dispose()
d.Dispose()
End Sub
End Class