自定义控件绘制内存不足异常?

时间:2017-11-07 06:40:42

标签: vb.net user-interface graphics

我正在学习如何绘制自定义控件并将一些代码放在一起,但得到的是#34;内存不足"调整控件大小时出现异常。虽然我在每次抽奖后丢弃了我的画笔和铅笔,但我仍然得到这个例外。有人可以告诉我我做错了什么吗?我似乎无法解决这个问题。

这是我的代码:

Imports System.Drawing.Drawing2D


Public Class Draw_Sub

Inherits Windows.Forms.Panel

Public Sub New()

    Me.DoubleBuffered = True
    Me.Width = 30
    Me.Height = 500

End Sub

Private Sub Draw_Sub_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint

    Cntrls_Draw(0, 0, Me.Width, Me.Height, 3, e)
    Cntrls_Draw(0, 100, Me.Width, Me.Width, 3, e)

End Sub

Public Sub Cntrls_Draw(ByVal X_pos As Integer,
                       ByVal Y_pos As Integer,
                       ByVal Wdth As Integer,
                       ByVal Hght As Integer,
                       ByVal Bev_Hght As Integer,
                       ByVal e As PaintEventArgs)

    Dim Width_bev = Bev_Hght * 2 / Wdth
    Dim Width_Scale = 1 - Width_bev
    Dim Height_bev = Bev_Hght * 2 / Hght
    Dim Height_Scale = 1 - Height_bev

    Dim Draw_pnts As Point() = {New Point(X_pos, Y_pos),
                                New Point(Wdth, Y_pos),
                                New Point(Wdth, Hght),
                                New Point(X_pos, Hght)}

    Dim pthGrBrush As New PathGradientBrush(Draw_pnts)

    Dim colors As Color() = {Color.FromArgb(50, 49, 65, 81),
                             Color.FromArgb(50, 0, 0, 0)}

    Dim relativePositions As Single() = {0.0F, 1.0F}
    pthGrBrush.FocusScales = New PointF(Width_Scale, Height_Scale)

    Dim colorBlend As New ColorBlend()
    colorBlend.Colors = colors
    colorBlend.Positions = relativePositions
    pthGrBrush.InterpolationColors = colorBlend

    e.Graphics.FillRectangle(pthGrBrush, 0, 0, Wdth, Hght)
    pthGrBrush.Dispose()

    'AO line rectangle to give a sharper look at the bottom sides
    Dim Rect As New Rectangle(Bev_Hght, Bev_Hght, Wdth - (Bev_Hght * 2), Hght - (Bev_Hght * 2))
    Dim My_Pen As New Pen(Color.FromArgb(25, 0, 0, 0), 3)

    e.Graphics.DrawRectangle(My_Pen, Rect)
    My_Pen.Dispose()

End Sub


End Class

1 个答案:

答案 0 :(得分:0)

感谢Andrew Morton,我的问题似乎是Double to Single转换。 改变这件作品后:

    Dim Width_bev = Bev_Hght * 2 / Wdth
    Dim Width_Scale = 1 - Width_bev
    Dim Height_bev = Bev_Hght * 2 / Hght
    Dim Height_Scale = 1 - Height_bev

对此:

    Dim Width_bev = CSng(Bev_Hght * 2 / Wdth)
    Dim Width_Scale = 1 - Width_bev
    Dim Height_bev = CSng(Bev_Hght * 2 / Hght)
    Dim Height_Scale = 1 - Height_bev

似乎已经解决了这个问题。