波形チャートのレンダリング パフォーマンスを改善する方法をしばらく探していました。現在、私は(可能な限り)最適化されたGDIベースのレンダリングルーチンを使用しています:
Private Sub Calculate2(ByVal aData()() As Double)
'aData size: 1000 traces with 200k points each -> Dim aData(1000, 200000)
'Some data preparations doing roughly the same as they would in the real app
Dim PS_Y As Double = 1
Dim Origin As PointF = New PointF(Rnd() * 100, Rnd() * 100)
PS_Y = Rnd() + 0.1
Dim Data(), ST As Double
Dim lPoints As New List(Of PointF)
Dim PS_X As Double = Rnd() + 0.1
'Graphics initialisation
Dim Img As New Bitmap(900, 600)
Dim ImgGR As Graphics = Graphics.FromImage(Img)
ImgGR.Clear(Color.White)
Dim WFPen As New Pen(Brushes.Black, 1)
'Cache property values for faster access:
Dim l As Integer = 100 'ChartRect.Left
Dim r As Integer = 1000 'ChartRect.Right
'Process trace by trace:
For i = 0 To aData.Length - 1
ST = Rnd() 'x distance of the points
Data = aData(i) 'y values, 1 per x value
If Data.Length = 0 Then Continue For
'scale precalculations, first & last displayed points:
Dim ScaleX As Double = ST * PS_X
Dim OrigX As Single = Origin.X
Dim iStart As Integer = (l - OrigX) / ScaleX
Dim iEnd As Integer = (r - OrigX) / ScaleX
If iStart < 0 Then iStart = 0
If iEnd < 0 Then iEnd = 0
If iEnd > Data.Length - 1 Then iEnd = Data.Length - 1
If iStart > Data.Length - 1 Then iStart = Data.Length - 1
'Make sure that for benchmarking purposes all points are displayed, next 2 lines do not exist in real code:
iStart = 0
iEnd = Data.Length - 1
If iEnd < iStart Then Continue For
'point calculations using the pecalculated values:
Dim APT(iEnd - iStart) As PointF
For j = iStart To iEnd
APT(j - iStart) = Origin + New SizeF(j * ScaleX, -(Data(j) * PS_Y))
Next
ImgGR.DrawLines(WFPen, APT)
'Commenting out this line reduces the time needed for executing this whole routine from 42.4s to 4.76s
'Hence most of the time spent even with all the scaling is still in rendering the spline.
Next
私は Direct2D でアプローチを試みましたが、GDI の "DrawLines" メソッドよりもはるかに遅くなりました。
'Imports D2D = Microsoft.WindowsAPICodePack.DirectX.Direct2D1
'Imports DX = Microsoft.WindowsAPICodePack.DirectX
Dim TGT As D2D.RenderTarget
Private Sub initd2d()
Dim fac As D2D.D2DFactory = D2D.D2DFactory.CreateFactory(Microsoft.WindowsAPICodePack.DirectX.Direct2D1.D2DFactoryType.SingleThreaded)
Dim imgf As DX.WindowsImagingComponent.ImagingFactory
imgf = DX.WindowsImagingComponent.ImagingFactory.Create
'Dim pf As New D2D.PixelFormat(DX.Graphics.Format.B8G8R8A8UNorm, D2D.AlphaMode.Ignore)
Dim pf As New D2D.PixelFormat(DX.Graphics.Format.Unknown, D2D.AlphaMode.Unknown)
Dim bmp As DX.WindowsImagingComponent.ImagingBitmap
bmp = imgf.CreateImagingBitmap(CUInt(900), CUInt(600), DX.WindowsImagingComponent.PixelFormats.Pbgra32Bpp, DX.WindowsImagingComponent.BitmapCreateCacheOption.CacheOnLoad)
Dim rtp As New D2D.RenderTargetProperties(D2D.RenderTargetType.Default, pf, 0, 0, D2D.RenderTargetUsages.None, Microsoft.WindowsAPICodePack.DirectX.Direct3D.FeatureLevel.Default)
TGT = fac.CreateWicBitmapRenderTarget(bmp, rtp)
TGT.Clear(New D2D.ColorF(Color.White.ToArgb))
End Sub
'104,7s execution time:
Private Sub drawd2d()
Dim p1 As New D2D.Point2F(1, 10.5)
Dim p2 As New D2D.Point2F(1.01, 10)
Dim b As D2D.Brush = TGT.CreateSolidColorBrush(New D2D.ColorF(0, 0, 255))
TGT.BeginDraw()
For i = 0 To 200000 * 1000
TGT.DrawLine(p1, p2, b, 1)
Next
End Sub
データ ディメンションはこのアプリケーションで一般的に使用されるので、なぜそれが必要なのかは聞かないでください。
また、最初にデータを生成するアプリケーションが約 3 秒で 50M ポイントの 4 つのトレースをレンダリングすることに成功したため、これをはるかに高速に表示できるはずです。これはほぼ同じデータ量です。
誰かが以前に似たようなことをしたことがある場合は、正しい方向に向けて教えていただければ幸いです。または、可能であれば、PointF-Arrayまたは同様の構造をビットマップにレンダリングする別の方法を教えてください.
編集: これらは、残りのプログラムをロードする必要なく、元のソフトウェアと同じ計算を行うことを目的とした BENCHMARKING ルーチンであることに注意してください。Data()() 配列はソフトウェアによって動的に生成されるため、次元をチェックして対応する必要があります。
クリーンアップ機能は、データの読み込みと画像の表示機能、グリッド、および問題に関係のないその他のコードと共に削除されました。
EDIT2: データ生成ルーチンを含むコード サンプル:
Sub Main()
Dim T As New HiResTimer
Dim StartTime, StopTime As Long
'initd2d()
PrepareData(10, 200000)
StartTime = T.Value
For i = 1 To 1
'drawd2d()
Calculate2(100, 0, 200000)
Next
StopTime = T.Value
Dim Elapsed As Double = (StopTime - StartTime) / T.Frequency
Debug.Print("Time: " & Elapsed)
End Sub
Dim aData()() As Double
Private Sub PrepareData(ByVal WaveformCount As Integer, ByVal Length As Integer)
Dim Offset As Double = 0
Dim Amplitude As Double = 100
Dim SineCount As Double = 4
Dim SineBase As Double = 2 * Math.PI / Length * SineCount
ReDim aData(WaveformCount - 1)
For i = 0 To WaveformCount - 1
ReDim aData(i)(Length - 1)
For j = 0 To Length - 1
aData(i)(j) = Amplitude * Math.Sin(SineBase * j) + Offset + Rnd() * Amplitude * 0.05
Next
Next
End Sub
Private Sub Calculate2(ByVal AmplitudeUsed As Double, ByVal OffsetUsed As Double, ByVal LengthUsed As Integer)
Dim PS_Y As Double
'Instead of making this random, here a real calculation for the scale (chartheight / biggest waveform amplitude) :
PS_Y = 600 / (AmplitudeUsed * 2 + AmplitudeUsed * 0.1) ' Rnd() + 0.1
'Since our calculation method oscillates around zero with the same amplitude we can predict that we need the following offset:
Dim Origin As PointF = New PointF(0, 300)
Dim Data(), ST As Double
Dim lPoints As New List(Of PointF)
'set the x axis scale to make our waveform fit exactly:
Dim PS_X As Double = 900 / LengthUsed
Dim Img As New Bitmap(900, 600)
Dim ImgGR As Graphics = Graphics.FromImage(Img)
ImgGR.Clear(Color.White)
Dim WFPen As New Pen(Brushes.Black, 1)
'theese 2 values simply define an area in the picture where the waveforms are actually visible to not overlap with the axis / legend, set it to something that makes sense
Dim l As Integer = 20 'ChartRect.Left
Dim r As Integer = 700 'ChartRect.Right
For i = 0 To aData.Length - 1
'Set sampletime to 1 second to keep the predefined scale from above, but still do the calculation as it would be needed with real data:
ST = 1 ' Rnd()
Data = aData(i)
If Data.Length = 0 Then Continue For
Dim ScaleX As Double = ST * PS_X
Dim OrigX As Single = Origin.X
Dim iStart As Integer = (l - OrigX) / ScaleX
Dim iEnd As Integer = (r - OrigX) / ScaleX
If iStart < 0 Then iStart = 0
If iEnd < 0 Then iEnd = 0
If iEnd > Data.Length - 1 Then iEnd = Data.Length - 1
If iStart > Data.Length - 1 Then iStart = Data.Length - 1
iStart = 0
iEnd = Data.Length - 1
If iEnd < iStart Then Continue For
Dim APT(iEnd - iStart) As PointF
For j = iStart To iEnd
APT(j - iStart) = Origin + New SizeF(j * ScaleX, -(Data(j) * PS_Y))
Next
ImgGR.DrawLines(WFPen, APT)
Next
PictureBox1.Image = Img
End Sub