⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.vb

📁 .net语言下开发的白板应用程序
💻 VB
📖 第 1 页 / 共 2 页
字号:
        rect.Offset(20, 0)
        lbrush = New LinearGradientBrush(rect, Color.FromArgb(255, 255, 0, 0), Color.FromArgb(0, 0, 0, 0), LinearGradientMode.Horizontal)
        g.FillRectangle(lbrush, rect)

        rect.Offset(10, 0)
        lbrush = New LinearGradientBrush(rect, Color.FromArgb(0, 0, 0, 0), Color.FromArgb(255, 255, 255, 255), LinearGradientMode.Horizontal)
        g.FillRectangle(lbrush, rect)
        PaletteBox.Image = bmp
    End Sub

#Region "Drawing Routines"
    Sub DrawPath(ByVal e) 'path
        EndX = e.x
        EndY = e.y

        pbox.Refresh()
        pbox.CreateGraphics.DrawLine(nPen, StartX, StartY, EndX, EndY)
    End Sub

    Sub DrawBrush(ByVal e) 'brush
        mpath.AddLine(e.X, e.Y, e.X, e.Y)
        pbox.CreateGraphics.DrawPath(nPen, mpath)
    End Sub

    Sub DrawLine(ByVal e) 'line
        EndX = e.x
        EndY = e.y
        pbox.Refresh()
        pbox.CreateGraphics.DrawLine(nPen, StartX, StartY, EndX, EndY)
    End Sub

    Sub DrawRectangle(ByVal e As System.Windows.Forms.MouseEventArgs) 'rectangle
        xLoc = 0
        yLoc = 0

        If e.X > StartX Then
            BoxWidth = e.X - StartX
            xLoc = StartX
        Else
            BoxWidth = StartX - e.X
            xLoc = e.X
        End If

        If e.Y > StartY Then
            BoxHeight = e.Y - StartY
            yLoc = StartY
        Else
            BoxHeight = StartY - e.Y
            yLoc = e.Y
        End If

        pbox.Refresh()
        Select Case DrawStyles
            Case dStyles.Filled
                pbox.CreateGraphics.FillRectangle(New SolidBrush(clr2), xLoc, yLoc, BoxWidth, BoxHeight)
            Case dStyles.Outline
                pbox.CreateGraphics.DrawRectangle(nPen, xLoc, yLoc, BoxWidth, BoxHeight)
            Case dStyles.OutlineFilled
                pbox.CreateGraphics.FillRectangle(New SolidBrush(clr2), xLoc, yLoc, BoxWidth, BoxHeight)
                pbox.CreateGraphics.DrawRectangle(nPen, xLoc, yLoc, BoxWidth, BoxHeight)
        End Select

    End Sub

    Sub DrawEllipse(ByVal e As System.Windows.Forms.MouseEventArgs) 'ellipse
        xLoc = 0
        yLoc = 0

        If e.X > StartX Then
            BoxWidth = e.X - StartX
            xLoc = StartX
        Else
            BoxWidth = StartX - e.X
            xLoc = e.X
        End If

        If e.Y > StartY Then
            BoxHeight = e.Y - StartY
            yLoc = StartY
        Else
            BoxHeight = StartY - e.Y
            yLoc = e.Y
        End If

        pbox.Refresh()
        Select Case DrawStyles
            Case dStyles.Filled
                pbox.CreateGraphics.FillEllipse(New SolidBrush(clr2), xLoc, yLoc, BoxWidth, BoxHeight)
            Case dStyles.Outline
                pbox.CreateGraphics.DrawEllipse(nPen, xLoc, yLoc, BoxWidth, BoxHeight)
            Case dStyles.OutlineFilled
                pbox.CreateGraphics.FillEllipse(New SolidBrush(clr2), xLoc, yLoc, BoxWidth, BoxHeight)
                pbox.CreateGraphics.DrawEllipse(nPen, xLoc, yLoc, BoxWidth, BoxHeight)
        End Select

    End Sub

    Sub Eraser(ByVal e As System.Windows.Forms.MouseEventArgs) 'eraser
        pbox.Refresh()
        pbox.CreateGraphics.FillRectangle(Brushes.White, e.X - 1, e.Y, penWidth, penWidth)
        pbox.CreateGraphics.DrawRectangle(Pens.Black, e.X - 1, e.Y, penWidth, penWidth)
    End Sub
#End Region

