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

📄 gradientfill.vb

📁 Windows mobile 图形编程例子
💻 VB
字号:
' Extends the standard button control and performs
' custom drawing with a GradientFill background.

Public Class GradientFilledButton
    Inherits Control
    Private components As System.ComponentModel.IContainer = Nothing

    Public Sub New()
        components = New System.ComponentModel.Container()
        Me.Font = New Font(Me.Font.Name, Me.Font.Size, FontStyle.Bold)
    End Sub

    ' Controls the direction in which the button is filled.
    Public Property FillDirection() As GradientFill.FillDirection
        Get
            Return fillDirectionValue
        End Get
        Set(ByVal value As GradientFill.FillDirection)
            fillDirectionValue = value
            Invalidate()
        End Set
    End Property
    Private fillDirectionValue As GradientFill.FillDirection

    ' The start color for the GradientFill. This is the color
    ' at the left or top of the control depeneding on the value
    ' of the FillDirection property.
    Public Property StartColor() As Color
        Get
            Return startColorValue
        End Get
        Set(ByVal value As Color)
            startColorValue = value
            Invalidate()
        End Set
    End Property
    Private startColorValue As Color = Color.Red

    ' The end color for the GradientFill. This is the color
    ' at the right or bottom of the control depending on the value
    ' of the FillDirection property
    Public Property EndColor() As Color
        Get
            Return endColorValue
        End Get
        Set(ByVal value As Color)
            endColorValue = value
            Invalidate()
        End Set
    End Property
    Private endColorValue As Color = Color.Blue

    ' This is the offset from the left or top edge
    '  of the button to start the gradient fill.
    Public Property StartOffset() As Integer
        Get
            Return startOffsetValue
        End Get
        Set(ByVal value As Integer)
            startOffsetValue = value
            Invalidate()
        End Set
    End Property
    Private startOffsetValue As Integer

    ' This is the offset from the right or bottom edge
    '  of the button to end the gradient fill.
    Public Property EndOffset() As Integer
        Get
            Return endOffsetValue
        End Get
        Set(ByVal value As Integer)
            endOffsetValue = value
            Invalidate()
        End Set
    End Property
    Private endOffsetValue As Integer

    ' Used to double-buffer our drawing to avoid flicker
    ' between painting the background, border, focus-rect
    ' and the text of the control.
    Private Property DoubleBufferImage() As Bitmap
        Get
            If bmDoubleBuffer Is Nothing Then
                bmDoubleBuffer = New Bitmap(Me.ClientSize.Width, Me.ClientSize.Height)
            End If
            Return bmDoubleBuffer
        End Get
        Set(ByVal value As Bitmap)
            If bmDoubleBuffer IsNot Nothing Then
                bmDoubleBuffer.Dispose()
            End If
            bmDoubleBuffer = value
        End Set
    End Property
    Private bmDoubleBuffer As Bitmap

    ' Called when the control is resized. When that happens,
    ' recreate the bitmap used for double-buffering.
    Protected Overloads Overrides Sub OnResize(ByVal e As EventArgs)
        DoubleBufferImage = New Bitmap(Me.ClientSize.Width, Me.ClientSize.Height)
        MyBase.OnResize(e)
    End Sub

    ' Called when the control gets focus. Need to repaint
    ' the control to ensure the focus rectangle is drawn correctly.
    Protected Overloads Overrides Sub OnGotFocus(ByVal e As EventArgs)
        MyBase.OnGotFocus(e)
        Me.Invalidate()
    End Sub
    '
    ' Called when the control loses focus. Need to repaint
    ' the control to ensure the focus rectangle is removed.
    Protected Overloads Overrides Sub OnLostFocus(ByVal e As EventArgs)
        MyBase.OnLostFocus(e)
        Me.Invalidate()
    End Sub

    Protected Overloads Overrides Sub OnMouseMove(ByVal e As MouseEventArgs)
        If Me.Capture Then
            Dim coord As New Point(e.X, e.Y)
            If Me.ClientRectangle.Contains(coord) <> Me.ClientRectangle.Contains(lastCursorCoordinates) Then
                DrawButton(Me.ClientRectangle.Contains(coord))
            End If
            lastCursorCoordinates = coord
        End If
        MyBase.OnMouseMove(e)
    End Sub

    ' The coordinates of the cursor the last time
    ' there was a MouseUp or MouseDown message.
    Private lastCursorCoordinates As Point

    Protected Overloads Overrides Sub OnMouseDown(ByVal e As MouseEventArgs)
        If e.Button = MouseButtons.Left Then
            ' Start capturing the mouse input
            Me.Capture = True
            ' Get the focus because button is clicked.
            Me.Focus()

            ' draw the button
            DrawButton(True)
        End If

        MyBase.OnMouseDown(e)
    End Sub

    Protected Overloads Overrides Sub OnMouseUp(ByVal e As MouseEventArgs)
        Me.Capture = False

        DrawButton(False)

        MyBase.OnMouseUp(e)
    End Sub

    Private bGotKeyDown As Boolean = False
    Protected Overloads Overrides Sub OnKeyDown(ByVal e As KeyEventArgs)
        bGotKeyDown = True
        Select Case e.KeyCode
            Case Keys.Space, Keys.Enter
                DrawButton(True)
                Exit Select
            Case Keys.Up, Keys.Left
                Me.Parent.SelectNextControl(Me, False, False, True, True)
                Exit Select
            Case Keys.Down, Keys.Right
                Me.Parent.SelectNextControl(Me, True, False, True, True)
                Exit Select
            Case Else
                bGotKeyDown = False
                MyBase.OnKeyDown(e)
                Exit Select
        End Select
    End Sub

    Protected Overloads Overrides Sub OnKeyUp(ByVal e As KeyEventArgs)
        Select Case e.KeyCode
            Case Keys.Space, Keys.Enter
                If bGotKeyDown Then
                    DrawButton(False)
                    OnClick(EventArgs.Empty)
                    bGotKeyDown = False
                End If
                Exit Select
            Case Else
                MyBase.OnKeyUp(e)
                Exit Select
        End Select
    End Sub

    ' Override this method with no code to avoid flicker.
    Protected Overloads Overrides Sub OnPaintBackground(ByVal e As PaintEventArgs)
    End Sub
    Protected Overloads Overrides Sub OnPaint(ByVal e As PaintEventArgs)
        DrawButton(e.Graphics, Me.Capture AndAlso (Me.ClientRectangle.Contains(lastCursorCoordinates)))
    End Sub

    '
    ' Gets a Graphics object for the provided window handle
    '  and then calls DrawButton(Graphics, bool).
    '
    ' If pressed is true, the button is drawn
    ' in the depressed state.
    Private Sub DrawButton(ByVal pressed As Boolean)
        Dim gr As Graphics = Me.CreateGraphics()
        DrawButton(gr, pressed)
        gr.Dispose()
    End Sub

    ' Draws the button on the specified Grapics
    ' in the specified state.
    '
    ' Parameters:
    '  gr - The Graphics object on which to draw the button.
    '  pressed - If true, the button is drawn in the depressed state.
    Private Sub DrawButton(ByVal gr As Graphics, ByVal pressed As Boolean)
        ' Get a Graphics object from the background image.
        Dim gr2 As Graphics = Graphics.FromImage(DoubleBufferImage)

        ' Fill solid up until where the gradient fill starts.
        If startOffsetValue > 0 Then
            If fillDirectionValue = GradientFill.FillDirection.LeftToRight Then
                gr2.FillRectangle(New SolidBrush(IIf(pressed, EndColor, StartColor)), 0, 0, startOffsetValue, Height)
            Else
                gr2.FillRectangle(New SolidBrush(IIf(pressed, EndColor, StartColor)), 0, 0, Width, startOffsetValue)
            End If
        End If

        ' Draw the gradient fill.
        Dim rc As Rectangle = Me.ClientRectangle
        If fillDirectionValue = GradientFill.FillDirection.LeftToRight Then
            rc.X = startOffsetValue
            rc.Width = rc.Width - startOffsetValue - endOffsetValue
        Else
            rc.Y = startOffsetValue
            rc.Height = rc.Height - startOffsetValue - endOffsetValue
        End If
        GradientFill.Fill(gr2, rc, IIf(pressed, endColorValue, startColorValue), IIf(pressed, startColorValue, endColorValue), fillDirectionValue)

        ' Fill solid from the end of the gradient fill
        ' to the edge of the button.
        If endOffsetValue > 0 Then
            If fillDirectionValue = GradientFill.FillDirection.LeftToRight Then
                gr2.FillRectangle(New SolidBrush(IIf(pressed, StartColor, EndColor)), rc.X + rc.Width, 0, endOffsetValue, Height)
            Else
                gr2.FillRectangle(New SolidBrush(IIf(pressed, StartColor, EndColor)), 0, rc.Y + rc.Height, Width, endOffsetValue)
            End If
        End If

        ' Draw the text.
        Dim sf As New StringFormat()
        sf.Alignment = StringAlignment.Center
        sf.LineAlignment = StringAlignment.Center
        gr2.DrawString(Me.Text, Me.Font, New SolidBrush(Me.ForeColor), Me.ClientRectangle, sf)

        ' Draw the border.
        ' Need to shrink the width and height by 1 otherwise
        ' there will be no border on the right or bottom.
        rc = Me.ClientRectangle
        rc.Width -= 1
        rc.Height -= 1
        Dim pen As New Pen(SystemColors.WindowFrame)

        gr2.DrawRectangle(pen, rc)

        ' Draw from the background image onto the screen.
        gr.DrawImage(DoubleBufferImage, 0, 0)
        gr2.Dispose()
    End Sub

    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing AndAlso (components IsNot Nothing) Then
            components.Dispose()
        End If
        MyBase.Dispose(disposing)
    End Sub

