Anyone knows what I'm doing wrong to my custom rounded panel have serrated edges? I tried to search about anti-aliasing, but I'm finding difficult to know where I must add the code in my class. Does anyone have any suggestions?
I found some articles in the internet but no one works properly. The panel continues with the serrated borders. :(
Imports System.Diagnostics
Imports System.ComponentModel
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Drawing.Drawing2D
Public Class Custom_Panel_1
Inherits Panel```
Private pen As Pen = New Pen(_borderColor, penWidth)
Private Shared ReadOnly penWidth As Single = 2.0F
Public Sub New()
End Sub
Private _borderColor As Color = Color.White
<Browsable(True)>
Public Property BorderColor() As Color
Get
Return _borderColor
End Get
Set(ByVal Value As Color)
_borderColor = Value
pen = New Pen(_borderColor, penWidth)
Invalidate()
End Set
End Property
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
MyBase.OnPaint(e)
ExtendedDraw(e)
DrawBorder(e.Graphics)
End Sub
Private _edge As Integer = 50
<Browsable(True)>
Public Property Edge() As Integer
Get
Return _edge
End Get
Set(ByVal Value As Integer)
_edge = Value
Invalidate()
End Set
End Property
Private Function GetLeftUpper(ByVal e As Integer) As Rectangle
Return New Rectangle(0, 0, e, e)
End Function
Private Function GetRightUpper(ByVal e As Integer) As Rectangle
Return New Rectangle(Width - e, 0, e, e)
End Function
Private Function GetRightLower(ByVal e As Integer) As Rectangle
Return New Rectangle(Width - e, Height - e, e, e)
End Function
Private Function GetLeftLower(ByVal e As Integer) As Rectangle
Return New Rectangle(0, Height - e, e, e)
End Function
Private Sub ExtendedDraw(ByVal e As PaintEventArgs)
e.Graphics.SmoothingMode = SmoothingMode.AntiAlias
Dim path As GraphicsPath = New GraphicsPath()
path.StartFigure()
path.StartFigure()
path.AddArc(GetLeftUpper(Edge), 180, 90)
path.AddLine(Edge, 0, Width - Edge, 0)
path.AddArc(GetRightUpper(Edge), 270, 90)
path.AddLine(Width, Edge, Width, Height - Edge)
path.AddArc(GetRightLower(Edge), 0, 90)
path.AddLine(Width - Edge, Height, Edge, Height)
path.AddArc(GetLeftLower(Edge), 90, 90)
path.AddLine(0, Height - Edge, 0, Edge)
path.CloseFigure()
Region = New Region(path)
End Sub
Private Sub DrawSingleBorder(ByVal graphics As Graphics)
graphics.DrawArc(pen, New Rectangle(0, 0, Edge, Edge),
180, 90)
graphics.DrawArc(pen, New Rectangle(Width - Edge - 1, -1,
Edge, Edge), 270, 90)
graphics.DrawArc(pen, New Rectangle(Width - Edge - 1,
Height - Edge - 1, Edge, Edge), 0, 90)
graphics.DrawArc(pen, New Rectangle(0, Height - Edge - 1,
Edge, Edge), 90, 90)
graphics.DrawRectangle(pen, 0.0F, 0.0F, CType((Width - 1),
Single), CType((Height - 1), Single))
End Sub
Private Sub Draw3DBorder(ByVal graphics As Graphics)
'TODO Implement 3D border
End Sub
Private Sub DrawBorder(ByVal graphics As Graphics)
DrawSingleBorder(graphics)
End Sub
End Class```
Related
Almost everytime I close VisualStudio my custom ToggleControl changes it's properties (size, location, margin) so it moves around in Designer, and gets bigger and bigger...
As I checked now location was set to 32000;32000, margin to 3;69000;3;69000 and size also some big number.
What could be the issue with this? I can't really find anything.
On another Tabcontrol I have the same ToggleControl that works fine, I tried to copy it but result is same.
Edit: Added control code
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.Windows.Forms
Public Class Toggle
Inherits System.Windows.Forms.UserControl
Private _checked As Boolean
Public Property Checked As Boolean
Get
Return _checked
End Get
Set(ByVal value As Boolean)
If Not _checked.Equals(value) Then
_checked = value
Me.OnCheckedChanged()
End If
End Set
End Property
Protected Overridable Sub OnCheckedChanged()
RaiseEvent CheckedChanged(Me, EventArgs.Empty)
End Sub
Public Event CheckedChanged(ByVal sender As Object, ByVal e As EventArgs)
Protected Overrides Sub OnMouseClick(e As MouseEventArgs)
Me.Checked = Not Me.Checked
Me.Invalidate()
MyBase.OnMouseClick(e)
End Sub
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Me.OnPaintBackground(e)
e.Graphics.SmoothingMode = SmoothingMode.AntiAlias
Using path = New GraphicsPath()
Dim d = Padding.All
Dim r = Me.Height - 2 * d
path.AddArc(d, d, r, r, 90, 180)
path.AddArc(Me.Width - r - d, d, r, r, -90, 180)
path.CloseFigure()
e.Graphics.FillPath(If(Checked, Brushes.DarkGray, Brushes.LightGray), path)
r = Height - 1
Dim rect = If(Checked, New System.Drawing.Rectangle(Width - r - 1, 0, r, r), New System.Drawing.Rectangle(0, 0, r, r))
e.Graphics.FillEllipse(If(Checked, Brushes.Green, Brushes.LightSlateGray), rect)
End Using
End Sub
End Class
This code is from several sources over the years and has some minor tweaks. It appears it exist in various forms on different sites so it's unclear who to attribute.
I would like to change the colour within a single circular indicator within a Graphical User Interface, so that it shows when an action is completed or when it fails ['two tone green/red LED']. I've looked through the inbuilt presets within the Toolbox but have been unable find anything.
I would therefore be grateful for any assistance.
I've found this code on the msdn.microsoft.com forum, which changes the colour of the centre of the 'dot' when you press the RadioButton.
Private Sub RadioButton_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles RadioButton1.Paint, RadioButton2.Paint
If DirectCast(sender, RadioButton).Checked Then
e.Graphics.FillEllipse(Brushes.Red, New RectangleF(2.5, 4.7, 7.2, 7.2))
End If
So have incorporated it into my code, its not at all elegant and there is clearly room for improvement, but it does work.
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
If My.Computer.Network.Ping("192.168.0.1") Then
RadioButton1.ForeColor = Color.Green
RadioButton1.ForeColor = Color.Black
Else
RadioButton1.ForeColor = Color.Red
RadioButton1.ForeColor = Color.Black
End If
End Sub
Private Sub RadioButton_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles RadioButton1.Paint
If My.Computer.Network.Ping("192.168.0.1") Then
e.Graphics.FillEllipse(Brushes.Green, New RectangleF(2.5, 4.7, 7.2, 7.2))
Else
e.Graphics.FillEllipse(Brushes.Red, New RectangleF(2.5, 4.7, 7.2, 7.2))
End If
End Sub
Explanation: when the 'Test Network' button is pressed it sends out a network ping, and depending upon the return the Network RadioButton 'dot' changes colour to either Green or Red,
Here's ON/OFF LED control.
Add a new class to your project, name it say OnOffLed.vb, copy the code below and paste it in the new class.
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Drawing.Drawing2D
Public Class OnOffLed
Inherits Panel
Public Enum LedState
[On]
Off
End Enum
Sub New()
SetStyle(ControlStyles.AllPaintingInWmPaint Or
ControlStyles.OptimizedDoubleBuffer Or
ControlStyles.ResizeRedraw Or
ControlStyles.UserPaint, True)
UpdateStyles()
End Sub
Private _state As LedState = LedState.Off
Public Property State As LedState
Get
Return _state
End Get
Set(value As LedState)
_state = value
Invalidate()
End Set
End Property
Private _onText As String
Public Property OnText As String
Get
Return _onText
End Get
Set(value As String)
_onText = value
Invalidate()
End Set
End Property
Private _offText As String
Public Property OffText As String
Get
Return _offText
End Get
Set(value As String)
_offText = value
Invalidate()
End Set
End Property
Protected Overrides Sub OnPaint(e As PaintEventArgs)
Dim rec As New Rectangle(2, 2, Height - 5, Height - 5)
Dim recText As New Rectangle(Height + 2, 1, Width - (Height - 2), Height)
Dim G As Graphics = e.Graphics
G.SmoothingMode = SmoothingMode.AntiAlias
G.Clear(Parent.BackColor)
If _state = LedState.On Then
Dim cb As New ColorBlend With {
.Colors = {Color.Green, Color.DarkGreen, Color.Green},
.Positions = {0, 0.5, 1}
}
Using lgb As New LinearGradientBrush(rec, Color.Empty, Color.Empty, 90.0F) With {.InterpolationColors = cb}
G.FillEllipse(lgb, rec)
End Using
Else
Dim cb As New ColorBlend With {
.Colors = {Color.Red, Color.DarkRed, Color.Red},
.Positions = {0, 0.5, 1}
}
Using lgb As New LinearGradientBrush(rec, Color.Empty, Color.Empty, 90.0F) With {.InterpolationColors = cb}
G.FillEllipse(lgb, rec)
End Using
End If
G.TextRenderingHint = Drawing.Text.TextRenderingHint.ClearTypeGridFit
Using br As New SolidBrush(ForeColor)
Using sf As New StringFormat With {.Alignment = StringAlignment.Near, .LineAlignment = StringAlignment.Center}
G.DrawString(If(_state = LedState.On, _onText, _offText), Font, br, recText, sf)
End Using
End Using
End Sub
End Class
Rebuild your project.
In the ToolBox under your project's component tab, you'll find the new control. OnOffLed. Drop it in your form as you drop any other control.
You can toggle the state through the State property, set different text if you need that for each state through the OnText and OffText properties.
Usage Example:
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
If My.Computer.Network.Ping("192.168.2.01") Then
OnOffLed1.State = OnOffLed.LedState.On
Else
OnOffLed1.State = OnOffLed.LedState.Off
End If
End Sub
Good luck.
I have created this class in visual Basic it works fine but there is a slight design issue. As you can see there is this small bumb, how can I fix this? And also, how can I fix the spacing between the content Box and the selection menu.
Public Class VerticallTabControll
Inherits TabControl
Sub New()
SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.ResizeRedraw Or ControlStyles.UserPaint, True)
DoubleBuffered = True
SizeMode = TabSizeMode.Fixed
ItemSize = New Size(30, 170)
End Sub
Protected Overrides Sub CreateHandle()
MyBase.CreateHandle()
Alignment = TabAlignment.Left
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
Dim selected As New SolidBrush(Color.FromArgb(0, 122, 204))
Dim notSelected As New SolidBrush(Color.FromArgb(63, 63, 70))
Dim B As New Bitmap(Width, Height)
Dim G As Graphics = Graphics.FromImage(B)
G.Clear(Color.FromArgb(63, 63, 70))
For i = 0 To TabCount - 1
Dim TabRectangle As Rectangle = GetTabRect(i)
If i = SelectedIndex Then
'// if tab is selected
G.FillRectangle(selected, TabRectangle)
Else
'// tab is not selected
G.FillRectangle(notSelected, TabRectangle)
End If
'Line Test
'Dim start As New Point(10, 31 * (i + 1))
'Dim ende As New Point(160, 31 * (i + 1))
'G.DrawLine(Pens.White, start, ende)
G.DrawString(TabPages(i).Text, Font, Brushes.White, TabRectangle, New StringFormat With {.Alignment = StringAlignment.Center, .LineAlignment = StringAlignment.Center})
Next
e.Graphics.DrawImage(B.Clone, 0, 0)
G.Dispose() : B.Dispose() : selected.Dispose() : notSelected.Dispose()
MyBase.OnPaint(e)
e.Dispose()
End Sub
End Class
You can try overriding the DisplayRectangle property to adjust the interior space accordingly:
Public Overrides ReadOnly Property DisplayRectangle As Rectangle
Get
Return New Rectangle(MyBase.DisplayRectangle.Left,
MyBase.DisplayRectangle.Top - 2,
MyBase.DisplayRectangle.Width + 2,
MyBase.DisplayRectangle.Height + 4)
End Get
End Property
I have this code to change border colour of Groupboxes. It adds custom groupbox to my Toolbox and I can change border colour, but every time I start debugging I get this error: InvalidArgument=Value of "-2147483648" is not valid for 'RowPosition'.. As I read online, this error is produced when there is some bad code in project. Anybody knows how I should deal with this ?
Public Class GroupBox_Color
Inherits GroupBox
Private _borderColor As Color
Public Sub New()
MyBase.New()
Me._borderColor = Color.Blue
End Sub
Public Property BorderColor() As Color
Get
Return Me._borderColor
End Get
Set(ByVal value As Color)
Me._borderColor = value
End Set
End Property
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim tSize As Size = TextRenderer.MeasureText(Me.Text, Me.Font)
Dim borderRect As Rectangle = Me.DisplayRectangle
borderRect.Y = (borderRect.Y + (tSize.Height / 2))
borderRect.Height = (borderRect.Height - (tSize.Height / 2))
ControlPaint.DrawBorder(e.Graphics, borderRect, Me._borderColor,
ButtonBorderStyle.Solid)
Dim textRect As Rectangle = Me.DisplayRectangle
textRect.X = (textRect.X + 6)
textRect.Width = tSize.Width
textRect.Height = tSize.Height
e.Graphics.FillRectangle(New SolidBrush(Me.BackColor), textRect)
e.Graphics.DrawString(Me.Text, Me.Font, New SolidBrush(Me.ForeColor), textRect)
End Sub
End Class
The Problem
I am trying to have the line draw to the cursors current position as it moves. I've tried adding the code below to the MouseMove event in the form; however, nothing changed. I have been able to successfully draw the line, but regardless of what I do I just can't seem to get the line to follow the mouse. Also, it would be nice to be able to achieve this with reliable code without using a timer (for resources sake), but whatever works, works.
Code
The program is simply a blank form. So far this is all I got for code (this is all of the code):
Public Class drawing
Public xpos = MousePosition.X
Public ypos = MousePosition.Y
Public Sub DrawLineFloat(ByVal e As PaintEventArgs)
' Create pen.
Dim blackPen As New Pen(Color.Black, 2)
' Create coordinates of points that define line.
Dim x1 As Single = xpos
Dim y1 As Single = ypos
Dim x2 As Single = 100
Dim y2 As Single = 100
' Draw line to screen.
e.Graphics.DrawLine(blackPen, x1, y1, x2, y2)
End Sub
Private Sub drawing_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
DrawLineFloat(e)
End Sub
End Class
As you can see, I tried to modify the code for the MouseMove event, but it failed (I'm just including it anyways so you can see the previous attempt). Thanks in advance for any help.
This will do what you need:
private Point? startPoint;
protected override void OnPaint(PaintEventArgs e)
{
base.OnPaint(e);
if (startPoint.HasValue)
{
Graphics g = e.Graphics;
using (Pen p = new Pen(Color.Black, 2f))
{
g.DrawLine(p, startPoint.Value, new Point(100, 100));
}
}
}
protected override void OnMouseMove(MouseEventArgs e)
{
base.OnMouseMove(e);
this.startPoint = e.Location;
this.Invalidate();
}
this refers to the Form instance.
Code translated to Vb.Net using http://converter.telerik.com/
Private startPoint As System.Nullable(Of Point)
Protected Overrides Sub OnPaint(e As PaintEventArgs)
MyBase.OnPaint(e)
If startPoint.HasValue Then
Dim g As Graphics = e.Graphics
Using p As New Pen(Color.Black, 2F)
g.DrawLine(p, startPoint.Value, New Point(100, 100))
End Using
End If
End Sub
Protected Overrides Sub OnMouseMove(e As MouseEventArgs)
MyBase.OnMouseMove(e)
Me.startPoint = e.Location
Me.Invalidate()
End Sub