#Region "Events"

    'picks forecolor and backcolor
    Private Sub PaletteBox_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PaletteBox.MouseUp
        On Error Resume Next
        'on left click sets forecolor, on right click sets backcolor
        If e.Button = MouseButtons.Left Then
            clr = Color.FromArgb(bmp.GetPixel(e.X, e.Y).ToArgb)
        Else
            clr2 = Color.FromArgb(bmp.GetPixel(e.X, e.Y).ToArgb)
        End If
        Dim rc As New Rectangle(PaletteBox.Left + PaletteBox.Width + 3, PaletteBox.Top + 3, 40, 16)
        Me.Invalidate(rc)
        nPen = New Pen(clr)
        nPen.Width = penWidth
        If dModes.Text Then
            pbox.Refresh()
            pbox.CreateGraphics.DrawString(txt, Me.Font, New SolidBrush(clr), pF.X, pF.Y)

        End If
    End Sub

    Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint
        e.Graphics.FillRectangle(Brushes.White, PaletteBox.Left - 2, PaletteBox.Top - 1, PaletteBox.Width + 45, PaletteBox.Height + 2)
        e.Graphics.DrawRectangle(New Pen(Color.FromArgb(153, 204, 255)), PaletteBox.Left - 2, PaletteBox.Top - 1, PaletteBox.Width + 46, PaletteBox.Height + 2)

        e.Graphics.FillRectangle(New SolidBrush(clr), PaletteBox.Left + PaletteBox.Width + 4, PaletteBox.Top + 4, 15, 15)
        e.Graphics.DrawRectangle(New Pen(Color.FromArgb(153, 204, 255)), PaletteBox.Left + PaletteBox.Width + 2, PaletteBox.Top + 2, 18, 18)
        e.Graphics.FillRectangle(New SolidBrush(clr2), PaletteBox.Left + PaletteBox.Width + 25, PaletteBox.Top + 4, 15, 15)
        e.Graphics.DrawRectangle(New Pen(Color.FromArgb(153, 204, 255)), PaletteBox.Left + PaletteBox.Width + 23, PaletteBox.Top + 2, 18, 18)

    End Sub

    Private Sub Form5_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        CreatePalette()

        'set the picturebox
        pbox.Font = New Font("Arial", 13)
        pbox.Left = 64
        pbox.Top = 0
        pbox.Width = 432
        pbox.Height = 303
        pbox.BackColor = Color.White
        Controls.Add(pbox)
        bmp2 = New Bitmap(pbox.Width, pbox.Height)
        g2 = Graphics.FromImage(bmp2)
        g2.SmoothingMode = SmoothingMode.AntiAlias
    End Sub

    'Starts the virtual drawing
    Private Sub pbox_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pbox.MouseDown
        If e.Button = MouseButtons.Left Then
            isDraw = True
            StartX = e.X
            StartY = e.Y

            If dmode = dModes.Text Then 'if text mode is selected it creates a caret on the clicked position 

                pF = New PointF(e.X, e.Y - fontheight / 2)
                If pF.Equals(pFOld) Then
                Else
                    allow = True
                End If
                pbox.Focus()

                CreateCaret(pbox.Handle.ToInt32, 0, 2, Me.FontHeight)
                SetCaretPos(pF.X, pF.Y)
                ShowCaret(pbox.Handle.ToInt32)
            End If

        End If
    End Sub

    'Virtual Drawing
    Private Sub pbox_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pbox.MouseMove
        Label2.Text = e.X & ":" & e.Y
        If isDraw Then
            Select Case dmode
                Case dModes.Ellipse
                    DrawEllipse(e)
                Case dModes.Line
                    DrawLine(e)
                Case dModes.Brush
                    DrawBrush(e)
                Case dModes.Rectangle
                    DrawRectangle(e)
                Case dModes.Path
                    DrawPath(e)
                Case dModes.Eraser
                    Eraser(e)
                    g2.FillRectangle(Brushes.White, e.X, e.Y, pWidth, pWidth)
            End Select
        End If
    End Sub

    'Here is where the actual drawing happens
    Private Sub pbox_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles pbox.MouseUp
        isDraw = False

        Select Case dmode
            Case dModes.Ellipse
                Select Case DrawStyles
                    Case dStyles.Filled
                        g2.FillEllipse(New SolidBrush(clr2), xLoc, yLoc, BoxWidth, BoxHeight)
                    Case dStyles.Outline
                        g2.DrawEllipse(nPen, xLoc, yLoc, BoxWidth, BoxHeight)
                    Case dStyles.OutlineFilled
                        g2.FillEllipse(New SolidBrush(clr2), xLoc, yLoc, BoxWidth, BoxHeight)
                        g2.DrawEllipse(nPen, xLoc, yLoc, BoxWidth, BoxHeight)
                End Select
            Case dModes.Line
                g2.DrawLine(nPen, StartX, StartY, EndX, EndY)
            Case dModes.Brush
                g2.DrawPath(nPen, mpath)
                mpath.Reset()
            Case dModes.Rectangle
                Select Case DrawStyles
                    Case dStyles.Filled
                        g2.FillRectangle(New SolidBrush(clr2), xLoc, yLoc, BoxWidth, BoxHeight)
                    Case dStyles.Outline
                        g2.DrawRectangle(nPen, xLoc, yLoc, BoxWidth, BoxHeight)
                    Case dStyles.OutlineFilled
                        g2.FillRectangle(New SolidBrush(clr2), xLoc, yLoc, BoxWidth, BoxHeight)
                        g2.DrawRectangle(nPen, xLoc, yLoc, BoxWidth, BoxHeight)
                End Select
            Case dModes.Path
                mpath.AddLine(StartX, StartY, e.X, e.Y)
                g2.DrawPath(nPen, mpath)
                'mpath.Reset()
            Case dModes.Text
                If allow Then g2.DrawString(txt, Me.Font, New SolidBrush(clr), pFOld)
                allow = False
                txt = ""
                'tbox.Clear()
        End Select

        pbox.Image = bmp2
    End Sub

    'if in text mode, writes text on the bitmap and moves the caret
    Private Sub pbox_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles pbox.KeyPress
        txt += e.KeyChar
        Me.Refresh()
        On Error Resume Next
        If e.KeyChar = Chr(8) Then 'backspace
            txt = txt.Substring(0, txt.Length - 2)
            e.Handled = True
        End If
        g2.PageUnit = GraphicsUnit.Pixel
        SetCaretPos(pF.X + g2.MeasureString(txt, New Font("arial", 8)).Width, pF.Y)
        pbox.CreateGraphics.DrawString(txt, Me.Font, New SolidBrush(clr), pF.X, pF.Y)
        pFOld = pF
    End Sub
