I found many tutorials on youtube which tell us, how to use AxWindowsMediaPlayer and basic stuff like creating your own volume control using TrackBar1 for Windows Media Player Component. But now I want to ask that how we can create our own movie duration control using trackbar or a seek slider in vb.net for Windows Media Player. I have searched a lot but question still remains a question. I hope that many great developers of vb.net on this site, should tell me logic behind it
THANKS IN ADVANCE
The trick is to subclass the TrackBar control and handle the OnPaintBackground and OnPaint events.
Here's an "extra-lite" version of a control I use on some of my own projects.
This version is quite limited but it should help you get started...
Imports System.Drawing.Drawing2D
Public Class CoolTrackBar
Inherits TrackBar
Private thumbRect As Rectangle = New Rectangle(0, 0, 19, 19)
Private isOverThumb As Boolean
Private cachedValue As Integer
Private rangeRect As Rectangle = Rectangle.Empty
Private mGrooveSize As Integer = 6
Private mGrooveBorderColor As Color = Color.Gray
Private mGrooveColor As Color = Color.LightGray
Private mSelStartColor As Color = Color.Blue
Private mSelEndColor As Color = Color.Red
Public Sub New()
Me.SetStyle(ControlStyles.AllPaintingInWmPaint, True)
Me.SetStyle(ControlStyles.OptimizedDoubleBuffer, True)
Me.SetStyle(ControlStyles.ResizeRedraw, True)
Me.SetStyle(ControlStyles.UserPaint, True)
Me.SetStyle(ControlStyles.SupportsTransparentBackColor, True)
End Sub
Public Property GrooveSize As Integer
Get
Return mGrooveSize
End Get
Set(value As Integer)
mGrooveSize = value
Me.Invalidate()
End Set
End Property
Public Property GrooveColor As Color
Get
Return mGrooveColor
End Get
Set(value As Color)
mGrooveColor = value
Me.Invalidate()
End Set
End Property
Public Property GrooveBorderColor As Color
Get
Return mGrooveBorderColor
End Get
Set(value As Color)
mGrooveBorderColor = value
Me.Invalidate()
End Set
End Property
Public Overloads Property TickStyle As TickStyle
Get
Return Windows.Forms.TickStyle.Both
End Get
Set(value As TickStyle)
MyBase.TickStyle = Windows.Forms.TickStyle.Both
End Set
End Property
Protected Overrides Sub OnPaintBackground(pevent As PaintEventArgs)
Dim g As Graphics = pevent.Graphics
Dim r As Rectangle = Me.DisplayRectangle
Select Case MyBase.Orientation
Case Orientation.Horizontal
rangeRect = New Rectangle(r.X + 14, r.Top, r.Width - 30, r.Height)
Case Orientation.Vertical
rangeRect = New Rectangle(r.X + 5, r.Y + 14, r.Width, r.Height - 29)
End Select
MyBase.OnPaintBackground(pevent)
DrawGroove(g)
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
Dim g As Graphics = e.Graphics
DrawThumb(g)
End Sub
Private Sub DrawGroove(g As Graphics)
Dim r1 As Rectangle
Dim r2 As Rectangle
Select Case Orientation
Case Windows.Forms.Orientation.Horizontal
r1 = New Rectangle(rangeRect.X, rangeRect.Y + (rangeRect.Height - mGrooveSize) \ 2, rangeRect.Width, mGrooveSize)
r2 = New Rectangle(r1.X, r1.Y, r1.Width * ValueToPercentage(cachedValue), r1.Height)
Case Windows.Forms.Orientation.Vertical
r1 = New Rectangle(rangeRect.X + (rangeRect.Width - mGrooveSize) / 2 - mGrooveSize \ 2, rangeRect.Y, mGrooveSize, rangeRect.Height)
r2 = New Rectangle(r1.X, r1.Y, r1.Width, r1.Height * ValueToPercentage(cachedValue))
End Select
Using b As New SolidBrush(mGrooveColor)
g.FillRectangle(b, r1)
End Using
Using p As New Pen(mGrooveBorderColor)
g.DrawRectangle(p, r1)
End Using
Using lgb As New LinearGradientBrush(r1.Location, New Point(r1.Right, r1.Bottom), mSelStartColor, mSelEndColor)
g.FillRectangle(lgb, r2)
End Using
End Sub
Private Sub DrawThumb(g As Graphics)
Dim thumb As VisualStyles.VisualStyleElement = Nothing
Select Case MyBase.Orientation
Case Orientation.Horizontal
If MyBase.Enabled Then
If isOverThumb Then
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbTop.Hot
Else
If MyBase.Focused Then
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbTop.Focused
Else
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbTop.Normal
End If
End If
Else
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbTop.Disabled
End If
Case Orientation.Vertical
If MyBase.Enabled Then
If isOverThumb Then
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbRight.Hot
Else
If MyBase.Focused Then
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbRight.Focused
Else
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbRight.Normal
End If
End If
Else
thumb = VisualStyles.VisualStyleElement.TrackBar.ThumbRight.Disabled
End If
End Select
Dim valuePercentage As Single = ValueToPercentage(cachedValue)
Dim vsr = New VisualStyles.VisualStyleRenderer(thumb)
thumbRect.Size = vsr.GetPartSize(g, VisualStyles.ThemeSizeType.Draw)
Dim pos As Integer
Select Case MyBase.Orientation
Case Orientation.Horizontal
pos = valuePercentage * rangeRect.Width
thumbRect.Location = New Point(pos + thumbRect.Width / 2 + 3, rangeRect.Y + thumbRect.Height / 2 + mGrooveSize / 4)
Case Orientation.Vertical
pos = valuePercentage * rangeRect.Height
thumbRect.Location = New Point(rangeRect.X + thumbRect.Width / 2 + mGrooveSize / 4, pos + thumbRect.Height / 2 + 3)
End Select
vsr.DrawBackground(g, thumbRect)
End Sub
Private Function ValueToPercentage(value As Integer) As Single
Dim w As Integer = MyBase.Maximum - MyBase.Minimum
Dim min = MyBase.Minimum
Dim max = MyBase.Maximum
If MyBase.Orientation = Orientation.Horizontal Then
Return (value - min) / (max - min)
Else
Return 1 - (value - min) / (max - min)
End If
End Function
Private Sub CoolTrackBar_MouseMove(sender As Object, e As MouseEventArgs) Handles Me.MouseMove
If thumbRect.IntersectsWith(New Rectangle(e.Location, New Size(1, 1))) Then
isOverThumb = True
Me.Invalidate()
ElseIf isOverThumb Then
isOverThumb = False
Me.Invalidate()
End If
End Sub
Private Sub CoolTrackBar_ValueChanged(sender As Object, e As EventArgs) Handles Me.ValueChanged
cachedValue = MyBase.Value
Me.Invalidate()
End Sub
End Class
To use it, simply create a WinForms project, then create a new Class, name it CoolTrackBar and paste the code above.
You'll need to compile the solution for the control to appear on your Toolbox.
Related
So I am trying to create an application to ease creation of pixel arts (school project), what I've done so far is draw a grid in a panel, next step would be to allow the user to click on a cell and have it painted, but I can't manage to make it work, here's the code I have:
Private Sub drawGrid(g As Graphics, rows As Integer, columns As Integer)
Dim originPoint As Point = New Point(10, 2)
Dim size As Size = New Size(64, 64)
Dim left As Integer = originPoint.X
Dim up As Integer = originPoint.Y
Dim right As Integer = originPoint.X + (columns * size.Width)
Dim down As Integer = originPoint.Y + (rows * size.Height)
For y As Integer = up To down + 1 Step size.Height
Dim pt1 As New Point(left, y)
Dim pt2 As New Point(right, y)
g.DrawLine(Pens.Black, pt1, pt2)
Next
For x As Integer = left To right + 1 Step size.Width
Dim pt1 As New Point(x, up)
Dim pt2 As New Point(x, down)
g.DrawLine(Pens.Black, pt1, pt2)
Next
End Sub
This draws a grid with the amount of columns and rows the user wants, but I've been struggling to allow painting
What I've been thinking is: dispose this code, and create a 'pixel' class, create the amount of 'pixel' objects based on user rows and columns, and draw each one individually, then just change each 'pixel's' color
This is a Grid class that allows setting the color of its cells.
The Grid cell are referenced using a List(Of List(Of Class)).
The Cell class Object contains is a simple Rectagle property that measures the size of the cell, and a Color property, which allows to set the color of the single cell:
Friend Class GridCell
Public Property Cell() As Rectangle
Public Property CellColor() As Color
End Class
You can define:
The size of the Grid → ColoredGrid.GridSize = new Size(...)
The number of Columns and Rows → ColoredGrid.GridColumnsRows = new Size(...)
The position of the Grid inside the Canvas → ColoredGrid.GridPosition = New Point(...)
The color of the Grid → ColoredGrid.GridColor = Color.Gray
The BackGround color of the cells → ColoredGrid.CellColor = Color.FromArgb(32, 32, 32)
The color of a selected cell → ColoredGrid.SelectedCellColor = Color.OrangeRed
The Grid class holds a reference to the control which will be used as the Canvas for the grid painting. This reference is set in the class contructor.
The Grid registers the Canvas control Paint() and MouseClick() events to respond to the related actions automatically.
When a Mouse Click is detected on the Canvas surface, the MouseEventArgs e.Location property reports the coordinates where the Click occurred.
To identify the Grid Cell where this action is performed, the GetUpdateCell() method inspects the List(Of List(Of GridCell)) using a simple LINQ SelectMany() and identified the Cell rectangle that contains the Mouse Click coordinates (expressed as a Point() value).
This identification is performed simply checking whether the Cell Rectangle.Contains(Point()).
When the cell is identified, the Canvas Invalidate() method is called, specifing the area to repaint.
This area corresponds to the Cell Rectangle, so only this section is repainted when a Cell is colored, to save resources and time.
To test it, create a Panel and a Button in a Form:
Imports System.Drawing
'This Grid object in defined at Form Class scope
Public ColoredGrid As ColorGrid
'Button used to trigger the Grid painting
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If ColoredGrid IsNot Nothing Then
ColoredGrid.Dispose()
End If
ColoredGrid = New ColorGrid(Panel1)
ColoredGrid.GridSize = New Size(300, 300)
ColoredGrid.GridColumnsRows = New Size(10, 10)
ColoredGrid.GridPosition = New Point(10, 10)
ColoredGrid.GridColor = Color.White
ColoredGrid.CellColor = Color.FromArgb(32, 32, 32)
ColoredGrid.SelectedCellColor = Color.OrangeRed
ColoredGrid.BuildGrid()
End Sub
This is a visual sample that shows how it works:
This is the main Grid class.
The ColorGrid Class supports IDisposable, because it registers the described events. These must be unregistered when the Class is not used anymore. Weird things can happen if you don't.
Public Class ColorGrid
Implements IDisposable
Private Grid As List(Of List(Of GridCell))
Private CurrentGridSize As New Size(100, 100)
Private GridColRows As New Size(10, 10)
Private CellSize As New Size(10, 10)
Private MouseCell As Point = Point.Empty
Private Canvas As Control = Nothing
Private UpdateCell As Boolean = False
Private NewGrid As Boolean = False
Public Sub New(DrawingControl As Control)
If DrawingControl IsNot Nothing Then
Me.Canvas = DrawingControl
AddHandler Me.Canvas.Paint, New PaintEventHandler(AddressOf Me.ControlPaint)
AddHandler Me.Canvas.MouseClick, New MouseEventHandler(AddressOf Me.MouseHandler)
Me.GridPosition = New Point(10, 10)
Me.CellColor = Color.FromArgb(32, 32, 32)
End If
End Sub
Public Property GridPosition() As Point
Public Property CellColor() As Color
Public Property SelectedCellColor() As Color
Public Property GridColor() As Color
Public Property GridSize() As Size
Get
Return Me.CurrentGridSize
End Get
Set(value As Size)
Me.CurrentGridSize = value
SetCellSize()
End Set
End Property
Public Property GridColumnsRows() As Size
Get
Return Me.GridColRows
End Get
Set(value As Size)
Me.GridColRows = value
SetCellSize()
End Set
End Property
Private Property RefreshCell() As GridCell
Friend Class GridCell
Public Property Cell() As Rectangle
Public Property CellColor() As Color
End Class
Private Sub SetCellSize()
Me.CellSize = New Size((Me.CurrentGridSize.Width \ Me.GridColRows.Width),
(Me.CurrentGridSize.Height \ Me.GridColRows.Height))
If Me.CellSize.Width < 4 Then Me.CellSize.Width = 4
If Me.CellSize.Height < 4 Then Me.CellSize.Height = 4
End Sub
Public Sub BuildGrid()
If Me.Canvas Is Nothing Then Return
Me.Grid = New List(Of List(Of GridCell))()
For row As Integer = 0 To GridColumnsRows.Height - 1
Dim RowCells As New List(Of GridCell)()
For col As Integer = 0 To GridColumnsRows.Width - 1
RowCells.Add(New GridCell() With {
.Cell = New Rectangle(New Point(Me.GridPosition.X + (col * Me.CellSize.Width),
Me.GridPosition.Y + (row * Me.CellSize.Height)),
Me.CellSize),
.CellColor = Me.CellColor})
Next
Me.Grid.Add(RowCells)
Next
Me.NewGrid = True
Me.Canvas.Invalidate()
End Sub
Private Sub ControlPaint(o As Object, e As PaintEventArgs)
If Me.NewGrid Then
e.Graphics.Clear(Me.Canvas.BackColor)
Me.NewGrid = False
End If
Me.Grid.
SelectMany(Function(rowcells) rowcells).
Select(Function(colcell)
If Me.UpdateCell Then
Using brush As New SolidBrush(Me.RefreshCell.CellColor)
e.Graphics.FillRectangle(brush, Me.RefreshCell.Cell.X + 1, Me.RefreshCell.Cell.Y + 1,
Me.RefreshCell.Cell.Width - 1, Me.RefreshCell.Cell.Height - 1)
End Using
Me.UpdateCell = False
Return Nothing
Else
Using pen As New Pen(Me.GridColor)
e.Graphics.DrawRectangle(pen, colcell.Cell)
End Using
Using brush As New SolidBrush(colcell.CellColor)
e.Graphics.FillRectangle(brush, colcell.Cell.X + 1, colcell.Cell.Y + 1,
colcell.Cell.Width - 1, colcell.Cell.Height - 1)
End Using
End If
Return colcell
End Function).TakeWhile(Function(colcell) colcell IsNot Nothing).ToList()
End Sub
Private Sub MouseHandler(o As Object, e As MouseEventArgs)
Me.RefreshCell = GetUpdateCell(e.Location)
Me.RefreshCell.CellColor = Me.SelectedCellColor
Dim CellColorArea As Rectangle = Me.RefreshCell.Cell
CellColorArea.Inflate(-1, -1)
Me.UpdateCell = True
Me.Canvas.Invalidate(CellColorArea)
End Sub
Private Function GetUpdateCell(CellPosition As Point) As GridCell
Return Me.Grid.
SelectMany(Function(rowcells) rowcells).
Select(Function(gridcell) gridcell).
Where(Function(gridcell) gridcell.Cell.Contains(CellPosition)).
First()
End Function
Public Sub Dispose() Implements IDisposable.Dispose
If Me.Canvas IsNot Nothing Then
RemoveHandler Me.Canvas.Paint, AddressOf Me.ControlPaint
RemoveHandler Me.Canvas.MouseClick, AddressOf Me.MouseHandler
Me.Grid = Nothing
End If
End Sub
End Class
I want to color every same word inside a RichTextBox. I can do it for one line but not on multiple lines.
E.g., Welcome "user" .....
I want the word user to be an exact color in every line it's found.
Here's with what i came up so far:
RichTextBox1.Text = "Welcome "
RichTextBox1.Select(RichTextBox1.TextLength, 0)
RichTextBox1.SelectionColor = My.Settings.color
RichTextBox1.AppendText(My.Settings.username)
RichTextBox1.SelectionColor = Color.Black
RichTextBox1.AppendText(" ........." + vbCrLf)
It's on form.Load; I tried to use the richtextbox.TextChange event, but it just colors the last user word and the others are remain the same.
This is a simple Class that enables multiple Selections and Highlights of text for RichTextBox and TextBox controls.
You can use multiple instances of this Class for different controls.
You can add the Words to Select/HighLight to a List and specify which color to use for selecting and/or highlighting the text.
Dim listOfWords As WordList = New WordList(RichTextBox1)
listOfWords.AddRange({"Word1", "Word2"})
listOfWords.SelectionColor = Color.LightBlue
listOfWords.HighLightColor = Color.Yellow
These are the visual results of the Class actions:
In the example, the List of words is filled using:
Dim patterns As String() = TextBox1.Text.Split()
listOfWords.AddRange(patterns)
In the visual example, the Class is configured this way:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim patterns As String() = TextBox1.Text.Split()
Dim listOfWords As WordList = New WordList(RichTextBox1)
listOfWords.AddRange(patterns)
listOfWords.SelectionColor = Color.LightBlue
listOfWords.HighLightColor = Color.Yellow
If RadioButton1.Checked = True Then
listOfWords.WordsSelect()
ElseIf RadioButton2.Checked Then
listOfWords.WordsHighLight()
Else
listOfWords.DeselectAll()
End If
End Sub
This is the Class used to generate the Selections and HighLights:
Imports System.Drawing.Text
Imports System.Text.RegularExpressions
Public Class WordList
Private TextRendererFlags As TextFormatFlags =
TextFormatFlags.Top Or TextFormatFlags.Left Or TextFormatFlags.NoPadding Or
TextFormatFlags.WordBreak Or TextFormatFlags.TextBoxControl
Private textControl As RichTextBox = Nothing
Private wordsList As List(Of Word)
Public Sub New(rtb As RichTextBox)
textControl = rtb
wordsList = New List(Of Word)
ProtectSelection = False
End Sub
Public Property ProtectSelection As Boolean
Public Property HighLightColor As Color
Public Property SelectionColor As Color
Public Sub Add(word As String)
wordsList.Add(New Word() With {.Word = word, .Indexes = GetWordIndexes(word)})
End Sub
Public Sub AddRange(words As String())
For Each WordItem As String In words
wordsList.Add(New Word() With {.Word = WordItem, .Indexes = GetWordIndexes(WordItem)})
Next
End Sub
Private Function GetWordIndexes(word As String) As List(Of Integer)
Return Regex.Matches(textControl.Text, word).
OfType(Of Match)().
Select(Function(chr) chr.Index).ToList()
End Function
Public Sub DeselectAll()
If textControl IsNot Nothing Then
textControl.SelectAll()
textControl.SelectionBackColor = textControl.BackColor
textControl.Update()
End If
End Sub
Public Sub WordsHighLight()
If wordsList.Count > 0 Then
For Each WordItem As Word In wordsList
For Each Position As Integer In WordItem.Indexes
Dim p As Point = textControl.GetPositionFromCharIndex(Position)
TextRenderer.DrawText(textControl.CreateGraphics(), WordItem.Word,
textControl.Font, p, textControl.ForeColor,
HighLightColor, TextRendererFlags)
Next
Next
End If
End Sub
Public Sub WordsSelect()
DeselectAll()
If wordsList.Count > 0 Then
For Each WordItem As Word In wordsList
For Each Position As Integer In WordItem.Indexes
textControl.Select(Position, WordItem.Word.Length)
textControl.SelectionColor = textControl.ForeColor
textControl.SelectionBackColor = SelectionColor
textControl.SelectionProtected = ProtectSelection
Next
Next
End If
End Sub
Friend Class Word
Property Word As String
Property Indexes As List(Of Integer)
End Class
End Class
With a module,you can do it this way :
Imports System.Runtime.CompilerServices
Module Utility
<Extension()>
Sub HighlightText(ByVal myRtb As RichTextBox, ByVal word As String, ByVal color As Color)
If word = String.Empty Then Return
Dim index As Integer, s_start As Integer = myRtb.SelectionStart, startIndex As Integer = 0
While(__InlineAssignHelper(index, myRtb.Text.IndexOf(word, startIndex))) <> -1
myRtb.[Select](index, word.Length)
myRtb.SelectionColor = color
startIndex = index + word.Length
End While
myRtb.SelectionStart = s_start
myRtb.SelectionLength = 0
myRtb.SelectionColor = Color.Black
End Sub
<Obsolete("Please refactor code that uses this function, it is a simple work-around to simulate inline assignment in VB!")>
Private Shared Function __InlineAssignHelper(Of T)(ByRef target As T, value As T) As T
target = value
Return value
End Function
End Module
Or , you can also go with this one as it will allow you to highlight multiple words at the same time :
Private Sub HighlightWords(ByVal words() As String)
Private Sub HighlightWords(ByVal words() As String)
For Each word As String In words
Dim startIndex As Integer = 0
While (startIndex < rtb1.TextLength)
Dim wordStartIndex As Integer = rtb1.Find(word, startIndex, RichTextBoxFinds.None)
If (wordStartIndex <> -1) Then
rtb1.SelectionStart = wordStartIndex
rtb1.SelectionLength = word.Length
rtb1.SelectionBackColor = System.Drawing.Color.Black
Else
Exit While
End If
startIndex += wordStartIndex + word.Length
End While
Next
End Sub
Source Hope this helps :)
This works
Public Sub HighlightText(ByVal txt As String, ByVal obj As RichTextBox)
obj.SelectionStart = 0
obj.SelectAll()
obj.SelectionBackColor = Color.White
Dim len = txt.Length
Dim pos = obj.Find(txt, 0, RichTextBoxFinds.NoHighlight)
While (pos >= 0)
obj.Select(pos, len)
obj.SelectionBackColor = Color.Yellow
If pos + len >= obj.Text.Length Then
Exit While
End If
pos = obj.Find(txt, pos + len, RichTextBoxFinds.NoHighlight)
End While
End Sub
Public Sub HighlightText(ByVal txt As String, ByVal obj As RichTextBox)
obj.SelectionStart = 0
obj.SelectAll()
obj.SelectionBackColor = Color.White
Dim len = txt.Length
Dim pos = obj.Find(txt, 0, RichTextBoxFinds.NoHighlight)
While (pos >= 0)
obj.Select(pos, len)
obj.SelectionBackColor = Color.Yellow
If pos + len >= obj.Text.Length Then
Exit While
End If
pos = obj.Find(txt, pos + len, RichTextBoxFinds.NoHighlight)
End While
End Sub
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
Having a bit of trouble trying to center the view on the center of the element inside a ScrollableControl.
I have no problems centering the control inside the ScrollableControl, however whenever I try to set AutoScrollPosition, the element inside the scroll container docks to the bottom right corner of the innermost container of the ScrollableControl.
Here is the code that I am using (and I am pretty sure the math is correct) :
MyBase.AutoScrollPosition = New System.Drawing.Point(Canvas1.Left - ((MyBase.Width - Canvas1.Size.Width) / 2), Canvas1.Top - ((MyBase.Height - Canvas1.Size.Height) / 2))
The type of project is actually a UserControl, not a Class, so this is not an "inherited" ScrollableControl per se. It is a UserControl type.
What I find most bizzare, is there doesn't appear to be a ScrollToX, only ScrollControlIntoView, and such, which do not do what I wish.
Basically, the end result, is the center of the Viewable area must be the center of the Control contained inside the Scrollable virtual area. I have the Control centered as such, so this is really just a matter of scrolling it into view so the X,Y of the dead center of the inner control, is in the dead center of the viewable area.
Current code for the entire class
Board.vb
Imports System.ComponentModel
Public Class Board
Private _init As Boolean = False
Private _keys As KeyEventArgs = Nothing
''' <summary>
''' </summary>
''' <filterpriority>3</filterpriority>
''' <remarks></remarks>
<Browsable(False), EditorBrowsable(False)> _
Shadows Property BackgroundImage As Image
Get
Return MyBase.BackgroundImage
End Get
Set(value As Image)
MyBase.BackgroundImage = value
End Set
End Property
<Browsable(False), EditorBrowsable(False)> _
Shadows Property AutoScroll As Boolean
Get
Return MyBase.AutoScroll
End Get
Set(value As Boolean)
MyBase.AutoScroll = value
End Set
End Property
<Browsable(False), EditorBrowsable(False)> _
Shadows Property AutoScrollMinSize As System.Drawing.Size
Get
Return MyBase.AutoScrollMinSize
End Get
Set(value As System.Drawing.Size)
MyBase.AutoScrollMinSize = value
End Set
End Property
Public Property Checkerboard As Boolean
Get
Return Canvas1.CheckeredBackground
End Get
Set(value As Boolean)
Canvas1.CheckeredBackground = value
End Set
End Property
Shadows Property BorderStyle As Windows.Forms.BorderStyle
Get
Return Canvas1.BorderStyle
End Get
Set(value As Windows.Forms.BorderStyle)
Canvas1.BorderStyle = value
End Set
End Property
Private Sub Canvas1_MouseEnter(sender As Object, e As EventArgs) Handles Canvas1.MouseEnter
Me.Focus()
End Sub
Public Sub Add(ByVal Image As System.Drawing.Image)
Dim l As New Layer("Layer " & Canvas1.Layers.Count + 1)
l.Graphics.Add(New Graphic(Image, New Point(10, 10)))
Canvas1.Layers.Add(l)
End Sub
Public Property CanvasSize() As System.Drawing.Size
Get
Return Canvas1.Size
End Get
Set(value As System.Drawing.Size)
Canvas1.Size = value
Me.CenterCanvas()
End Set
End Property
Public Property BoardSize() As System.Drawing.Size
Get
Return Me.AutoScrollMinSize
End Get
Set(value As System.Drawing.Size)
Me.AutoScrollMinSize = value
Me.CenterCanvas()
End Set
End Property
Public Function Remove(ByVal Index As Integer) As Boolean
Try
Canvas1.Layers.RemoveAt(Index)
Return True
Catch ex As Exception
Return False
End Try
End Function
Public Sub RefreshCanvas()
Canvas1.Invalidate()
End Sub
Public Sub CenterCanvas()
Canvas1.Location = New System.Drawing.Point((MyBase.DisplayRectangle.Width - Canvas1.Size.Width) / 2, (MyBase.DisplayRectangle.Height - Canvas1.Size.Height) / 2)
'Debug.Print(Canvas1.Top & ", " & Canvas1.Left)
' Dim y As Integer = (Me.Height - Canvas1.Height) / 2
' Dim x As Integer = (Me.Width - Canvas1.Width) / 2
' x = Canvas1.Left - x
' y = Canvas1.Top - y
' Me.AutoScrollPosition = New System.Drawing.Point(x, y)
End Sub
Public Sub New()
' This call is required by the designer.
InitializeComponent()
_init = True
' Add any initialization after the InitializeComponent() call.
Me.CenterCanvas()
End Sub
Private Sub Board_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
_keys = e
End Sub
Private Sub Board_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
_keys = Nothing
End Sub
Private Sub Board_MouseWheel(sender As Object, e As MouseEventArgs) Handles Me.MouseWheel
Dim l As Layer
l = Canvas1.SelectedLayer
If IsNothing(l) = False Then
Debug.Print("Wheels")
End If
Dim MW As HandledMouseEventArgs = e
MW.Handled = False
End Sub
Private Sub Board_Resize(sender As Object, e As EventArgs) Handles Me.Resize
' If _init Then
' Dim x As Integer = Canvas1.Left - ((MyBase.Width - Canvas1.Size.Width) / 2)
'Dim y As Integer = Canvas1.Top - ((MyBase.Height - Canvas1.Size.Height) / 2)
' MyBase.AutoScrollPosition = New System.Drawing.Point(Canvas1.Left - ((MyBase.Width - Canvas1.Size.Width) / 2), Canvas1.Top - ((MyBase.Height - Canvas1.Size.Height) / 2))
'End If
MyBase.AutoScrollPosition = New System.Drawing.Point( _
Canvas1.Left - MyBase.AutoScrollPosition.X - ((MyBase.ClientSize.Width - Canvas1.Size.Width) \ 2), _
Canvas1.Top - MyBase.AutoScrollPosition.Y - ((MyBase.ClientSize.Height - Canvas1.Size.Height) \ 2))
End Sub
Private Sub Board_SizeChanged(sender As Object, e As EventArgs) Handles Me.SizeChanged
End Sub
End Class
Board.Designer.vb
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class Board
Inherits System.Windows.Forms.UserControl
'UserControl1 overrides dispose to clean up the component list.
<System.Diagnostics.DebuggerNonUserCode()> _
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
Try
If disposing AndAlso components IsNot Nothing Then
components.Dispose()
End If
Finally
MyBase.Dispose(disposing)
End Try
End Sub
'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer
'NOTE: The following procedure is required by the Windows Form Designer
'It can be modified using the Windows Form Designer.
'Do not modify it using the code editor.
<System.Diagnostics.DebuggerStepThrough()> _
Private Sub InitializeComponent()
Me.Canvas1 = New Artisto.Canvas()
CType(Me.Canvas1, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'Canvas1
'
Me.Canvas1.Anchor = System.Windows.Forms.AnchorStyles.None
Me.Canvas1.CheckeredBackground = True
Me.Canvas1.Location = New System.Drawing.Point(0, 0)
Me.Canvas1.Name = "Canvas1"
Me.Canvas1.SelectedLayer = Nothing
Me.Canvas1.Size = New System.Drawing.Size(619, 317)
Me.Canvas1.TabIndex = 0
Me.Canvas1.TabStop = False
'
'Board
'
Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Inherit
Me.AutoScroll = True
Me.AutoScrollMinSize = New System.Drawing.Size(4096, 2160)
Me.AutoSizeMode = System.Windows.Forms.AutoSizeMode.GrowAndShrink
Me.Controls.Add(Me.Canvas1)
Me.DoubleBuffered = True
Me.Name = "Board"
Me.Size = New System.Drawing.Size(1266, 523)
CType(Me.Canvas1, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
Friend WithEvents Canvas1 As Artisto.Canvas
End Class
I'm pretty new to programming. I'm trying to code OOP as much as possible .
Problem: How can I detected if two graphics make a collision with each other in a single picturebox?
Now here are the questions:
Is there anyway I can do this with graphics on a bitmap. I have seen a lot of examples where two separate picterbox are used to make a collision with each, but how to do this with my example?
How can I improve my current code?
Public Class RechtHoek
'property
Public Property Y As Integer
Set(value As Integer)
_y = value
End Set
Get
Return _y
End Get
End Property
Public Property X As Integer
Set(value As Integer)
_x = value
End Set
Get
Return _x
End Get
End Property
'Variables
Dim _y As Integer
Dim _x As Integer
Dim _maxY As Integer
Dim _maxX As Integer
'Variabele om kleur te wijzingen
Dim kleur As Color = RandomKleur()
Dim VeranderKleur As Boolean = False
Dim brush2 As New SolidBrush(RandomKleur)
'variablen om rechthoek te draaien
'Variabelen voor bewegen van de rechthoeken
Dim goingUp As Boolean = False
Dim goingRight As Boolean = False
'constructor
Public Sub New(x As Integer, y As Integer, maxX As Integer, MaxY As Integer)
_y = y
_x = x
_maxX = maxX
_maxY = MaxY
End Sub
Public Sub DrawRechthoekHorizontaal(graph As Graphics)
Dim pen As New Pen(Color.Black)
Dim rect As New Rectangle(_x, Y, 40, 100)
graph.FillRectangle(brush2, rect)
graph.DrawRectangle(pen, rect)
End Sub
Public Sub DrawRechthoekVerticaal(graph As Graphics)
Dim pen As New Pen(Color.Black)
Dim rect As New Rectangle(_x, Y, 100, 40)
graph.FillRectangle(brush2, rect)
graph.DrawRectangle(pen, rect)
End Sub
Public Function RandomKleur() As Color
Dim myAlpha As Integer = 0
Dim myRed As Integer = 0
Dim myGreen As Integer = 0
Dim myBlue As Integer = 0
Randomize()
myAlpha = CInt(Int((254 * Rnd()) + 0))
Randomize()
myGreen = CInt(Int((254 * Rnd()) + 0))
Randomize()
myRed = CInt(Int((254 * Rnd()) + 0))
Randomize()
myBlue = CInt(Int((254 * Rnd()) + 0))
'Color.FromArgb(myAlpha, myRed, myGreen, myBlue)
Return Color.FromArgb(myAlpha, myRed, myGreen, myBlue)
End Function
Public Sub Up()
Y -= 10
End Sub
Public Sub Down()
Y += 10
End Sub
Public Sub Right()
X -= 10
End Sub
Public Sub Left()
X += 10
End Sub
Public Sub MoveX()
If goingRight Then
Right()
Else
Left()
End If
If X < 0 Then
goingRight = False
'verander van kleur
If X = -10 Then
VeranderKleur = True
brush2.Color = RandomKleur()
End If
ElseIf X > 1600 Then
goingRight = True
'verander van kleur
If X = 1610 Then
VeranderKleur = False
brush2.Color = RandomKleur()
End If
End If
End Sub
Public Sub MoveY()
If goingUp Then
Up()
Else
Down()
End If
If Y < 0 Then
goingUp = False
'verander van kleur
If Y = -10 Then
VeranderKleur = True
brush2.Color = RandomKleur()
End If
ElseIf Y > 900 Then
goingUp = True
'verander van kleur
If Y = 910 Then
VeranderKleur = True
brush2.Color = RandomKleur()
End If
End If
End Sub
End Class
Public Class FormBewegendeRechtHoeken
Dim rectY As RechtHoek
Dim rectX As RechtHoek
Dim bitmap As Bitmap
Private img As Image
Private Sub FormRechtHoek_Load(sender As Object, e As EventArgs) Handles MyBase.Load
bitmap = New Bitmap(PictureBox.Width, PictureBox.Height)
'X = plaats waar rechthoek start op x as , Y = plaats waar rechthoekstart op y as 'Max x hoogete &' Max Y hoogte
rectY = New RechtHoek(PictureBox.Width \ 2, PictureBox.Height, PictureBox.Width, PictureBox.Height)
rectX = New RechtHoek(PictureBox.Width, PictureBox.Height \ 2, PictureBox.Width, PictureBox.Height)
Draw()
TheTimer.Start()
End Sub
Private Sub Botsing()
End Sub
Private Sub Draw()
Using graph As Graphics = Graphics.FromImage(bitmap)
graph.Clear(Color.Yellow)
rectX.DrawRechthoekHorizontaal(graph)
'Omkeren van de rechthoek in het midden
If rectY.Y < 450 Then
rectY.DrawRechthoekHorizontaal(graph)
End If
If rectY.Y > 450 Then
rectY.DrawRechthoekVerticaal(graph)
End If
End Using
PictureBox.Image = bitmap
End Sub
Private Sub TheTimer_Tick(sender As Object, e As EventArgs) Handles TheTimer.Tick
rectY.MoveY()
rectX.MoveX()
Draw()
End Sub
End Class
If you save the rectangle structures you draw in an array or a list, you can check a collision like this:
The rectangles collide when one rectangle contains at least one edge point of the other rectangle. So you can define a function:
Function CheckRectCollision(Rect1 as Rectangle, Rect2 as Rectangle) as Boolean
If Rect1.Contains(New Point(Rect2.Left, Rect2.Top) Orelse _
Rect1.Contains(New Point(Rect2.Left, Rect2.Bottom) Orelse _
Rect1.Contains(New Point(Rect2.Right, Rect2.Top) Orelse _
Rect1.Contains(New Point(Rect2.Right, Rect2.Bottom) Then
Return True
Else
Return False
End If
End Function
That way you can check if two rectangles collide. Find exclusive permutations for all rectangle pairs you have and call the function for each pair.