End Class

Public NotInheritable Class GradientFill
    ' This method wraps the PInvoke to GradientFill.
    ' Parmeters:
    '  gr - The Graphics object we are filling
    '  rc - The rectangle to fill
    '  startColor - The starting color for the fill
    '  endColor - The ending color for the fill
    '  fillDir - The direction to fill
    '
    ' Returns true if the call to GradientFill succeeded; false
    ' otherwise.
    Public Shared Function Fill(ByVal gr As Graphics, ByVal rc As Rectangle, ByVal startColor As Color, ByVal endColor As Color, ByVal fillDir As FillDirection) As Boolean

        ' Initialize the data to be used in the call to GradientFill.
        Dim tva As Win32Helper.TRIVERTEX() = New Win32Helper.TRIVERTEX(1) {}
        tva(0) = New Win32Helper.TRIVERTEX(rc.X, rc.Y, startColor)
        tva(1) = New Win32Helper.TRIVERTEX(rc.Right, rc.Bottom, endColor)
        Dim gra As Win32Helper.GRADIENT_RECT() = New Win32Helper.GRADIENT_RECT() {New Win32Helper.GRADIENT_RECT(0, 1)}

        ' Get the hDC from the Graphics object.
        Dim hdc As IntPtr = gr.GetHdc()

        ' PInvoke to GradientFill.
        Dim b As Boolean

        b = Win32Helper.GradientFill(hdc, tva, CInt(tva.Length), gra, CInt(gra.Length), CInt(fillDir))
        System.Diagnostics.Debug.Assert(b, String.Format("GradientFill failed: {0}", System.Runtime.InteropServices.Marshal.GetLastWin32Error()))

        ' Release the hDC from the Graphics object.
        gr.ReleaseHdc(hdc)

        Return b
    End Function

    ' The direction to the GradientFill will follow
    Public Enum FillDirection
        '
        ' The fill goes horizontally
        '
        LeftToRight = Win32Helper.GRADIENT_FILL_RECT_H
        '
        ' The fill goes vertically
        '
        TopToBottom = Win32Helper.GRADIENT_FILL_RECT_V
    End Enum
End Class

⌨️ 快捷键说明

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