- Код: Выделить всё
Private Sub customplot(ByRef g As Graphics, ByVal n As Integer, ByVal m As Integer, ByVal sxz As Single, ByVal syz As Single)
Dim sclx, scly, count As Integer
sclx = nx / pic.Width
scly = ny / pic.Height
count = 0
If sclx = 0 Or scly = 0 Then
Pbar.Maximum = nx
Pbar.Value = 0
plot(gr, nx, ny, sx, sy)
Else
Pbar.Maximum = nx / sclx
Pbar.Value = 0
For i = 0 To n - 1 Step sclx
For j = 0 To m - 1 Step scly
k = Fix((data(i, Abs(m - j - 1)) - zmin) / cc)
mybrush = New SolidBrush(colors(k))
g.FillRectangle(mybrush, i * sxz, j * syz, sxz + sxz * sclx, syz + syz * scly)
mybrush.Dispose()
Next j
count = count + 1
Pbar.PerformStep()
Next i
End If
End Sub
Рисует достаточно медленно, тогда я переписал с помощью api:
- Код: Выделить всё
Private Sub customplot(ByRef g As Graphics, ByVal n As Integer, ByVal m As Integer, ByVal sxz As Single, ByVal syz As Single)
Dim LB As LOGBRUSH
Dim R As RECT
Dim hBrush As Integer
Dim hdc As Integer
Dim sclx, scly, count As Integer
sclx = nx / pic.Width
scly = ny / pic.Height
count = 0
If sclx = 0 Or scly = 0 Then
Pbar.Maximum = nx
Pbar.Value = 0
plot(gr, nx, ny, sx, sy)
Else
Pbar.Maximum = nx / sclx
Pbar.Value = 0
hdc = g.gethdc()
For i = 0 To n - 1 Step sclx
For j = 0 To m - 1 Step scly
k = Fix((data(i, Abs(m - j - 1)) - zmin) / cc)
LB.lbColor = RGB(colorsx(k, 1), colorsx(k, 2), colorsx(k, 3))
hBrush = CreateBrushIndirect(LB)
SetRect(R, i * sxz, j * syz, i * sxz + sxz * sclx, j * syz + syz * scly)
FillRect(hdc, R, hBrush)
DeleteObject(hBrush)
Next j
count = count + 1
Pbar.PerformStep()
Next i
g.ReleaseHdc()
End If
End Sub
А скорость такая-же
Что посоветуете?