L
L1nk3R
Guest
Hello everyone.
Some of you may still be fresh from my last thread here, if youre not, be sure to visit it first as you might get a head start on whats going on now.
At the moment Im trying to draw a textbox with the mouse at runtime, just as the title suggests. The logic Im following is to first draw a rectangle shape and convert that shape into a richtextbox, passing all the relevant characteristics into the richtextbox control, such as the location, width and height and then I also pass on the fontfamiliy, fontsize and fontstyle values by checking if certain buttons are pressed on a toolstripbar.
I think this logic is actually the key, as Im really close to what Im trying to achieve, as so far Im able to draw the textbox and Im able to type text after drawing it.
What Im missing now, is that I need the textbox to be removed and to transfer the written text on the textbox back into the shape. This would only happen when the user would click anywhere else but the richtextbox control itself, where the control would lose focus, thus creating a rectangle shape with text. I guess using DrawString will be the key here? If thats true, then how do I use it on this case?
Another thing thats bugging me, is that when typing the text on the RichTextBox, if the text length surpasses the height of the control itself, a vertical scrollbar appears to accomodate the rest of the text.
What I wanted to happen here, is resize the richtextbox in order to maintain visibility of the text, but Id want to impose a fixed maximum restriction upon the resizing of the control. Is this possible?
Heres the code I have so far:
Imports System.Drawing.Imaging
Imports Microsoft.VisualBasic.PowerPacks
Imports MasterRecipe.RMDrawingShapes
Imports System.Drawing.Text
Public Class fDBRelationshipsMap
Size of the pen
Private DrawSize As Integer = 6
Private mapBmp As Bitmap
Private currentUnsavedMap As Bitmap
Private selectedDrawingColorIndex As Integer = -1
Private selectedFillingColorIndex As Integer = -1
Private currentDrawingColor As Color = Color.Black
Private currentFillingColor As Color = Color.White
Private solidColorsList As List(Of String)
Private brushSizeIndex As Integer = 2
Buffer for erasing rubberband lines.
Private m_BufferBitmap As Bitmap
Private m_BufferGraphics As Graphics
The mouse position.
Private _x1 As Integer = 0
Private _y1 As Integer = 0
Private _x2 As Integer = 0
Private _y2 As Integer = 0
Private _w As Integer = 0
Private _h As Integer = 0
Private _shapes As New List(Of RMDrawingShapes)
Private _shape As RMDrawingShapes
Private _shapesMemorizer As New List(Of RMDrawingShapes)
Private colorFill As Boolean = False
Private Sub fDBRelationshipsMap_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim sysFontCollection As New InstalledFontCollection
Dim _ffIndex As Integer = -1
For Each _fontFamily As FontFamily In sysFontCollection.Families
tsCbTextBoxFont.Items.Add(_fontFamily.Name)
_ffIndex += 1
If _fontFamily.Name = "Arial" Then tsCbTextBoxFont.SelectedIndex = _ffIndex
Next
If pbRelationshipsMap.Image Is Nothing Then
pbRelationshipsMap.Image = My.Resources.RMDBRelMap
End If
Dim fontSizeIndex As Integer = 7
Do
If fontSizeIndex < 12 Then
fontSizeIndex += 1
ElseIf fontSizeIndex < 28 Then
fontSizeIndex += 2
ElseIf fontSizeIndex = 28 Then
fontSizeIndex += 8
ElseIf fontSizeIndex = 36 Then
fontSizeIndex += 12
ElseIf fontSizeIndex = 48 Then
fontSizeIndex += 24
End If
tsCbTextSize.Items.Add(fontSizeIndex)
Loop While fontSizeIndex < 72
tsCbTextSize.SelectedIndex = 3
currentUnsavedMap = New Drawing.Bitmap(pbRelationshipsMap.Image)
solidColorsList = New List(Of String)
For Each _solidColor As KnownColor In [Enum].GetValues(GetType(KnownColor))
Dim _color As Color = Color.FromKnownColor(_solidColor)
If Not _color.IsSystemColor And _solidColor.ToString <> "Transparent" Then
solidColorsList.Add(_solidColor.ToString)
End If
Next
Dim tsDrawingMenu As New ToolStripDropDown
tsDrawingMenu.LayoutStyle = ToolStripLayoutStyle.Table
DirectCast(tsDrawingMenu.LayoutSettings, TableLayoutSettings).ColumnCount = 14
Dim tsFillingMenu As New ToolStripDropDown
tsFillingMenu.LayoutStyle = ToolStripLayoutStyle.Table
DirectCast(tsFillingMenu.LayoutSettings, TableLayoutSettings).ColumnCount = 14
tsDdDrawingColor.DropDown = tsDrawingMenu
tsDdFillingColor.DropDown = tsFillingMenu
For tsMDrawingICounter As Integer = 0 To solidColorsList.Count - 1
Dim tsMDrawingI As New ToolStripMenuItem("Cor: " & solidColorsList(tsMDrawingICounter))
AddHandler tsMDrawingI.Paint, AddressOf tsMDrawingI_Paint Add the handler procedure for Drawing
tsMDrawingI.Tag = tsMDrawingICounter
tsMDrawingI.Text = String.Empty
tsMDrawingI.Name = "ts" & solidColorsList(tsMDrawingICounter)
tsMDrawingI.AutoSize = False
tsMDrawingI.Size = New Drawing.Size(20, 20)
tsMDrawingI.Margin = New Padding(2)
tsMDrawingI.BackColor = Color.FromName(solidColorsList(tsMDrawingICounter))
tsMDrawingI.ToolTipText = solidColorsList(tsMDrawingICounter)
tsDrawingMenu.Items.Add(tsMDrawingI)
If tsMDrawingI.BackColor = Color.Black Then
selectedDrawingColorIndex = tsMDrawingICounter
tsDdDrawingColor.BackColor = currentDrawingColor
tsDdDrawingColor.ToolTipText = solidColorsList(tsMDrawingICounter)
End If
Next
For tsMFillingICounter As Integer = 0 To solidColorsList.Count - 1
Dim tsMFillingI As New ToolStripMenuItem("Cor: " & solidColorsList(tsMFillingICounter))
AddHandler tsMFillingI.Paint, AddressOf tsMFillingI_Paint Add the handler procedure for Drawing
tsMFillingI.Tag = tsMFillingICounter
tsMFillingI.Text = String.Empty
tsMFillingI.Name = "ts" & solidColorsList(tsMFillingICounter)
tsMFillingI.AutoSize = False
tsMFillingI.Size = New Drawing.Size(20, 20)
tsMFillingI.Margin = New Padding(2)
tsMFillingI.BackColor = Color.FromName(solidColorsList(tsMFillingICounter))
tsMFillingI.ToolTipText = solidColorsList(tsMFillingICounter)
tsFillingMenu.Items.Add(tsMFillingI)
If tsMFillingI.BackColor = Color.White Then
selectedFillingColorIndex = tsMFillingICounter
tsDdFillingColor.BackColor = currentFillingColor
tsDdFillingColor.ToolTipText = solidColorsList(tsMFillingICounter)
End If
Next
Dim tsMenux As New ToolStripDropDown
tsMenux.LayoutStyle = ToolStripLayoutStyle.Table
DirectCast(tsMenux.LayoutSettings, TableLayoutSettings).ColumnCount = 1
DirectCast(tsMenux.LayoutSettings, TableLayoutSettings).RowCount = 5
tsDdBrushSize.DropDown = tsMenux
For tsMICounter As Integer = 0 To 4
Dim trueHeightSize As Integer = (tsMICounter * 2) + 2
Dim tsMIx As New ToolStripMenuItem("Tamanho: " & trueHeightSize & "px")
AddHandler tsMIx.Paint, AddressOf tsMIx_Paint Add the handler procedure for Drawing
tsMIx.Name = "ts" & trueHeightSize & "px"
tsMIx.Tag = tsMICounter sets the Tags according to the respective index (0 => 2, 1 => 4, 2 => 6, 3 => 8, 4 => 10)
tsMIx.Text = String.Empty
tsMIx.AutoSize = False
tsMIx.Size = New Drawing.Size(120, trueHeightSize + 20)
tsMIx.Margin = New Padding(2)
tsDdBrushSize.DropDownItems.Add(tsMIx)
Next
tsDdFillingColor.Enabled = False
tsDdFillingColor.BackColor = SystemColors.ButtonShadow
tsDdFillingColor.ToolTipText = Nothing
End Sub
Private Sub tsMDrawingI_Paint(ByVal sender As Object, ByVal e As PaintEventArgs)
Dim tsmdrawingi As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim rct As New Rectangle(2, 0, tsmdrawingi.Width - 4, tsmdrawingi.Height - 1)
If tsmdrawingi.Selected Then
e.Graphics.DrawRectangle(Pens.Orange, rct)
e.Graphics.FillRectangle(New SolidBrush(tsmdrawingi.BackColor), rct)
ElseIf CInt(tsmdrawingi.Tag) = selectedDrawingColorIndex Then
e.Graphics.DrawRectangle(Pens.OrangeRed, rct)
e.Graphics.FillRectangle(New SolidBrush(tsmdrawingi.BackColor), rct)
tsDdDrawingColor.BackColor = currentDrawingColor
Else
e.Graphics.DrawRectangle(Pens.Black, rct)
e.Graphics.FillRectangle(New SolidBrush(tsmdrawingi.BackColor), rct)
End If
End Sub
Private Sub tsMFillingI_Paint(ByVal sender As Object, ByVal e As PaintEventArgs)
Dim tsmfillingi As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim rct As New Rectangle(2, 0, tsmfillingi.Width - 4, tsmfillingi.Height - 1)
If tsmfillingi.Selected Then
e.Graphics.DrawRectangle(Pens.Orange, rct)
e.Graphics.FillRectangle(New SolidBrush(tsmfillingi.BackColor), rct)
ElseIf CInt(tsmfillingi.Tag) = selectedFillingColorIndex Then
e.Graphics.DrawRectangle(Pens.OrangeRed, rct)
e.Graphics.FillRectangle(New SolidBrush(tsmfillingi.BackColor), rct)
tsDdFillingColor.BackColor = currentFillingColor
Else
e.Graphics.DrawRectangle(Pens.Black, rct)
e.Graphics.FillRectangle(New SolidBrush(tsmfillingi.BackColor), rct)
End If
End Sub
Private Sub tsMIx_Paint(ByVal sender As Object, ByVal e As PaintEventArgs)
Dim tsmix As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim rct As New Rectangle(2, 0, tsmix.Width - 4, tsmix.Height - 1)
If tsmix.Selected Then
e.Graphics.FillRectangle(Brushes.Orange, rct)
e.Graphics.DrawRectangle(Pens.OrangeRed, rct)
ElseIf CInt(tsmix.Tag) = brushSizeIndex Then
e.Graphics.FillRectangle(Brushes.DarkOrange, rct)
e.Graphics.DrawRectangle(Pens.Orange, rct)
End If
Using pn As New Pen(Brushes.Black, CInt((tsmix.Tag * 2) + 2))
e.Graphics.DrawLine(pn, 8, CInt(tsmix.Height / 2), tsmix.Width - 9, CInt(tsmix.Height / 2))
End Using
End Sub
Private Sub PaintBrush(ByVal xPos As Integer, ByVal yPos As Integer)
Using g As Graphics = Graphics.FromImage(pbRelationshipsMap.Image)
For Each tsMenuItem As ToolStripMenuItem In tsDdDrawingColor.DropDownItems
If tsMenuItem.BackColor = currentDrawingColor Then
g.FillRectangle(New SolidBrush(currentDrawingColor), New Rectangle(xPos, yPos, DrawSize, DrawSize))
End If
Next
End Using
Using g As Graphics = Graphics.FromImage(pbRelationshipsMap.Image)
For Each tsMenuItem As ToolStripMenuItem In tsDdFillingColor.DropDownItems
If tsMenuItem.BackColor = currentFillingColor Then
g.FillRectangle(New SolidBrush(currentFillingColor), New Rectangle(xPos, yPos, DrawSize, DrawSize))
End If
Next
End Using
pbRelationshipsMap.Refresh()
End Sub
Private Sub tsBtnFreeStyleDraw_Click(sender As Object, e As EventArgs) Handles tsBtnFreeStyleDraw.Click
If tsBtnFreeStyleDraw.Checked Then
tsBtnFreeStyleDraw.Checked = False
Else
If tsBtnLineDraw.Checked Then
If tsbtnRectDraw.Checked Then
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
tsbtnRectDraw.Checked = False
Else
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
End If
tsBtnLineDraw.Checked = False
Else
If tsbtnRectDraw.Checked Then
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
tsbtnRectDraw.Checked = False
Else
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
End If
End If
tsBtnFreeStyleDraw.Checked = True
End If
End Sub
Private Sub tsBtnLineDraw_Click(sender As Object, e As EventArgs) Handles tsBtnLineDraw.Click
If tsBtnLineDraw.Checked Then
tsBtnLineDraw.Checked = False
Else
If tsBtnFreeStyleDraw.Checked Then
If tsbtnRectDraw.Checked Then
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
tsbtnRectDraw.Checked = False
Else
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
End If
tsBtnFreeStyleDraw.Checked = False
Else
If tsbtnRectDraw.Checked Then
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
tsbtnRectDraw.Checked = False
Else
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
End If
End If
tsBtnLineDraw.Checked = True
End If
End Sub
Private Sub tsbtnRectDraw_Click(sender As Object, e As EventArgs) Handles tsbtnRectDraw.Click
If tsbtnRectDraw.Checked Then
tsbtnRectDraw.Checked = False
Else
If tsBtnFreeStyleDraw.Checked Then
If tsBtnLineDraw.Checked Then
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
tsBtnLineDraw.Checked = False
Else
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
End If
tsBtnFreeStyleDraw.Checked = False
Else
If tsBtnLineDraw.Checked Then
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
tsBtnLineDraw.Checked = False
Else
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
End If
End If
tsbtnRectDraw.Checked = True
End If
End Sub
Private Sub tsbtnCircleDraw_Click(sender As Object, e As EventArgs) Handles tsbtnCircleDraw.Click
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
Else
If tsBtnFreeStyleDraw.Checked Then
If tsBtnLineDraw.Checked Then
If tsbtnRectDraw.Checked Then
tsbtnRectDraw.Checked = False
End If
tsBtnLineDraw.Checked = False
Else
If tsbtnRectDraw.Checked Then
tsbtnRectDraw.Checked = False
End If
End If
tsBtnFreeStyleDraw.Checked = False
Else
If tsBtnLineDraw.Checked Then
If tsbtnRectDraw.Checked Then
tsbtnRectDraw.Checked = False
End If
tsBtnLineDraw.Checked = False
Else
If tsbtnRectDraw.Checked Then
tsbtnRectDraw.Checked = False
End If
End If
End If
tsbtnCircleDraw.Checked = True
End If
End Sub
Private Sub pbRelationshipsMap_MouseDown(sender As Object, e As MouseEventArgs) Handles pbRelationshipsMap.MouseDown
If e.Button = MouseButtons.Left Then
Dim shptyp As ShapeTypes
If tsBtnFreeStyleDraw.Checked Then
shptyp = CType(5, ShapeTypes)
ElseIf tsBtnLineDraw.Checked Then
shptyp = CType(4, ShapeTypes)
ElseIf tsbtnRectDraw.Checked Then
shptyp = CType(3, ShapeTypes)
ElseIf tsbtnCircleDraw.Checked Then
shptyp = CType(2, ShapeTypes)
ElseIf tsBtnOpaqueTextBox.Checked Then
shptyp = CType(1, ShapeTypes)
ElseIf tsBtnTransparentTextBox.Checked Then
shptyp = CType(0, ShapeTypes)
End If
_shape = New RMDrawingShapes(shptyp, colorFill, currentDrawingColor, currentFillingColor, DrawSize)
If shptyp = ShapeTypes.FreeHand Then
_shape.Points.Add(e.Location)
Else
_shape.StartPoint = e.Location
_shape.EndPoint = e.Location
End If
End If
End Sub
Private Sub pbRelationshipsMap_MouseMove(sender As Object, e As MouseEventArgs) Handles pbRelationshipsMap.MouseMove
If e.Button = MouseButtons.Left Then
If _shape.ShapeType = ShapeTypes.FreeHand Then
_shape.Points.Add(e.Location)
Else
_shape.EndPoint = e.Location
End If
pbRelationshipsMap.Refresh()
End If
End Sub
Private Sub pbRelationshipsMap_MouseUp(sender As Object, e As MouseEventArgs) Handles pbRelationshipsMap.MouseUp
If e.Button = MouseButtons.Left Then
If _shape.ShapeType = ShapeTypes.FreeHand Then
_shapes.Add(_shape)
_shapesMemorizer.Add(_shape)
ElseIf _shape.ShapeType = ShapeTypes.OpaqueTextBox Then
Dim descTextBox As RichTextBox = New RichTextBox
descTextBox.Location = _shape.StartPoint
descTextBox.Width = Math.Max(_shape.StartPoint.X, _shape.EndPoint.X) - Math.Min(_shape.StartPoint.X, _shape.EndPoint.X)
If _shape.EndPoint.X <= _shape.StartPoint.X + 5 And _shape.EndPoint.Y <= _shape.StartPoint.Y + 5 Then
_shape.StartPoint = Nothing
_shape.EndPoint = Nothing
pbRelationshipsMap.Refresh()
Exit Sub
End If
If Math.Max(_shape.StartPoint.X, _shape.EndPoint.X) - Math.Min(_shape.StartPoint.X, _shape.EndPoint.X) < 150 Then
descTextBox.Width = 150
Else
descTextBox.Width = Math.Max(_shape.StartPoint.X, _shape.EndPoint.X) - Math.Min(_shape.StartPoint.X, _shape.EndPoint.X)
End If
If Math.Max(_shape.StartPoint.Y, _shape.EndPoint.Y) - Math.Min(_shape.StartPoint.Y, _shape.EndPoint.Y) < 23 Then
descTextBox.Height = 23
Else
descTextBox.Height = Math.Max(_shape.StartPoint.Y, _shape.EndPoint.Y) - Math.Min(_shape.StartPoint.Y, _shape.EndPoint.Y)
End If
descTextBox.BackColor = _shape.FillColor
descTextBox.ForeColor = currentDrawingColor
descTextBox.BorderStyle = BorderStyle.None
descTextBox.Visible = True
descTextBox.Multiline = True
descTextBox.Font = New Drawing.Font(tsCbTextBoxFont.Text, CSng(tsCbTextSize.Text), FontStyle.Regular)
pbRelationshipsMap.Controls.Add(descTextBox)
descTextBox.Focus()
AddHandler descTextBox.LostFocus, AddressOf descTextBox_LostFocus
Else
If _shape.StartPoint.X <> _shape.EndPoint.X And _shape.StartPoint.Y <> _shape.EndPoint.Y Then
_shapes.Add(_shape)
_shapesMemorizer.Add(_shape)
End If
End If
_shape = Nothing
pbRelationshipsMap.Refresh()
End If
End Sub
Private Sub pbRelationshipsMap_Paint(sender As Object, e As PaintEventArgs) Handles pbRelationshipsMap.Paint
DrawPicture(e.Graphics)
e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
For Each s As RMDrawingShapes In _shapes
s.Draw(e.Graphics)
Next
If _shape IsNot Nothing AndAlso (_shape.EndPoint <> _shape.StartPoint Or _shape.ShapeType = ShapeTypes.FreeHand) Then
_shape.Draw(e.Graphics)
End If
End Sub
Private Sub tsDdBrushSize_DropDownItemClicked(sender As Object, e As ToolStripItemClickedEventArgs) Handles tsDdBrushSize.DropDownItemClicked
when a brush size is selected from the tsSbBrushSize dropdown you set the SelectedBrushSize to its Tag value
brushSizeIndex = CInt(e.ClickedItem.Tag)
DrawSize = (e.ClickedItem.Tag * 2) + 2
End Sub
Private Sub tsDdDrawingColor_DropDownItemClicked(sender As Object, e As ToolStripItemClickedEventArgs) Handles tsDdDrawingColor.DropDownItemClicked
when a drawing color is selected from the SbDrawingColor dropdown you set the CurrentDrawingColor to its Tag value
selectedDrawingColorIndex = CInt(e.ClickedItem.Tag)
currentDrawingColor = Color.FromName(solidColorsList(selectedDrawingColorIndex))
End Sub
Private Sub tsDdFillingColor_DropDownItemClicked(sender As Object, e As ToolStripItemClickedEventArgs) Handles tsDdFillingColor.DropDownItemClicked
when a drawing color is selected from the SbDrawingColor dropdown you set the CurrentFillingColor to its Tag value
selectedFillingColorIndex = CInt(e.ClickedItem.Tag)
currentFillingColor = Color.FromName(solidColorsList(selectedFillingColorIndex))
End Sub
Private Sub tsBtnUndoDrawingStep_Click(sender As Object, e As EventArgs) Handles tsBtnUndoDrawingStep.Click
_shapes.RemoveAt(_shapes.Count - 1)
pbRelationshipsMap.Refresh()
End Sub
Private Sub tsBtnRedoDrawingStep_Click(sender As Object, e As EventArgs) Handles tsBtnRedoDrawingStep.Click
_shapes.Add(_shapesMemorizer(_shapes.Count))
pbRelationshipsMap.Refresh()
End Sub
Private Sub tsBtnResetCurrentMap_Click(sender As Object, e As EventArgs) Handles tsBtnResetCurrentMap.Click
For sIndex As Integer = _shapes.Count - 1 To 0 Step -1
_shapes.RemoveAt(sIndex)
Next
pbRelationshipsMap.Refresh()
End Sub
Private Sub tsBtnRestoreDefaultMap_Click(sender As Object, e As EventArgs) Handles tsBtnRestoreDefaultMap.Click
If _shapes.Count > 0 Then
For sIndex As Integer = _shapes.Count - 1 To 0 Step -1
_shapes.RemoveAt(sIndex)
Next
End If
pbRelationshipsMap.Image = My.Resources.RMDBRelMap
pbRelationshipsMap.Refresh()
End Sub
Private Sub tsBtnFillColorCheck_Click(sender As Object, e As EventArgs) Handles tsBtnFillColorCheck.Click
If colorFill Then
colorFill = False
tsBtnFillColorCheck.Image = My.Resources.cbUnchecked
tsDdFillingColor.Enabled = False
tsDdFillingColor.BackColor = SystemColors.ButtonShadow
tsDdFillingColor.ToolTipText = Nothing
Else
colorFill = True
tsBtnFillColorCheck.Image = My.Resources.cbChecked
tsDdFillingColor.Enabled = True
tsDdFillingColor.BackColor = currentFillingColor
tsDdFillingColor.ToolTipText = solidColorsList(selectedFillingColorIndex)
End If
End Sub
Private Sub tsBtnOpaqueTextBox_Click(sender As Object, e As EventArgs) Handles tsBtnOpaqueTextBox.Click
If tsBtnOpaqueTextBox.Checked Then
tsBtnOpaqueTextBox.Checked = False
Else
tsBtnOpaqueTextBox.Checked = True
End If
End Sub
Private Sub descTextBox_LostFocus(ByVal sender As Object, e As EventArgs)
If _shape.StartPoint.X <> _shape.EndPoint.X And _shape.StartPoint.Y <> _shape.EndPoint.Y Then
_shapes.Add(_shape)
_shapesMemorizer.Add(_shape)
End If
_shape = Nothing
pbRelationshipsMap.Refresh()
End Sub
Private Sub pbRelationshipsMap_MouseEnter(sender As Object, e As EventArgs) Handles pbRelationshipsMap.MouseEnter
If tsBtnOpaqueTextBox.Checked Or tsBtnTransparentTextBox.Checked Then
Me.Cursor = Cursors.IBeam
Else
Me.Cursor = Cursors.Default
End If
End Sub
Private Sub pbRelationshipsMap_MouseLeave(sender As Object, e As EventArgs) Handles pbRelationshipsMap.MouseLeave
If Me.Cursor <> Cursors.Default Then
Me.Cursor = Cursors.Default
End If
End Sub
End Class
In case youre wondering, this is the RMDrawingShapes class code:
Public Class RMDrawingShapes
Public Property ShapeType As ShapeTypes
Public Property StartPoint As Point
Public Property EndPoint As Point
Public Property Filled As Boolean
Public Property ShapeColor As Color
Public Property FillColor As Color
Public Property PenWidth As Integer
Public Property Points As List(Of Point)
Public Enum ShapeTypes As Integer
TransparentTextBox = 0
OpaqueTextBox = 1
Circle = 2
Rectangle = 3
Line = 4
FreeHand = 5
End Enum
Public Sub New(ByVal shptyp As ShapeTypes, ByVal fill As Boolean, ByVal dcolor As Color, ByVal fcolor As Color, ByVal penwdth As Integer)
Me.ShapeType = shptyp
Me.Filled = fill
Me.ShapeColor = dcolor
Me.FillColor = fcolor
Me.PenWidth = penwdth
Me.Points = New List(Of Point)
End Sub
Public Sub New(ByVal shp As RMDrawingShapes)
Me.ShapeType = shp.ShapeType
Me.Filled = shp.Filled
Me.ShapeColor = shp.ShapeColor
Me.FillColor = shp.FillColor
Me.StartPoint = shp.StartPoint
Me.EndPoint = shp.EndPoint
Me.Points = shp.Points
End Sub
Public Sub Draw(ByVal grx As Graphics)
With grx
Dim rect As Rectangle
rect.X = Math.Min(Me.StartPoint.X, Me.EndPoint.X)
rect.Y = Math.Min(Me.StartPoint.Y, Me.EndPoint.Y)
rect.Width = Math.Max(Me.StartPoint.X, Me.EndPoint.X) - rect.X
rect.Height = Math.Max(Me.StartPoint.Y, Me.EndPoint.Y) - rect.Y
Select Case Me.ShapeType
Case ShapeTypes.TransparentTextBox
Using pn As New Pen(Brushes.Transparent, 2)
.DrawRectangle(pn, rect)
End Using
Case ShapeTypes.OpaqueTextBox
Using pn As New Pen(Brushes.Transparent, 2)
.DrawRectangle(pn, rect)
End Using
Using sb As New SolidBrush(Me.FillColor)
.FillRectangle(sb, rect)
End Using
Case ShapeTypes.Circle
If Filled Then
Using pn As New Pen(Me.ShapeColor, Me.PenWidth)
.DrawEllipse(pn, rect)
End Using
Using sb As New SolidBrush(Me.FillColor)
.FillEllipse(sb, rect)
End Using
Else
Using pn As New Pen(Me.ShapeColor, Me.PenWidth)
.DrawEllipse(pn, rect)
End Using
End If
Case ShapeTypes.Rectangle
If Filled Then
Using pn As New Pen(Me.ShapeColor, Me.PenWidth)
.DrawRectangle(pn, rect)
End Using
Using sb As New SolidBrush(Me.FillColor)
.FillRectangle(sb, rect)
End Using
Else
Using pn As New Pen(Me.ShapeColor, Me.PenWidth)
.DrawRectangle(pn, rect)
End Using
End If
Case ShapeTypes.Line
Using pn As New Pen(Me.ShapeColor, Me.PenWidth)
pn.StartCap = Drawing2D.LineCap.Round
pn.EndCap = Drawing2D.LineCap.Round
.DrawLine(pn, Me.StartPoint.X, Me.StartPoint.Y, Me.EndPoint.X, Me.EndPoint.Y)
End Using
Case ShapeTypes.FreeHand
Using pn As New Pen(Me.ShapeColor, Me.PenWidth)
pn.StartCap = Drawing2D.LineCap.Round
pn.EndCap = Drawing2D.LineCap.Round
.DrawLines(pn, Me.Points.ToArray)
End Using
End Select
End With
End Sub
End Class
Thanks in advance for any given help.
Continue reading...
Some of you may still be fresh from my last thread here, if youre not, be sure to visit it first as you might get a head start on whats going on now.
At the moment Im trying to draw a textbox with the mouse at runtime, just as the title suggests. The logic Im following is to first draw a rectangle shape and convert that shape into a richtextbox, passing all the relevant characteristics into the richtextbox control, such as the location, width and height and then I also pass on the fontfamiliy, fontsize and fontstyle values by checking if certain buttons are pressed on a toolstripbar.
I think this logic is actually the key, as Im really close to what Im trying to achieve, as so far Im able to draw the textbox and Im able to type text after drawing it.
What Im missing now, is that I need the textbox to be removed and to transfer the written text on the textbox back into the shape. This would only happen when the user would click anywhere else but the richtextbox control itself, where the control would lose focus, thus creating a rectangle shape with text. I guess using DrawString will be the key here? If thats true, then how do I use it on this case?
Another thing thats bugging me, is that when typing the text on the RichTextBox, if the text length surpasses the height of the control itself, a vertical scrollbar appears to accomodate the rest of the text.
What I wanted to happen here, is resize the richtextbox in order to maintain visibility of the text, but Id want to impose a fixed maximum restriction upon the resizing of the control. Is this possible?
Heres the code I have so far:
Imports System.Drawing.Imaging
Imports Microsoft.VisualBasic.PowerPacks
Imports MasterRecipe.RMDrawingShapes
Imports System.Drawing.Text
Public Class fDBRelationshipsMap
Size of the pen
Private DrawSize As Integer = 6
Private mapBmp As Bitmap
Private currentUnsavedMap As Bitmap
Private selectedDrawingColorIndex As Integer = -1
Private selectedFillingColorIndex As Integer = -1
Private currentDrawingColor As Color = Color.Black
Private currentFillingColor As Color = Color.White
Private solidColorsList As List(Of String)
Private brushSizeIndex As Integer = 2
Buffer for erasing rubberband lines.
Private m_BufferBitmap As Bitmap
Private m_BufferGraphics As Graphics
The mouse position.
Private _x1 As Integer = 0
Private _y1 As Integer = 0
Private _x2 As Integer = 0
Private _y2 As Integer = 0
Private _w As Integer = 0
Private _h As Integer = 0
Private _shapes As New List(Of RMDrawingShapes)
Private _shape As RMDrawingShapes
Private _shapesMemorizer As New List(Of RMDrawingShapes)
Private colorFill As Boolean = False
Private Sub fDBRelationshipsMap_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim sysFontCollection As New InstalledFontCollection
Dim _ffIndex As Integer = -1
For Each _fontFamily As FontFamily In sysFontCollection.Families
tsCbTextBoxFont.Items.Add(_fontFamily.Name)
_ffIndex += 1
If _fontFamily.Name = "Arial" Then tsCbTextBoxFont.SelectedIndex = _ffIndex
Next
If pbRelationshipsMap.Image Is Nothing Then
pbRelationshipsMap.Image = My.Resources.RMDBRelMap
End If
Dim fontSizeIndex As Integer = 7
Do
If fontSizeIndex < 12 Then
fontSizeIndex += 1
ElseIf fontSizeIndex < 28 Then
fontSizeIndex += 2
ElseIf fontSizeIndex = 28 Then
fontSizeIndex += 8
ElseIf fontSizeIndex = 36 Then
fontSizeIndex += 12
ElseIf fontSizeIndex = 48 Then
fontSizeIndex += 24
End If
tsCbTextSize.Items.Add(fontSizeIndex)
Loop While fontSizeIndex < 72
tsCbTextSize.SelectedIndex = 3
currentUnsavedMap = New Drawing.Bitmap(pbRelationshipsMap.Image)
solidColorsList = New List(Of String)
For Each _solidColor As KnownColor In [Enum].GetValues(GetType(KnownColor))
Dim _color As Color = Color.FromKnownColor(_solidColor)
If Not _color.IsSystemColor And _solidColor.ToString <> "Transparent" Then
solidColorsList.Add(_solidColor.ToString)
End If
Next
Dim tsDrawingMenu As New ToolStripDropDown
tsDrawingMenu.LayoutStyle = ToolStripLayoutStyle.Table
DirectCast(tsDrawingMenu.LayoutSettings, TableLayoutSettings).ColumnCount = 14
Dim tsFillingMenu As New ToolStripDropDown
tsFillingMenu.LayoutStyle = ToolStripLayoutStyle.Table
DirectCast(tsFillingMenu.LayoutSettings, TableLayoutSettings).ColumnCount = 14
tsDdDrawingColor.DropDown = tsDrawingMenu
tsDdFillingColor.DropDown = tsFillingMenu
For tsMDrawingICounter As Integer = 0 To solidColorsList.Count - 1
Dim tsMDrawingI As New ToolStripMenuItem("Cor: " & solidColorsList(tsMDrawingICounter))
AddHandler tsMDrawingI.Paint, AddressOf tsMDrawingI_Paint Add the handler procedure for Drawing
tsMDrawingI.Tag = tsMDrawingICounter
tsMDrawingI.Text = String.Empty
tsMDrawingI.Name = "ts" & solidColorsList(tsMDrawingICounter)
tsMDrawingI.AutoSize = False
tsMDrawingI.Size = New Drawing.Size(20, 20)
tsMDrawingI.Margin = New Padding(2)
tsMDrawingI.BackColor = Color.FromName(solidColorsList(tsMDrawingICounter))
tsMDrawingI.ToolTipText = solidColorsList(tsMDrawingICounter)
tsDrawingMenu.Items.Add(tsMDrawingI)
If tsMDrawingI.BackColor = Color.Black Then
selectedDrawingColorIndex = tsMDrawingICounter
tsDdDrawingColor.BackColor = currentDrawingColor
tsDdDrawingColor.ToolTipText = solidColorsList(tsMDrawingICounter)
End If
Next
For tsMFillingICounter As Integer = 0 To solidColorsList.Count - 1
Dim tsMFillingI As New ToolStripMenuItem("Cor: " & solidColorsList(tsMFillingICounter))
AddHandler tsMFillingI.Paint, AddressOf tsMFillingI_Paint Add the handler procedure for Drawing
tsMFillingI.Tag = tsMFillingICounter
tsMFillingI.Text = String.Empty
tsMFillingI.Name = "ts" & solidColorsList(tsMFillingICounter)
tsMFillingI.AutoSize = False
tsMFillingI.Size = New Drawing.Size(20, 20)
tsMFillingI.Margin = New Padding(2)
tsMFillingI.BackColor = Color.FromName(solidColorsList(tsMFillingICounter))
tsMFillingI.ToolTipText = solidColorsList(tsMFillingICounter)
tsFillingMenu.Items.Add(tsMFillingI)
If tsMFillingI.BackColor = Color.White Then
selectedFillingColorIndex = tsMFillingICounter
tsDdFillingColor.BackColor = currentFillingColor
tsDdFillingColor.ToolTipText = solidColorsList(tsMFillingICounter)
End If
Next
Dim tsMenux As New ToolStripDropDown
tsMenux.LayoutStyle = ToolStripLayoutStyle.Table
DirectCast(tsMenux.LayoutSettings, TableLayoutSettings).ColumnCount = 1
DirectCast(tsMenux.LayoutSettings, TableLayoutSettings).RowCount = 5
tsDdBrushSize.DropDown = tsMenux
For tsMICounter As Integer = 0 To 4
Dim trueHeightSize As Integer = (tsMICounter * 2) + 2
Dim tsMIx As New ToolStripMenuItem("Tamanho: " & trueHeightSize & "px")
AddHandler tsMIx.Paint, AddressOf tsMIx_Paint Add the handler procedure for Drawing
tsMIx.Name = "ts" & trueHeightSize & "px"
tsMIx.Tag = tsMICounter sets the Tags according to the respective index (0 => 2, 1 => 4, 2 => 6, 3 => 8, 4 => 10)
tsMIx.Text = String.Empty
tsMIx.AutoSize = False
tsMIx.Size = New Drawing.Size(120, trueHeightSize + 20)
tsMIx.Margin = New Padding(2)
tsDdBrushSize.DropDownItems.Add(tsMIx)
Next
tsDdFillingColor.Enabled = False
tsDdFillingColor.BackColor = SystemColors.ButtonShadow
tsDdFillingColor.ToolTipText = Nothing
End Sub
Private Sub tsMDrawingI_Paint(ByVal sender As Object, ByVal e As PaintEventArgs)
Dim tsmdrawingi As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim rct As New Rectangle(2, 0, tsmdrawingi.Width - 4, tsmdrawingi.Height - 1)
If tsmdrawingi.Selected Then
e.Graphics.DrawRectangle(Pens.Orange, rct)
e.Graphics.FillRectangle(New SolidBrush(tsmdrawingi.BackColor), rct)
ElseIf CInt(tsmdrawingi.Tag) = selectedDrawingColorIndex Then
e.Graphics.DrawRectangle(Pens.OrangeRed, rct)
e.Graphics.FillRectangle(New SolidBrush(tsmdrawingi.BackColor), rct)
tsDdDrawingColor.BackColor = currentDrawingColor
Else
e.Graphics.DrawRectangle(Pens.Black, rct)
e.Graphics.FillRectangle(New SolidBrush(tsmdrawingi.BackColor), rct)
End If
End Sub
Private Sub tsMFillingI_Paint(ByVal sender As Object, ByVal e As PaintEventArgs)
Dim tsmfillingi As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim rct As New Rectangle(2, 0, tsmfillingi.Width - 4, tsmfillingi.Height - 1)
If tsmfillingi.Selected Then
e.Graphics.DrawRectangle(Pens.Orange, rct)
e.Graphics.FillRectangle(New SolidBrush(tsmfillingi.BackColor), rct)
ElseIf CInt(tsmfillingi.Tag) = selectedFillingColorIndex Then
e.Graphics.DrawRectangle(Pens.OrangeRed, rct)
e.Graphics.FillRectangle(New SolidBrush(tsmfillingi.BackColor), rct)
tsDdFillingColor.BackColor = currentFillingColor
Else
e.Graphics.DrawRectangle(Pens.Black, rct)
e.Graphics.FillRectangle(New SolidBrush(tsmfillingi.BackColor), rct)
End If
End Sub
Private Sub tsMIx_Paint(ByVal sender As Object, ByVal e As PaintEventArgs)
Dim tsmix As ToolStripMenuItem = DirectCast(sender, ToolStripMenuItem)
Dim rct As New Rectangle(2, 0, tsmix.Width - 4, tsmix.Height - 1)
If tsmix.Selected Then
e.Graphics.FillRectangle(Brushes.Orange, rct)
e.Graphics.DrawRectangle(Pens.OrangeRed, rct)
ElseIf CInt(tsmix.Tag) = brushSizeIndex Then
e.Graphics.FillRectangle(Brushes.DarkOrange, rct)
e.Graphics.DrawRectangle(Pens.Orange, rct)
End If
Using pn As New Pen(Brushes.Black, CInt((tsmix.Tag * 2) + 2))
e.Graphics.DrawLine(pn, 8, CInt(tsmix.Height / 2), tsmix.Width - 9, CInt(tsmix.Height / 2))
End Using
End Sub
Private Sub PaintBrush(ByVal xPos As Integer, ByVal yPos As Integer)
Using g As Graphics = Graphics.FromImage(pbRelationshipsMap.Image)
For Each tsMenuItem As ToolStripMenuItem In tsDdDrawingColor.DropDownItems
If tsMenuItem.BackColor = currentDrawingColor Then
g.FillRectangle(New SolidBrush(currentDrawingColor), New Rectangle(xPos, yPos, DrawSize, DrawSize))
End If
Next
End Using
Using g As Graphics = Graphics.FromImage(pbRelationshipsMap.Image)
For Each tsMenuItem As ToolStripMenuItem In tsDdFillingColor.DropDownItems
If tsMenuItem.BackColor = currentFillingColor Then
g.FillRectangle(New SolidBrush(currentFillingColor), New Rectangle(xPos, yPos, DrawSize, DrawSize))
End If
Next
End Using
pbRelationshipsMap.Refresh()
End Sub
Private Sub tsBtnFreeStyleDraw_Click(sender As Object, e As EventArgs) Handles tsBtnFreeStyleDraw.Click
If tsBtnFreeStyleDraw.Checked Then
tsBtnFreeStyleDraw.Checked = False
Else
If tsBtnLineDraw.Checked Then
If tsbtnRectDraw.Checked Then
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
tsbtnRectDraw.Checked = False
Else
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
End If
tsBtnLineDraw.Checked = False
Else
If tsbtnRectDraw.Checked Then
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
tsbtnRectDraw.Checked = False
Else
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
End If
End If
tsBtnFreeStyleDraw.Checked = True
End If
End Sub
Private Sub tsBtnLineDraw_Click(sender As Object, e As EventArgs) Handles tsBtnLineDraw.Click
If tsBtnLineDraw.Checked Then
tsBtnLineDraw.Checked = False
Else
If tsBtnFreeStyleDraw.Checked Then
If tsbtnRectDraw.Checked Then
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
tsbtnRectDraw.Checked = False
Else
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
End If
tsBtnFreeStyleDraw.Checked = False
Else
If tsbtnRectDraw.Checked Then
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
tsbtnRectDraw.Checked = False
Else
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
End If
End If
tsBtnLineDraw.Checked = True
End If
End Sub
Private Sub tsbtnRectDraw_Click(sender As Object, e As EventArgs) Handles tsbtnRectDraw.Click
If tsbtnRectDraw.Checked Then
tsbtnRectDraw.Checked = False
Else
If tsBtnFreeStyleDraw.Checked Then
If tsBtnLineDraw.Checked Then
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
tsBtnLineDraw.Checked = False
Else
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
End If
tsBtnFreeStyleDraw.Checked = False
Else
If tsBtnLineDraw.Checked Then
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
tsBtnLineDraw.Checked = False
Else
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
End If
End If
End If
tsbtnRectDraw.Checked = True
End If
End Sub
Private Sub tsbtnCircleDraw_Click(sender As Object, e As EventArgs) Handles tsbtnCircleDraw.Click
If tsbtnCircleDraw.Checked Then
tsbtnCircleDraw.Checked = False
Else
If tsBtnFreeStyleDraw.Checked Then
If tsBtnLineDraw.Checked Then
If tsbtnRectDraw.Checked Then
tsbtnRectDraw.Checked = False
End If
tsBtnLineDraw.Checked = False
Else
If tsbtnRectDraw.Checked Then
tsbtnRectDraw.Checked = False
End If
End If
tsBtnFreeStyleDraw.Checked = False
Else
If tsBtnLineDraw.Checked Then
If tsbtnRectDraw.Checked Then
tsbtnRectDraw.Checked = False
End If
tsBtnLineDraw.Checked = False
Else
If tsbtnRectDraw.Checked Then
tsbtnRectDraw.Checked = False
End If
End If
End If
tsbtnCircleDraw.Checked = True
End If
End Sub
Private Sub pbRelationshipsMap_MouseDown(sender As Object, e As MouseEventArgs) Handles pbRelationshipsMap.MouseDown
If e.Button = MouseButtons.Left Then
Dim shptyp As ShapeTypes
If tsBtnFreeStyleDraw.Checked Then
shptyp = CType(5, ShapeTypes)
ElseIf tsBtnLineDraw.Checked Then
shptyp = CType(4, ShapeTypes)
ElseIf tsbtnRectDraw.Checked Then
shptyp = CType(3, ShapeTypes)
ElseIf tsbtnCircleDraw.Checked Then
shptyp = CType(2, ShapeTypes)
ElseIf tsBtnOpaqueTextBox.Checked Then
shptyp = CType(1, ShapeTypes)
ElseIf tsBtnTransparentTextBox.Checked Then
shptyp = CType(0, ShapeTypes)
End If
_shape = New RMDrawingShapes(shptyp, colorFill, currentDrawingColor, currentFillingColor, DrawSize)
If shptyp = ShapeTypes.FreeHand Then
_shape.Points.Add(e.Location)
Else
_shape.StartPoint = e.Location
_shape.EndPoint = e.Location
End If
End If
End Sub
Private Sub pbRelationshipsMap_MouseMove(sender As Object, e As MouseEventArgs) Handles pbRelationshipsMap.MouseMove
If e.Button = MouseButtons.Left Then
If _shape.ShapeType = ShapeTypes.FreeHand Then
_shape.Points.Add(e.Location)
Else
_shape.EndPoint = e.Location
End If
pbRelationshipsMap.Refresh()
End If
End Sub
Private Sub pbRelationshipsMap_MouseUp(sender As Object, e As MouseEventArgs) Handles pbRelationshipsMap.MouseUp
If e.Button = MouseButtons.Left Then
If _shape.ShapeType = ShapeTypes.FreeHand Then
_shapes.Add(_shape)
_shapesMemorizer.Add(_shape)
ElseIf _shape.ShapeType = ShapeTypes.OpaqueTextBox Then
Dim descTextBox As RichTextBox = New RichTextBox
descTextBox.Location = _shape.StartPoint
descTextBox.Width = Math.Max(_shape.StartPoint.X, _shape.EndPoint.X) - Math.Min(_shape.StartPoint.X, _shape.EndPoint.X)
If _shape.EndPoint.X <= _shape.StartPoint.X + 5 And _shape.EndPoint.Y <= _shape.StartPoint.Y + 5 Then
_shape.StartPoint = Nothing
_shape.EndPoint = Nothing
pbRelationshipsMap.Refresh()
Exit Sub
End If
If Math.Max(_shape.StartPoint.X, _shape.EndPoint.X) - Math.Min(_shape.StartPoint.X, _shape.EndPoint.X) < 150 Then
descTextBox.Width = 150
Else
descTextBox.Width = Math.Max(_shape.StartPoint.X, _shape.EndPoint.X) - Math.Min(_shape.StartPoint.X, _shape.EndPoint.X)
End If
If Math.Max(_shape.StartPoint.Y, _shape.EndPoint.Y) - Math.Min(_shape.StartPoint.Y, _shape.EndPoint.Y) < 23 Then
descTextBox.Height = 23
Else
descTextBox.Height = Math.Max(_shape.StartPoint.Y, _shape.EndPoint.Y) - Math.Min(_shape.StartPoint.Y, _shape.EndPoint.Y)
End If
descTextBox.BackColor = _shape.FillColor
descTextBox.ForeColor = currentDrawingColor
descTextBox.BorderStyle = BorderStyle.None
descTextBox.Visible = True
descTextBox.Multiline = True
descTextBox.Font = New Drawing.Font(tsCbTextBoxFont.Text, CSng(tsCbTextSize.Text), FontStyle.Regular)
pbRelationshipsMap.Controls.Add(descTextBox)
descTextBox.Focus()
AddHandler descTextBox.LostFocus, AddressOf descTextBox_LostFocus
Else
If _shape.StartPoint.X <> _shape.EndPoint.X And _shape.StartPoint.Y <> _shape.EndPoint.Y Then
_shapes.Add(_shape)
_shapesMemorizer.Add(_shape)
End If
End If
_shape = Nothing
pbRelationshipsMap.Refresh()
End If
End Sub
Private Sub pbRelationshipsMap_Paint(sender As Object, e As PaintEventArgs) Handles pbRelationshipsMap.Paint
DrawPicture(e.Graphics)
e.Graphics.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias
For Each s As RMDrawingShapes In _shapes
s.Draw(e.Graphics)
Next
If _shape IsNot Nothing AndAlso (_shape.EndPoint <> _shape.StartPoint Or _shape.ShapeType = ShapeTypes.FreeHand) Then
_shape.Draw(e.Graphics)
End If
End Sub
Private Sub tsDdBrushSize_DropDownItemClicked(sender As Object, e As ToolStripItemClickedEventArgs) Handles tsDdBrushSize.DropDownItemClicked
when a brush size is selected from the tsSbBrushSize dropdown you set the SelectedBrushSize to its Tag value
brushSizeIndex = CInt(e.ClickedItem.Tag)
DrawSize = (e.ClickedItem.Tag * 2) + 2
End Sub
Private Sub tsDdDrawingColor_DropDownItemClicked(sender As Object, e As ToolStripItemClickedEventArgs) Handles tsDdDrawingColor.DropDownItemClicked
when a drawing color is selected from the SbDrawingColor dropdown you set the CurrentDrawingColor to its Tag value
selectedDrawingColorIndex = CInt(e.ClickedItem.Tag)
currentDrawingColor = Color.FromName(solidColorsList(selectedDrawingColorIndex))
End Sub
Private Sub tsDdFillingColor_DropDownItemClicked(sender As Object, e As ToolStripItemClickedEventArgs) Handles tsDdFillingColor.DropDownItemClicked
when a drawing color is selected from the SbDrawingColor dropdown you set the CurrentFillingColor to its Tag value
selectedFillingColorIndex = CInt(e.ClickedItem.Tag)
currentFillingColor = Color.FromName(solidColorsList(selectedFillingColorIndex))
End Sub
Private Sub tsBtnUndoDrawingStep_Click(sender As Object, e As EventArgs) Handles tsBtnUndoDrawingStep.Click
_shapes.RemoveAt(_shapes.Count - 1)
pbRelationshipsMap.Refresh()
End Sub
Private Sub tsBtnRedoDrawingStep_Click(sender As Object, e As EventArgs) Handles tsBtnRedoDrawingStep.Click
_shapes.Add(_shapesMemorizer(_shapes.Count))
pbRelationshipsMap.Refresh()
End Sub
Private Sub tsBtnResetCurrentMap_Click(sender As Object, e As EventArgs) Handles tsBtnResetCurrentMap.Click
For sIndex As Integer = _shapes.Count - 1 To 0 Step -1
_shapes.RemoveAt(sIndex)
Next
pbRelationshipsMap.Refresh()
End Sub
Private Sub tsBtnRestoreDefaultMap_Click(sender As Object, e As EventArgs) Handles tsBtnRestoreDefaultMap.Click
If _shapes.Count > 0 Then
For sIndex As Integer = _shapes.Count - 1 To 0 Step -1
_shapes.RemoveAt(sIndex)
Next
End If
pbRelationshipsMap.Image = My.Resources.RMDBRelMap
pbRelationshipsMap.Refresh()
End Sub
Private Sub tsBtnFillColorCheck_Click(sender As Object, e As EventArgs) Handles tsBtnFillColorCheck.Click
If colorFill Then
colorFill = False
tsBtnFillColorCheck.Image = My.Resources.cbUnchecked
tsDdFillingColor.Enabled = False
tsDdFillingColor.BackColor = SystemColors.ButtonShadow
tsDdFillingColor.ToolTipText = Nothing
Else
colorFill = True
tsBtnFillColorCheck.Image = My.Resources.cbChecked
tsDdFillingColor.Enabled = True
tsDdFillingColor.BackColor = currentFillingColor
tsDdFillingColor.ToolTipText = solidColorsList(selectedFillingColorIndex)
End If
End Sub
Private Sub tsBtnOpaqueTextBox_Click(sender As Object, e As EventArgs) Handles tsBtnOpaqueTextBox.Click
If tsBtnOpaqueTextBox.Checked Then
tsBtnOpaqueTextBox.Checked = False
Else
tsBtnOpaqueTextBox.Checked = True
End If
End Sub
Private Sub descTextBox_LostFocus(ByVal sender As Object, e As EventArgs)
If _shape.StartPoint.X <> _shape.EndPoint.X And _shape.StartPoint.Y <> _shape.EndPoint.Y Then
_shapes.Add(_shape)
_shapesMemorizer.Add(_shape)
End If
_shape = Nothing
pbRelationshipsMap.Refresh()
End Sub
Private Sub pbRelationshipsMap_MouseEnter(sender As Object, e As EventArgs) Handles pbRelationshipsMap.MouseEnter
If tsBtnOpaqueTextBox.Checked Or tsBtnTransparentTextBox.Checked Then
Me.Cursor = Cursors.IBeam
Else
Me.Cursor = Cursors.Default
End If
End Sub
Private Sub pbRelationshipsMap_MouseLeave(sender As Object, e As EventArgs) Handles pbRelationshipsMap.MouseLeave
If Me.Cursor <> Cursors.Default Then
Me.Cursor = Cursors.Default
End If
End Sub
End Class
In case youre wondering, this is the RMDrawingShapes class code:
Public Class RMDrawingShapes
Public Property ShapeType As ShapeTypes
Public Property StartPoint As Point
Public Property EndPoint As Point
Public Property Filled As Boolean
Public Property ShapeColor As Color
Public Property FillColor As Color
Public Property PenWidth As Integer
Public Property Points As List(Of Point)
Public Enum ShapeTypes As Integer
TransparentTextBox = 0
OpaqueTextBox = 1
Circle = 2
Rectangle = 3
Line = 4
FreeHand = 5
End Enum
Public Sub New(ByVal shptyp As ShapeTypes, ByVal fill As Boolean, ByVal dcolor As Color, ByVal fcolor As Color, ByVal penwdth As Integer)
Me.ShapeType = shptyp
Me.Filled = fill
Me.ShapeColor = dcolor
Me.FillColor = fcolor
Me.PenWidth = penwdth
Me.Points = New List(Of Point)
End Sub
Public Sub New(ByVal shp As RMDrawingShapes)
Me.ShapeType = shp.ShapeType
Me.Filled = shp.Filled
Me.ShapeColor = shp.ShapeColor
Me.FillColor = shp.FillColor
Me.StartPoint = shp.StartPoint
Me.EndPoint = shp.EndPoint
Me.Points = shp.Points
End Sub
Public Sub Draw(ByVal grx As Graphics)
With grx
Dim rect As Rectangle
rect.X = Math.Min(Me.StartPoint.X, Me.EndPoint.X)
rect.Y = Math.Min(Me.StartPoint.Y, Me.EndPoint.Y)
rect.Width = Math.Max(Me.StartPoint.X, Me.EndPoint.X) - rect.X
rect.Height = Math.Max(Me.StartPoint.Y, Me.EndPoint.Y) - rect.Y
Select Case Me.ShapeType
Case ShapeTypes.TransparentTextBox
Using pn As New Pen(Brushes.Transparent, 2)
.DrawRectangle(pn, rect)
End Using
Case ShapeTypes.OpaqueTextBox
Using pn As New Pen(Brushes.Transparent, 2)
.DrawRectangle(pn, rect)
End Using
Using sb As New SolidBrush(Me.FillColor)
.FillRectangle(sb, rect)
End Using
Case ShapeTypes.Circle
If Filled Then
Using pn As New Pen(Me.ShapeColor, Me.PenWidth)
.DrawEllipse(pn, rect)
End Using
Using sb As New SolidBrush(Me.FillColor)
.FillEllipse(sb, rect)
End Using
Else
Using pn As New Pen(Me.ShapeColor, Me.PenWidth)
.DrawEllipse(pn, rect)
End Using
End If
Case ShapeTypes.Rectangle
If Filled Then
Using pn As New Pen(Me.ShapeColor, Me.PenWidth)
.DrawRectangle(pn, rect)
End Using
Using sb As New SolidBrush(Me.FillColor)
.FillRectangle(sb, rect)
End Using
Else
Using pn As New Pen(Me.ShapeColor, Me.PenWidth)
.DrawRectangle(pn, rect)
End Using
End If
Case ShapeTypes.Line
Using pn As New Pen(Me.ShapeColor, Me.PenWidth)
pn.StartCap = Drawing2D.LineCap.Round
pn.EndCap = Drawing2D.LineCap.Round
.DrawLine(pn, Me.StartPoint.X, Me.StartPoint.Y, Me.EndPoint.X, Me.EndPoint.Y)
End Using
Case ShapeTypes.FreeHand
Using pn As New Pen(Me.ShapeColor, Me.PenWidth)
pn.StartCap = Drawing2D.LineCap.Round
pn.EndCap = Drawing2D.LineCap.Round
.DrawLines(pn, Me.Points.ToArray)
End Using
End Select
End With
End Sub
End Class
Thanks in advance for any given help.
Continue reading...