drawing.vb

来自「Samples are organized by chapter, and th」· VB 代码 · 共 221 行

VB
221
字号
Public Class Drawing
    Inherits System.Windows.Forms.Form

#Region " Windows Form Designer generated code "

    Public Sub New()
        MyBase.New()

        'This call is required by the Windows Form Designer.
        InitializeComponent()

        'Add any initialization after the InitializeComponent() call

    End Sub

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    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.
    Friend WithEvents mnuForm As System.Windows.Forms.ContextMenu
    Friend WithEvents mnuLabel As System.Windows.Forms.ContextMenu
    Friend WithEvents mnuColorChange As System.Windows.Forms.MenuItem
    Friend WithEvents mnuRectangle As System.Windows.Forms.MenuItem
    Friend WithEvents mnuEllipse As System.Windows.Forms.MenuItem
    Friend WithEvents mnuTriangle As System.Windows.Forms.MenuItem
    Friend WithEvents mnuRemoveShape As System.Windows.Forms.MenuItem
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.mnuForm = New System.Windows.Forms.ContextMenu()
        Me.mnuRectangle = New System.Windows.Forms.MenuItem()
        Me.mnuEllipse = New System.Windows.Forms.MenuItem()
        Me.mnuTriangle = New System.Windows.Forms.MenuItem()
        Me.mnuLabel = New System.Windows.Forms.ContextMenu()
        Me.mnuColorChange = New System.Windows.Forms.MenuItem()
        Me.mnuRemoveShape = New System.Windows.Forms.MenuItem()
        '
        'mnuForm
        '
        Me.mnuForm.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuRectangle, Me.mnuEllipse, Me.mnuTriangle})
        '
        'mnuRectangle
        '
        Me.mnuRectangle.Index = 0
        Me.mnuRectangle.Text = "Create New Rectangle"
        '
        'mnuEllipse
        '
        Me.mnuEllipse.Index = 1
        Me.mnuEllipse.Text = "Create New Ellipse"
        '
        'mnuTriangle
        '
        Me.mnuTriangle.Index = 2
        Me.mnuTriangle.Text = "Create New Triangle"
        '
        'mnuLabel
        '
        Me.mnuLabel.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.mnuColorChange, Me.mnuRemoveShape})
        '
        'mnuColorChange
        '
        Me.mnuColorChange.Index = 0
        Me.mnuColorChange.Text = "Change Color"
        '
        'mnuRemoveShape
        '
        Me.mnuRemoveShape.Index = 1
        Me.mnuRemoveShape.Text = "Remove Shape"
        '
        'Drawing
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(452, 330)
        Me.ContextMenu = Me.mnuForm
        Me.Name = "Drawing"
        Me.Text = "Drawing"

    End Sub

#End Region


    ' Keep track of when fake drag or resize mode is enabled.
    Private IsDragging As Boolean = False
    Private IsResizing As Boolean = False

    ' Store the location where the user clicked on the control.
    Private ClickOffsetX, ClickOffsetY As Integer

    Private Sub lbl_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs)

        ' Retrieve a reference to the active label.
        Dim CurrentCtrl As Control
        CurrentCtrl = CType(sender, Control)

        If e.Button = MouseButtons.Right Then
            ' Show the context menu.
            CurrentCtrl.ContextMenu.Show(CurrentCtrl, New Point(e.X, e.Y))

        ElseIf e.Button = MouseButtons.Left Then
            If (e.X + 5) > CurrentCtrl.Width Or (e.Y + 5) > CurrentCtrl.Height Then
                ' Resizing mode is appropriate.
                IsResizing = True
            Else
                ' The mouse is somewhere else, so dragging mode is
                ' appropriate.
                IsDragging = True
                ClickOffsetX = e.X
                ClickOffsetY = e.Y
            End If
        End If

    End Sub

    Private Sub lbl_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs)
        IsDragging = False
        IsResizing = False
    End Sub

    Private Sub lbl_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)

        ' Retrieve a reference to the active shape.
        Dim CurrentCtrl As Control
        CurrentCtrl = CType(sender, Control)

        If IsDragging = True Then
            ' Move the control.
            CurrentCtrl.Left = e.X + CurrentCtrl.Left - ClickOffsetX
            CurrentCtrl.Top = e.Y + CurrentCtrl.Top - ClickOffsetY

        ElseIf IsResizing = True Then
            ' Resize the control, according to the resize mode.
            If CurrentCtrl.Cursor Is Cursors.SizeNWSE Then
                CurrentCtrl.Width = e.X
                CurrentCtrl.Height = e.Y
            ElseIf CurrentCtrl.Cursor Is Cursors.SizeNS Then
                CurrentCtrl.Height = e.Y
            ElseIf CurrentCtrl.Cursor Is Cursors.SizeWE Then
                CurrentCtrl.Width = e.X
            End If

        Else
            If (e.X + 5) > CurrentCtrl.Width And (e.Y + 5) > CurrentCtrl.Height Then
                CurrentCtrl.Cursor = Cursors.SizeNWSE
            ElseIf (e.X + 5) > CurrentCtrl.Width Then
                CurrentCtrl.Cursor = Cursors.SizeWE
            ElseIf (e.Y + 5) > CurrentCtrl.Height Then
                CurrentCtrl.Cursor = Cursors.SizeNS
            Else
                CurrentCtrl.Cursor = Cursors.Arrow
            End If
        End If
    End Sub

    Private Sub Drawing_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
        If e.Button = MouseButtons.Right Then
            Me.ContextMenu.Show(Me, New Point(e.X, e.Y))
        End If
    End Sub

    Private Sub mnuNewShape_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuRectangle.Click, mnuEllipse.Click, mnuTriangle.Click

        ' Create and configure the "square".
        Dim NewShape As New Shape()
        NewShape.Size = New Size(40, 40)
        NewShape.ForeColor = Color.Coral

        ' Configure the appropriate shape.
        If sender Is mnuRectangle Then
            NewShape.Shape = Shape.ShapeType.Rectangle
        ElseIf sender Is mnuEllipse Then
            NewShape.Shape = Shape.ShapeType.Ellipse
        ElseIf sender Is mnuTriangle Then
            NewShape.Shape = Shape.ShapeType.Triangle
        End If

        ' To determine where to place the shape, you need to convert the 
        ' current screen-based mouse coordinates into relative form coordinates.
        NewShape.Location = Me.PointToClient(Me.MousePosition)

        ' Attach a context menu to the shape.
        NewShape.ContextMenu = mnuLabel

        ' Connect the shape to all its event handlers.
        AddHandler NewShape.MouseDown, AddressOf lbl_MouseDown
        AddHandler NewShape.MouseMove, AddressOf lbl_MouseMove
        AddHandler NewShape.MouseUp, AddressOf lbl_MouseUp

        ' Add the shape to the form.
        Me.Controls.Add(NewShape)

    End Sub

    Private Sub mnuColorChange_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuColorChange.Click
        ' Show color dialog.
        Dim dlgColor As New ColorDialog()
        dlgColor.ShowDialog()

        ' Change shape background.
        mnuLabel.SourceControl.BackColor = dlgColor.Color
    End Sub

    Private Sub mnuShape_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles mnuRemoveShape.Click
        Dim ctrlShape As Shape
        ctrlShape = CType(mnuLabel.SourceControl, Shape)

        Me.Controls.Remove(ctrlShape)
    End Sub
End Class

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?