我的控件在编译和运行后运行良好，但在设计时IDE中，一切都运行得非常笨拙。我的意思是，假设工具箱在我的UI上打开，然后关闭，它将以每秒1帧的速度移动...或者，如果我尝试移动/调整窗体上的任何控件，它将会非常移动慢。
我能做些什么来加快这个速度？
Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D
Imports System.Drawing.Text
Namespace Classes
<ToolboxBitmap(GetType(Button))> Public Class MetroButton
Inherits Button
Private _color As Color = Color.FromArgb(255, 69, 129, 61)
Private _hover As Boolean = False
Private _mousedown As Boolean = False
Private _forceWhite As Boolean = True
Public Property ForceWhiteImage() As Boolean
Get
Return _forceWhite
End Get
Set(ByVal value As Boolean)
_forceWhite = value
Invalidate()
End Set
End Property
Public Property Color() As Color
Get
Return _color
End Get
Set(ByVal value As Color)
_color = value
Invalidate()
End Set
End Property
Protected Overrides Sub OnMouseEnter(ByVal eventargs As EventArgs)
MyBase.OnMouseEnter(eventargs)
_hover = True
Invalidate()
End Sub
Protected Overrides Sub OnMouseLeave(ByVal eventargs As EventArgs)
MyBase.OnMouseLeave(eventargs)
_hover = False
Invalidate()
End Sub
Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseDown(e)
If e.Button = Windows.Forms.MouseButtons.Left Then
_mousedown = True
Invalidate()
End If
End Sub
Protected Overrides Sub OnMouseUp(ByVal e As System.Windows.Forms.MouseEventArgs)
MyBase.OnMouseUp(e)
_mousedown = False
Invalidate()
End Sub
Private Shared Function ImageLocation(ByVal sf As StringFormat, ByVal Area As SizeF, ByVal ImageArea As SizeF) As PointF
Dim pt As PointF
Select Case sf.Alignment
Case StringAlignment.Center
pt.X = CSng((Area.Width - ImageArea.Width) / 2)
Case StringAlignment.Near
pt.X = 2
Case StringAlignment.Far
pt.X = Area.Width - ImageArea.Width - 2
End Select
Select Case sf.LineAlignment
Case StringAlignment.Center
pt.Y = CSng((Area.Height - ImageArea.Height) / 2)
Case StringAlignment.Near
pt.Y = 2
Case StringAlignment.Far
pt.Y = Area.Height - ImageArea.Height - 2
End Select
Return pt
End Function
Private Function GetStringFormat(ByVal ctrlalign As ContentAlignment) As StringFormat
Dim strFormat As StringFormat = New StringFormat()
Select Case ctrlalign
Case ContentAlignment.MiddleCenter
strFormat.LineAlignment = StringAlignment.Center
strFormat.Alignment = StringAlignment.Center
Case ContentAlignment.MiddleLeft
strFormat.LineAlignment = StringAlignment.Center
strFormat.Alignment = StringAlignment.Near
Case ContentAlignment.MiddleRight
strFormat.LineAlignment = StringAlignment.Center
strFormat.Alignment = StringAlignment.Far
Case ContentAlignment.TopCenter
strFormat.LineAlignment = StringAlignment.Near
strFormat.Alignment = StringAlignment.Center
Case ContentAlignment.TopLeft
strFormat.LineAlignment = StringAlignment.Near
strFormat.Alignment = StringAlignment.Near
Case ContentAlignment.TopRight
strFormat.LineAlignment = StringAlignment.Near
strFormat.Alignment = StringAlignment.Far
Case ContentAlignment.BottomCenter
strFormat.LineAlignment = StringAlignment.Far
strFormat.Alignment = StringAlignment.Center
Case ContentAlignment.BottomLeft
strFormat.LineAlignment = StringAlignment.Far
strFormat.Alignment = StringAlignment.Near
Case ContentAlignment.BottomRight
strFormat.LineAlignment = StringAlignment.Far
strFormat.Alignment = StringAlignment.Far
End Select
strFormat.HotkeyPrefix = Drawing.Text.HotkeyPrefix.None
Return strFormat
End Function
Protected Overrides Sub OnResize(ByVal e As System.EventArgs)
'Color = Color.FromArgb(255, ClientRectangle.Width Mod 255, ClientRectangle.Width Mod 255, ClientRectangle.Width Mod 255)
MyBase.OnResize(e)
End Sub
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
If DesignMode Then
e.Graphics.CompositingQuality = CompositingQuality.Default
e.Graphics.InterpolationMode = InterpolationMode.Low
e.Graphics.SmoothingMode = SmoothingMode.HighSpeed
e.Graphics.TextRenderingHint = TextRenderingHint.SystemDefault
Else
e.Graphics.CompositingQuality = CompositingQuality.HighQuality
e.Graphics.InterpolationMode = InterpolationMode.High
e.Graphics.SmoothingMode = SmoothingMode.AntiAlias
e.Graphics.TextRenderingHint = TextRenderingHint.ClearTypeGridFit
End If
Using b As New SolidBrush(Color)
e.Graphics.FillRectangle(b, ClientRectangle)
End Using
If _mousedown Then
Using b As New SolidBrush(Color.FromArgb(20, 0, 0, 0))
e.Graphics.FillRectangle(b, ClientRectangle)
End Using
Else
If _hover Then
Using b As New SolidBrush(Color.FromArgb(20, 255, 255, 255))
e.Graphics.FillRectangle(b, ClientRectangle)
End Using
End If
End If
' Position the imagery and text in the proper location
If Image IsNot Nothing Then
Dim imageSizeUse As Size
If Not Image Is Nothing Then
imageSizeUse = Image.Size
Else
imageSizeUse = New Size(0, 0)
End If
Dim textSize As SizeF = e.Graphics.MeasureString(Text, Font)
Dim textArea As Rectangle = AdjustRect(ClientRectangle, New Padding(0))
textArea.Width -= imageSizeUse.Width - 4
Dim imageArea As New RectangleF(textArea.X - imageSizeUse.Width, ClientRectangle.Y, imageSizeUse.Width, imageSizeUse.Height)
Dim imagept As PointF = ImageLocation(GetStringFormat(ImageAlign), ClientRectangle.Size, imageArea.Size)
Select Case GetStringFormat(TextAlign).Alignment
Case StringAlignment.Center
imagept.X = ClientRectangle.X + ((ClientRectangle.Width - textSize.Width - imageSizeUse.Width) / 2) - 16
textArea.X = ClientRectangle.X + imageSizeUse.Width
Case StringAlignment.Near
imagept.X = ClientRectangle.X + 4
textArea.X = ClientRectangle.X + imageSizeUse.Width + 4
Case StringAlignment.Far
imagept.X = ClientRectangle.X + textArea.Width - textSize.Width - 12
textArea.X = ClientRectangle.X + imageSizeUse.Width - 8
End Select
imagept.Y += ClientRectangle.Y
If _forceWhite Then
' Brightness should be -1 (black) to 0 (neutral) to 1 (white)
Dim colorMatrixVal As Single()() = { _
New Single() {1, 0, 0, 0, 0}, _
New Single() {0, 1, 0, 0, 0}, _
New Single() {0, 0, 1, 0, 0}, _
New Single() {0, 0, 0, 1, 0}, _
New Single() {1, 1, 1, 0, 1}}
Dim colorMatrix As New ColorMatrix(colorMatrixVal)
Dim ia As New ImageAttributes
ia.SetColorMatrix(colorMatrix, ColorMatrixFlag.Default, ColorAdjustType.Bitmap)
e.Graphics.DrawImage(Image, New Rectangle(imagept.X, imagept.Y, Image.Width, Image.Height), 0, 0, Image.Width, Image.Height, GraphicsUnit.Pixel, ia)
Else
e.Graphics.DrawImage(Image, imagept.X, imagept.Y, Image.Width, Image.Height)
End If
Using currFont As New Font("Verdana", 11)
e.Graphics.DrawString(Text, currFont, Brushes.White, textArea, GetStringFormat(TextAlign))
End Using
Else
Using currFont As New Font("Verdana", 11)
Using sf As New StringFormat()
sf.LineAlignment = StringAlignment.Center
sf.Alignment = StringAlignment.Center
e.Graphics.DrawString(Text, currFont, Brushes.White, ClientRectangle, sf)
End Using
End Using
End If
If Focused Then
Dim highlightRect As Rectangle = New Rectangle(1, 1, ClientRectangle.Width - 3, ClientRectangle.Height - 3)
Using highlightPen As Pen = New Pen(Drawing.Color.White)
highlightPen.Width = 1
highlightPen.DashStyle = Drawing2D.DashStyle.Dot
e.Graphics.DrawRectangle(highlightPen, highlightRect)
End Using
End If
GC.Collect()
End Sub
Private Shared Function AdjustRect(ByVal BaseRect As RectangleF, ByVal Pad As Padding) As RectangleF
BaseRect.Width -= Pad.Horizontal
BaseRect.Height -= Pad.Vertical
BaseRect.Offset(Pad.Left, Pad.Top)
Return BaseRect
End Function
Private Shared Function AdjustRect(ByVal BaseRect As Rectangle, ByVal Pad As Padding) As Rectangle
BaseRect.Width -= Pad.Horizontal
BaseRect.Height -= Pad.Vertical
BaseRect.Offset(Pad.Left, Pad.Top)
Return BaseRect
End Function
Public Sub New()
End Sub
End Class
End Namespace
答案 0 :(得分：2)
您应该从OnPaint方法中删除GC.Collect。 OnPaint可以经常被触发，并且触发垃圾收集可能会降低它的速度。
相反，请确保正确处理所有非托管资源，如画笔，笔等。这样你就不必手动触发垃圾收集。
如果您仍有问题，请尝试分析项目。使用Visual Studio的内置工具（如果您不使用Express版本），或使用日期等手动
Dim dStart as Date = Date.Now
PaintALLtheStuff()
Dim dEnd as date = Date.Now
Dim T1 as TimeSpan = DEnd - DStart
这不太舒服，但它通常可以正常工作。这是围绕经常被触发的事件的子部分进行的，并查看一直消耗的内容。
答案 1 :(得分：0)
显然，OnPaint方法因某种原因表现不佳。
尽量避免过多地调用GC.Collect()（删除该行，真正解决您的问题）。只要确保你妥善处理所有对象，让.NET处理剩下的事情。此外，保留本地图形对象更清晰。
Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
Dim graphics As System.Drawing.Graphics = e.Graphics
If DesignMode Then
graphics.CompositingQuality = CompositingQuality.Default
graphics.InterpolationMode = InterpolationMode.Low
graphics.SmoothingMode = SmoothingMode.HighSpeed
graphics.TextRenderingHint = TextRenderingHint.SystemDefault
Else
graphics.CompositingQuality = CompositingQuality.HighQuality
graphics.InterpolationMode = InterpolationMode.High
graphics.SmoothingMode = SmoothingMode.AntiAlias
graphics.TextRenderingHint = TextRenderingHint.ClearTypeGridFit
End If
Using b As New SolidBrush(Color)
graphics.FillRectangle(b, ClientRectangle)
End Using
If _mousedown Then
Using b As New SolidBrush(Color.FromArgb(20, 0, 0, 0))
graphics.FillRectangle(b, ClientRectangle)
End Using
ElseIf _hover Then
Using b As New SolidBrush(Color.FromArgb(20, 255, 255, 255))
graphics.FillRectangle(b, ClientRectangle)
End Using
End If
' Position the imagery and text in the proper location
If Image IsNot Nothing Then
Dim imageSizeUse As Size = Image.Size
Dim textSize As SizeF = e.Graphics.MeasureString(Text, Font)
Dim textArea As Rectangle = AdjustRect(ClientRectangle, New Padding(0))
textArea.Width -= imageSizeUse.Width - 4
Dim imageArea As New RectangleF(textArea.X - imageSizeUse.Width, ClientRectangle.Y, imageSizeUse.Width, imageSizeUse.Height)
Dim imagept As PointF = ImageLocation(GetStringFormat(ImageAlign), ClientRectangle.Size, imageArea.Size)
Select Case GetStringFormat(TextAlign).Alignment
Case StringAlignment.Center
imagept.X = ClientRectangle.X + ((ClientRectangle.Width - textSize.Width - imageSizeUse.Width) / 2) - 16
textArea.X = ClientRectangle.X + imageSizeUse.Width
Case StringAlignment.Near
imagept.X = ClientRectangle.X + 4
textArea.X = ClientRectangle.X + imageSizeUse.Width + 4
Case StringAlignment.Far
imagept.X = ClientRectangle.X + textArea.Width - textSize.Width - 12
textArea.X = ClientRectangle.X + imageSizeUse.Width - 8
End Select
imagept.Y += ClientRectangle.Y
If _forceWhite Then
' Brightness should be -1 (black) to 0 (neutral) to 1 (white)
Dim colorMatrixVal As Single()() = { _
New Single() {1, 0, 0, 0, 0}, _
New Single() {0, 1, 0, 0, 0}, _
New Single() {0, 0, 1, 0, 0}, _
New Single() {0, 0, 0, 1, 0}, _
New Single() {1, 1, 1, 0, 1}}
Dim colorMatrix As New ColorMatrix(colorMatrixVal)
Dim ia As New ImageAttributes
ia.SetColorMatrix(colorMatrix, ColorMatrixFlag.Default, ColorAdjustType.Bitmap)
graphics.DrawImage(Image, New Rectangle(CInt(imagept.X), CInt(imagept.Y), Image.Width, Image.Height), 0, 0, Image.Width, Image.Height, GraphicsUnit.Pixel, ia)
Else
graphics.DrawImage(Image, imagept.X, imagept.Y, Image.Width, Image.Height)
End If
Using currFont As New Font("Verdana", 11)
graphics.DrawString(Text, currFont, Brushes.White, textArea, GetStringFormat(TextAlign))
End Using
Else
Using currFont As New Font("Verdana", 11)
Using sf As New StringFormat()
sf.LineAlignment = StringAlignment.Center
sf.Alignment = StringAlignment.Center
graphics.DrawString(Text, currFont, Brushes.White, ClientRectangle, sf)
End Using
End Using
End If
If Focused Then
Dim highlightRect As Rectangle = New Rectangle(1, 1, ClientRectangle.Width - 3, ClientRectangle.Height - 3)
Using highlightPen As Pen = New Pen(Drawing.Color.White)
highlightPen.Width = 1
highlightPen.DashStyle = Drawing2D.DashStyle.Dot
graphics.DrawRectangle(highlightPen, highlightRect)
End Using
End If
' Let .NET handle the garbage collection
'GC.Collect()
End Sub
答案 2 :(得分：0)
子类化很可能是您最好的解决方案。看看这个网站......
你基本上需要做的是使用AssignHandle函数来控制你的控制然后“听”＆＃39;在WndProc函数中为该控件生成的Windows消息...有WM_PAINT消息，然后您可以捕获然后调用所有绘图代码....