#End Region


    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        dmode = dModes.Ellipse
        mpath.Reset()
        hide_Caret()
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        dmode = dModes.Line
        mpath.Reset()
        hide_Caret()
    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        dmode = dModes.Brush
        mpath.Reset()
        hide_Caret()
    End Sub

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
        dmode = dModes.Rectangle
        mpath.Reset()
        hide_Caret()
    End Sub

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
        dmode = dModes.Path
        hide_Caret()
    End Sub

    Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click
        dmode = dModes.Eraser
        hide_Caret()
    End Sub


    Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click
        dmode = dModes.Text
        mpath.Reset()

    End Sub


#Region "Cursors"
    'Sets the appropriate cursor
    Private Sub PictureBox1_MouseEnter(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles pbox.MouseEnter
        Select Case dmode
            Case dModes.Ellipse
                pbox.Cursor = Cursors.Cross
            Case dModes.Line
                pbox.Cursor = Cursors.Cross
            Case dModes.Brush
                pbox.Cursor = Cursors.Cross
            Case dModes.Rectangle
                pbox.Cursor = Cursors.Cross
            Case dModes.Path
                pbox.Cursor = Cursors.Cross
            Case dModes.Eraser
                pbox.Cursor = er
            Case dModes.Text
                pbox.Cursor = Cursors.IBeam
            Case Else
                pbox.Cursor = Cursors.Default
        End Select
    End Sub

    Private Sub PictureBox1_MouseLeave(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles pbox.MouseLeave
        pbox.Cursor = Cursors.Default
    End Sub


    Private Sub PaletteBox_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles PaletteBox.MouseEnter
        PaletteBox.Cursor = c
    End Sub
#End Region

    Function GetEmbeddedFile(ByVal strname As String) As System.IO.Stream
        Return System.Reflection.Assembly.GetExecutingAssembly.GetManifestResourceStream(strname)
    End Function


#Region "Brush Width" 'sets the brush width
    Private Sub TrackBar1_Scroll(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TrackBar1.Scroll
        TextBox2.Text = TrackBar1.Value
    End Sub

    Private Sub TextBox2_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox2.TextChanged
        penWidth = CInt(TextBox2.Text)
        TrackBar1.Value = penWidth
    End Sub
#End Region


#Region "Drawing Styles" 'Filled, Outlines only or Filled with Outlines
    Private Sub Panel1_Click1(ByVal sender As Object, ByVal e As System.EventArgs) Handles Panel1.Click
        DrawStyles = dStyles.Outline
        GroupBox1.Refresh()
        GroupBox1.CreateGraphics.DrawRectangle(Pens.Blue, Panel1.Left - 4, Panel1.Top - 4, Panel1.Width + 7, Panel1.Height + 7)
    End Sub

    Private Sub Panel2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Panel2.Click
        DrawStyles = dStyles.OutlineFilled
        GroupBox1.Refresh()
        GroupBox1.CreateGraphics.DrawRectangle(Pens.Blue, Panel2.Left - 4, Panel2.Top - 4, Panel2.Width + 7, Panel2.Height + 7)
    End Sub

    Private Sub Panel3_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Panel3.Click
        DrawStyles = dStyles.Filled
        GroupBox1.Refresh()
        GroupBox1.CreateGraphics.DrawRectangle(Pens.Blue, Panel3.Left - 4, Panel3.Top - 4, Panel3.Width + 7, Panel3.Height + 7)
    End Sub
#End Region

    Function hide_Caret() 'hides the caret
        If txt <> "" Then g2.DrawString(txt, Me.Font, New SolidBrush(clr), pFOld)
        pbox.Image = bmp2
        allow = False
        HideCaret(pbox.Handle.ToInt32)
        txt = ""
    End Function
End Class

⌨️ 快捷键说明

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