Почему заполнение массива происходит долго? Как можно быстрее?
Я имел в виду процесс заполнения массива, а не вывод его на экран.
Цитирую код.
- Код: Выделить всё
Sub draw()
Dim yc As Integer, xc As Integer
Dim bi24BitInfo As BITMAPINFO, bBytes() As Byte, Cnt As Long
With bi24BitInfo.bmiHeader
.biBitCount = 24
.biCompression = BI_RGB
.biPlanes = 1
.biSize = 40
.biWidth = 608
.biHeight = 608
End With
ReDim bBytes(1 To bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * 3) As Byte
'заполнение массива
For yc = 0 To 607
For xc = 0 To 607
GFX_SET_PIXEL_DIB bBytes, xc, yc, vbRed, bi24BitInfo.bmiHeader.biWidth
Next xc
Next yc
'вывод на экран
SetDIBitsToDevice mfrm.hdc, 0, 0, bi24BitInfo.bmiHeader.biWidth, bi24BitInfo.bmiHeader.biHeight, 0, 0, 0, bi24BitInfo.bmiHeader.biHeight, bBytes(1), bi24BitInfo, DIB_RGB_COLORS
End Sub
Sub GFX_SET_PIXEL_DIB(ByRef obj() As Byte, ByVal sX As Long, ByVal sY As Long, zColor As Long, hWidth As Long)
Dim dibX As Long, dibY As Long
Dim cNum As Long
Dim R As Byte, G As Byte, B As Byte
dibX = sX + 1: dibY = hWidth - sY
cNum = (hWidth * (dibY - 1) + dibX) * 3 - 2
R = zColor \ 65536
G = (zColor And 65535) \ 256
B = zColor And 255
obj(cNum) = R
obj(cNum + 2) = B
obj(cNum + 1) = G
End Sub
Во-первых. Чтобы быстрее происходило заполнение, надо вынести код процедуры прямо в цикл. Муторно, но поможет. (в варианте от GSerg сделано)
Во-вторых. Зачем для каждого пикселя разбивать vbRed на компоненты, если это можно сделать вне цикла. (в варианте от GSerg не сделано, но реально как правило цвета различны и сделать это не представляется возможным)
В-третьих. Сделать из двухмерного цикла одномерный и не считать произведение ширины на игрек (в варианте от GSerg не сделано, хотя умножение ушло из явного кода в неявный)
И последнее. Скомпилировать, желательно с оптимизацией Remove Array Bounds Checks. (компиляция сильно ускоряет, до 10 раз)
Заполнение можно еще ускорить, если заполнить красным только первую строчку рисунка, а затем все остальные копировать из первой путем CopyMemory. Это даст ускорение в ~3 раза.
И тогда это будет работать в мгновение ока. И по хорошему, действительно НЕ нужно никаких хитростей с CreateDIBSection.
Однако, использование CreateDIBSection позволит еще немного ускорить, так как не потребуется вызов SetDIBitsToDevice и не будет лишнего копирования.
Ну и напоследок. Вот это
- Код: Выделить всё
1 to bi24BitInfo.bmiHeader.biWidth * bi24BitInfo.bmiHeader.biHeight * 3
неверно. Сделай ширину картинки не кратной 4 и программа перестанет работать (может сработает, а может вылетит с Access Violation). Причина в том, что ширина массива в байтах должна быть кратна 4. То есть выровнена на границу двойного слова.
Исправить можно так:
- Код: Выделить всё
1 to ceil(.biWidth*3 / 4)*4 * .biHeight
public function Ceil(byval Value as double) as long
ceil=-int(-value)
end function
Кстати и код заполнения массива тоже придется поправить.
Можно исправить проще: сделать рисунок глубиной 32 бита, тогда выравнивание будет выполнено всегда автоматом. Так сделано у GSerg.
И последнее.
Внутри процедуры GFX_SET_PIXEL_DIB значения B и R перепутаны местами два раза, и в результате работает правильно.
Первый раз здесь: R = zColor \ 65536 на самом деле возвращает синее;
Второй раз тут: obj(cNum) = R должен писать R туда, где находится синий, но так как в R уже синий, все нормально.
В массиве для каждого пикселя сначала записывается Blue, затем Green и Red. Наоборот по сравнению с байтовым содержимым переменной Long RGBцвет.
Ой! Еще не сразу заметил. Вот здесь
- Код: Выделить всё
dibX = sX + 1: dibY = hWidth - sY
ошибка, которая не даст программе работать, если рисунок не квадратный. Вместо Width там надо сделать Height.
Оно конечно весело! Спасибо. Но моя паскаль (это он?) не понимать! 
Здесь на форуме так принято давать линки которые второстепенно относяться к теме? Ты смотрел тот пример что я дал? Нет, конечно же не смотрел. Там прямая запись в битмап. Все максимально оптимизировано (по-моему). А вопрос был: можно ли еще быстрее?
Твой код отрисовует форму гдето ~ в 25 раз медленее.... 