- Mikle
- Модератор
SR2D - изумительный инструмент, и я никогда бы не смог реализовать задуманную программу, если бы не он! Тем более что пишу исключительно на VB6, для коего 2D движков не густо. Но здесь ещё и продуманность, совершенная простота синтаксиса, молниеносность исполнения... Блеск! От всей души благодарю!!
Один только назрел серьёзный вопрос.
В моём случае на экране должны отображаться ноты, а они с обилием толстых наклонных линий.
Но думаю, этот вопрос и многих других касается.
Есть функция DrawLine, толщиной всегда 1 px.
Я, конечно, добавил DrawLineWidth с указанием толщины - она просто многократно повторяет DrawLine со смещением.
Но в результате слегка наклонные линии получаются СТУПЕНЧАТЫЕ, по квадратным пикселям.
А есть ли возможность программно выполнить СГЛАЖИВАНИЕ на этих ступеньках?
Подумалось, что можно нарисовать прямую линию через ClearRect, а потом её вращать при наложении, тогда ведь задействуется анти-алиасинг. Но при известных координатах X1, Y1, X2, Y2 гораздо легче провести линию, чем вычислять её длину, середину, угол вращения и т.д. Но если ПРОСТОГО, лежащего на поверхности, решения нет, можно сделать и так!
Музыкант
Рад, что кто-то пользуется SR2D, я сам пользуюсь им постоянно.
Да, ClearRect по производительности будет лучше многократных DrawLine, по крайней мере, когда линии достаточно толстые.
И, да, для линий не предусмотрен АА и метод поворота уже готового изображения вполне приемлем.
Я так понял, требуется что-то такое:
Тогда вообще можно заранее приготовить 3-5 готовых (в PNG файлах) вариантов линии достаточной длины, чтобы при использовании просто оставлять необходимое, отрезая лишнее с помощью SetLockRect. Всё равно ведь всякие бемоли, ключи и т. п. рисуются по тому же принципу (а как ещё?).
А точно! Отчего-то не смел думать в сторону PNG.
Попробую то и другое. Меня затрудняли расчёты, но поскольку вариантов наклона немного, подберу коэффициенты методом тыка. Я так всё делаю.
Ещё раз огромная благодарность! SR2D действительно радует постоянно. Всё нужное - и ничего лишнего. Редкое сочетание!
По ходу дела я вносил в SR2D разные функции, главным образом - запоминание вносимых спрайтов для определения, который из них мышью, с тегами и прочим, чтобы реализовать выбор объектов мышью, но пока не нахожу этого проекта (а был рабочий точно).
Ещё внёс градиентную заливку и подсветку серых областей любым цветом (раскраска на ходу), может будет интересно:
Public Sub DrawGreyColored(src as SR2D_Sprite, Optional ByVal A As Byte = 128, Optional ByVal R As Byte = 128, Optional ByVal G As Byte = 128, Optional ByVal B As Byte = 128, Optional Left As Long = 0, Optional Top As Long = 0)
'Спрайт src должен быть в серых тонах (тона вокруг RGB(128,128,128). На него накладывается цвет.
If meHeight = 0 Or meWidth = 0 Then Init src.Width, src.Height
MulAddS2X src, Left, Top, ARGB(128, 255 - R, 255 - G, 255 - B), ARGB(A, R, G, B)
End Sub
Sub DrawGradient(cARGB1 As Long, cARGB2 As Long, Optional Vert As Boolean, Optional Left As Long, Optional Top As Long, Optional Width As Long, Optional Height As Long, Optional IsXor As Boolean)
If meWidth = 0 Or meHeight = 0 Then
Init Left + Width, Top + Height
Else
If Width = 0 Then Width = Left + meWidth
If Height = 0 Then Height = Top + meHeight
End If
If Vert Then
For i = 0 To Height
DrawLine Left, i + Top, Left + Width, i + Top, ColLerp(cARGB2, cARGB1, i / Height), , IsXor
Next
Else
For i = 0 To Width
DrawLine Left + i, Top, Left + i, Height + Top, ColLerp(cARGB2, cARGB1, i / Width), , IsXor
Next
End If
End Sub
Public Function ColLerp(ByVal c1 As Long, ByVal c2 As Long, ByVal k As Single) As Long
'Эту функцию я взял где-то в интернете и переправил для ARGB вместо RGB.
'При ARGB случается отрицательное значение Long (т.к. задействуется его минусовая часть хранилища).
'Пришлось это расследовать и учесть.
'(Позже пришла мысль, что при грамотном шестнадцатеричном представлении этого сбоя могло и не произойти.
' Но я неграмотный...)
Dim A As Integer, R As Integer, G As Integer, B As Integer, a1plus As Long, a2plus As Long
'Подправляем сбой на минус лонг при A>127:
If c1 < 0 Then 'значит, A>127 и, как следствие, Long отрицательный
c1 = c1 + 2147483647 + 1& 'прибавляем МаксЛонг, который вообще-то есть половина действит.макса (столько же ниже нуля)
a1plus = 128&
End If
If c2 < 0 Then 'значит, A>127 и, как следствие, Long отрицательный
c2 = c2 + 2147483647 + 1& 'прибавляем МаксЛонг, который вообще-то есть половина действит.макса (столько же ниже нуля)
a2plus = 128&
End If
'Составляем цвет из двух:
A = (((c1 \ 16777216) And 255&) + a1plus) * k + (((c2 \ 16777216) And 255&) + a2plus) * (1 - k)
R = ((c1 \ 65536) And 255&) * k + ((c2 \ 65536) And 255&) * (1 - k)
G = ((c1 \ 256&) And 255&) * k + ((c2 \ 256&) And 255&) * (1 - k)
B = (c1 And 255&) * k + (c2 And 255&) * (1 - k)
ColLerp = ARGB(A, R, G, B)
End Function
Public Sub DrawLineWidth(X1&, Y1&, X2&, Y2&, c&, w, Optional с_конца As Boolean, Optional ByVal IsXor As Boolean = False)
If с_конца Then нпрвл_ = -1 Else нпрвл_ = 1
If Abs(X1 - X2) > Abs(Y1 - Y2) Then 'Если линия ГОРИЗОНТАЛЬНАЯ,
For н = 1 To w
DrawLine X1, Y1 + н * нпрвл_, X2, Y2 + н * нпрвл_, c, IsXor
Next
Else
For н = 1 To w
DrawLine X1 + н * нпрвл_, Y1, X2 + н * нпрвл_, Y2, c, IsXor
Next
End If
End Sub
Public Sub DrawRect(ByVal Left As Long, ByVal Top As Long, ByVal Width As Long, ByVal Height As Long, Optional ByVal c)
ClearRect Left, Width + Left, Top, Height + Top, c
End Sub
Public Sub DrawColor(Left As Long, Top As Long, Optional ByVal w As Long, Optional ByVal H As Long, Optional ByVal c, Optional ByVal Op As SR2D_Op = OpDefault)
If w = 0 Then If meWidth > 0 Then w = meWidth Else Exit Sub
If H = 0 Then If meHeight > 0 Then H = meHeight Else Exit Sub
If IsMissing(c) Then c = &HFF000000
Dim src As New SR2D_Sprite
src.Init w, H, Op, c
Me.Draw src, Left, Top
End Sub
Public Sub DrawResize(src as SR2D_Sprite, Optional Left As Long, Optional Top As Long, Optional ByVal w As Long, Optional ByVal H As Long, Optional ByVal Trans As SR2D_Transform = TrNone, Optional ByVal cKey As Long = -1, Optional ByVal Op As SR2D_Op = OpDefault)
If w = 0 And H > 0 Then 'ширина неизвестна
w = H * (src.Width / src.Height)
ElseIf w > 0 And H = 0 Then 'высота неизвестна,
H = w * (src.Height / src.Width)
End If
Dim srTemp As New SR2D_Sprite
srTemp.LoadFromSprite src, Trans, w, H, cKey
Draw srTemp, Left, Top, Op
End Sub
'НЕМНОЖКО ДОПОЛНЕННЫЕ ИЗНАЧАЛЬНЫЕ ФУНКЦИИ: //////////////////////////////////////////////////////////////////////
Public Sub Init(Optional ByVal w As Long = 0, Optional ByVal H As Long = 0, Optional ByVal Op As SR2D_Op = OpAlphaTest, Optional c)
If Op <> OpDefault Then meOp = Op
If w <= 0 And H <= 0 Then Exit Sub
If w = meWidth And H = meHeight Then GoTo цвет
If w > 0 Then meWidth = w
If H > 0 Then meHeight = H
SetLockRect 0, meWidth, 0, meHeight
ReDim cBuf(meWidth * meHeight - 1) As Long
With bi32BitInfo.bmiHeader
.biBitCount = 32
.biPlanes = 1
.biSize = Len(bi32BitInfo.bmiHeader)
.biWidth = meWidth
.biHeight = -meHeight
.biSizeImage = 4 * (meWidth * meHeight)
End With
цвет:
If Not IsMissing(c) Then ClearBuffer c
End Sub
'Ну и LoadFromFile я сделал функцией, с возвратом удачи. Может, ещё что вносил по мелочам.Музыкант
> Optional c
Почему не "As Long"? Вместо "IsMissing(c)" просто "c <> 0", ведь ноль не нужен, нулём затирает ReDim.
Для RGBColorLerp есть более оптимальная реализация (без делений):
Function RGBColorLerp(C1 As Long, C2 As Long, s As Single) As Long Dim uS As Single, d As Long uS = 1 - s d = ((C1 And &HFF&) * s + (C2 And &HFF) * uS) And &HFF& d = d + (((C1 And &HFF00&) * s + (C2 And &HFF00&) * uS) And &HFF00&) RGBColorLerp = d + (((C1 And &HFF0000) * s + (C2 And &HFF0000) * uS) And &HFF0000) End Function
Для альфаканала тоже можно что-то додумать.
Я любитель и не заморачиваюсь с типами и объявлениями переменных без необходимости, вот и вся причина. Главное - спрайт инициализировали и сразу цветом залили, одной командой. Мне это показалось удобным при частом вызове.
А вводные параметры функций я вообще предпочитаю без типа, чтобы удобней было туда передавать что угодно. А то какой-то левый Variant передашь и получишь несовпадение типов.
У меня многие внутренние переменные без объявления и без типа, и ни разу за 15 лет не столкнулся с неприятностью, т.к. внимателен к их именам. Зато сэкономил много энергии не держать их в голове и не помнить каждую мелочь объявить. Не думаю, что это фатально сказывается на производительности (проверял итерациями и разницы не заметил).
...О-о! Я не знал такой интерполяции! Мне это нравится! Простота - высший талант.
Музыкант
> Не думаю, что это фатально сказывается на производительности
Иногда очень сказывается.
На ходу, конечно, часто помечаю знаками %, & и т.д. Но больше проблем от этого поимел (особенно когда коэффициент должен был быть Single). Знак убрал - и всё заработало.
Музыкант
> Знак убрал - и всё заработало.
Заключи в скобки, тоже заработает, но без потери производительности:
Sub Test(s As Single) .... End Sub Dim i As Long Test i' так не работает Test (i)' а так уже работает
А ещё правильнее декларировать "ByVal s As Single", если только тебе правда не нужна ссылка на переданную переменную.
Так и безопаснее, и быстрее работает, и приводить тип не требует.
Спасибо, учту!
По теме - да, Вы всё правильно поняли с нотным текстом, речь о наклонных соединительных рёбрах.
Сделал наскоро функцию (пока не заморачиваясь с углом поворота):
Public Sub DrawLineAA(X1&, Y1&, X2&, Y2&, w&, c&)
'Слегка наклонная горизонтальная линия без ступенек.
Dim srTemp As New Фея
катет_гор& = X2 - X1
катет_верт& = Y2 - Y1
'Создаём ровную горизонтальную линию.
'Длина линии равна мнимой гипотенузе, за которую мы приняли наклонную линию;
'ширина указана пользователем:
srTemp.Init Sqr(катет_гор ^ 2 + катет_верт ^ 2), w, OpAlphaTest, c 'Пробовал и OpAlphaBlend
'Накладываем эту линию с поворотом.
'Точка поворота - в начале линии, конец её сам должен прийти куда нужно,
'угол пока от фонаря:
Me.DrawRotate srTemp, Left:=0, Top:=IIf(Y1 < Y2, 0, катет_верт), dx:=X1, dy:=Y1, Angle:=50, AA:=True
Set srTemp = Nothing
End Sub
Формально работает, но повёрнутые линии ВСЁ РАВНО СТУПЕНЧАТЫЕ. И никакой попытки сгладить. Что же тогда делает АА в DrawRotate? Видать, АА при повороте не действует на границы спрайта? Тогда на что? ИЛИ НУЖЕН АЛЬФА-КАНАЛ? (Хотя не представляю, как его прикрутить.)
Пока единственный рабочий выход - именно, как Вы говорите, несколько вариантов поворота в PNG. Хотя этот выход и затратный, т.к. нужно заранее спроектировать эти несколько вариантов поворота и каждый отрегулировать опытным путём, да и как поведет себя интерполяция такого нестандартного изображения при неизбежном масштабировании? не вернёт ли опять ступеньки? Разрешение-то у пользователей разное, и масштаб листа тоже регулируется. АА в момент поворота в любом случае будет качественнее, т.к. стремится к идеалу именно при данном разрешении и масштабе. Да и легче с ним намного.
Музыкант
> АА при повороте не действует на границы спрайта? Тогда на что?
На всё, что внутри границ.
Музыкант
> Пока единственный рабочий выход - именно, как Вы говорите, несколько вариантов поворота в PNG. Хотя этот выход и затратный, т.к. нужно заранее спроектировать эти несколько вариантов поворота и каждый отрегулировать опытным путём
Я бы сделал 3 варианта - влево, вправо и плоский. Не вижу особых проблем.
Музыкант
> как поведет себя интерполяция такого нестандартного изображения при неизбежном масштабировании? не вернёт ли опять ступеньки?
Не вернёт. Масштабирование включает АА, только нужно масштабировать в меньшую сторону, чтобы уменьшить искажения.
Музыкант
> ИЛИ НУЖЕН АЛЬФА-КАНАЛ? (Хотя не представляю, как его прикрутить.)
Смотря какие цвета, если нужны произвольные цвета, то без альфы обойтись сложно, но, если рисовать всегда чёрным, то я бы использовал ЧБ спрайты и накладывал их с помощью OpMul.
Вообще, при рисовании нот обычное масштабирование будет давать не очень хороший результат, и дело тут не в качестве рендера. Тут нужен подход, как со шрифтами - линии имеют всегда целочисленную ширину, выровнены по пикселям, АА только на закруглениях. Если всё делать по уму, это довольно большая работа. Но интересная.
> АА при повороте не действует на границы спрайта? Тогда на что?
На всё, что внутри границ.
ТЕПЕРЬ ПОНЯТНО!
Как же я сразу не догадался. Объявляю спрайтом белую ПОЛУПРОЗРАЧНУЮ горизонтальную линию чуть толще (альфа=126); в её центр кладу чёрную линию нужной толщины; поворачиваю это DrawRotate AA на временный спрайт и кладу его на общую картину. За счёт 126-й альфы срабатывает OpAlphaTest и поглощает паразитный фон, в котором происходил АА, но при этом и сам АА срабатывает (совсем без альфы он не работал). Я ведь чувствовал, что как-то нужно прикрутить альфу.
Ура! Линии без ступенек.
Вот новая функция:
Public Sub DrawLineAA(X1&, Y1&, X2&, Y2&, w&, c&)
If Y1 = Y2 Then 'строго горизонтальная
Me.ClearRect X1, X2, Y1 - w \ 2, Y1 + w \ 2
Else 'слегка наклонная
Dim s As New Фея, ss As New Фея, sss As New Фея
катет_гор& = X2 - X1
катет_верт& = Y2 - Y1
s.Init Sqr(катет_гор ^ 2 + катет_верт ^ 2), w, OpAlphaTest, c 'длина гипотенузы; ширина указанная пользователем
ss.Init s.Width, s.Height + 2, OpAlphaTest, RGBtoARGB(Цвет_страницы, 126)
sss.Init Me.Width, Me.Height
ss.Draw s, , 1
sss.DrawRotate ss, Left:=0, Top:=IIf(Y1 < Y2, 0, катет_верт), dx:=X1, dy:=Y1, Angle:=-Atn((Y2 - Y1) / (X2 - X1)), AA:=True
Me.Draw sss, , , OpAlphaTest
Set srTemp = Nothing
End If
End Sub ЕДИНСТВЕННЫЙ ВОПРОС - ПО РЕЖИМУ НАЛОЖЕНИЯ.
При наложении наклонных линий на ровные в местах их пересечения есть белые ступеньки. Паразитный однопиксельный фон, необходимый для АА, имеет вроде бы альфу меньшую, чем 128 (а именно - 126) и потому не должен был бы накладываться в режиме OpAlphaTest. Но в процессе АА при DrawRotate эти пиксели были заполнены и альфа их тоже заполнилась.
"OpAlphaTest - в тех пикселях, где АЛЬФА в цвете источника превышает среднее (128), значение цвета приемника заменяется на значение из источника"
А вот бы не альфа, а ВСЕ компоненты по этому принципу? Светлый цвет (сумма цветовых каналов менее 200, к примеру) не передаётся, а тёмный - передаётся и накладывается на приёмник. Или это что-то связанное с масками?
Я бы сделал 3 варианта - влево, вправо и плоский. Не вижу особых проблем.
В обратную-то сторону можно просто зеркалить, а плоские чертить ClearRect; сложность же в том, что желательно пару-тройку разных УГЛОВ наклона.
Тут нужен подход, как со шрифтами - линии имеют всегда целочисленную ширину, выровнены по пикселям, АА только на закруглениях
Так вроде и есть: линейки и штили рисуются через ClearRect (целочисленно), а закруглённые точки и все знаки - из PNG с интерполяцией. И кстати, интерполируются они хорошо и АА на всех знаках отличный в любом масштабе.
Я сделал небольшой пример: https://disk.yandex.ru/d/TnCByMt2cWSUZw
Вообще без альфы, так чёрные линии можно рисовать на любом фоне, хоть на текстуре, кривого наложения не будет.
И все спрайты, которые загружаются из PNG лучше рисовать по той же схеме.
Думаю, всё понятно, если что — спрашивай.
Это волшебно! Преспасибище!
Запустил форму и долго любовался идеальным пересечением линий.
У меня без альфы не срабатывал АА, а у Вас, видать благодаря SprSL.ClearBuffer &HFFFFFF (белый без альфы), всё работает и фону не мешает (opMul).
Чуть позже впишу Ваш принцип в свой код, в т.ч. для PNG, и отпишусь. Гран мерси!!!
Вы - редкой души человек.
Музыкант
> не срабатывал АА, а у Вас, видать благодаря SprSL.ClearBuffer &HFFFFFF (белый без альфы), всё работает и фону не мешает
АА всегда срабатывает, после него нельзя использовать OpAlphaTest, это не для градиентов.
Музыкант
> Преспасибище!
Да не за что.
И давай на "ты", а то я один тыкаю.
После перерыва вернулся к работе.
Всё же не смог я перевести весь проект на OpMul, там много разных наложений и фонов и всё уже отлажено волшебным тыком для OpAlphaTest, к тому же в будущем предполагаются объекты и цветные... В общем, вернулся к своему первому варианту наклона линий, а нечёткое их наложение на линии ровные исправил изменением порядка наложения: сперва прорисовываются все наклонные, а после на них - все ровные. Просто все ровные линии (вообще все) выводятся на отдельный спрайт того же размера, что и общий спрайт для всего остального, а в конце всего этот "ровный" спрайт накладывается на "кривой", и весь АА оказывается в фоне и ничему не мешает.
Функцию рисования наклонных линий по заданным координатам я доработал и отрегулировал, теперь она рабочая и универсальная, к тому же может рисовать фрагмент линии, наклонённой по координатам так, как если бы она была цельной. (Напоминает рисование дуги фрагментом Circle). При желании можно легко перевести в OpMul на основе проекта из сообщения #11. Для интересующихся приведу эту функцию в рабочем виде:
Public Sub DrawLineAA(X1&, Y1&, X2&, Y2&, Width&, Color&, Optional ByVal от&, Optional ByVal до&)
'Рисование линии, в т.ч. наклонной - в последнем случае будет применён анти-алиасинг, и она будет гладкой на экране.
'От и До - для указания фрагмента линии (это особенно актуально, если она окажется наклонной).
'Отрицательный От и/или До означает - отнять это значение от длины наклонной линии.
'Если линия окажется наклонной, то X1,Y1,X2,Y2 задают координаты угла наклона, а От и До - её фактическую прорисовку.
If Y1 = Y2 Then 'строго горизонтальная
длина& = X2 - X1
If от < 0 Then от = длина + от
If до = 0 Then до = длина Else If до < 0 Then до = длина + до
Me.ClearRect X1 + от, X1 + длина, Y1, Y1 + Width
Else 'слегка наклонная
Dim прямая As New SR2D_Sprite, кривая As New SR2D_Sprite
катет_гор& = Abs(X2 - X1)
катет_верт& = Abs(Y2 - Y1)
длина& = Sqr(катет_гор ^ 2 + катет_верт ^ 2) + 3 'длина гипотенузы
If от < 0 Then от = длина + от
If до = 0 Then до = длина Else If до < 0 Then до = длина + до
прямая.Init длина, Width + 2, OpAlphaTest, RGBtoARGB(Цвет_страницы, 126)
прямая.ClearRect от, до, 1, Width + 1, Color
кривая.Init катет_гор, катет_верт + Width + 2
абс_верх& = IIf(Y1 < Y2, 0, катет_верт)
кривая.DrawRotate прямая, Left:=3, Top:=0, dx:=0, dy:=абс_верх, Angle:=Atn(катет_верт / катет_гор) * IIf(Y1 < Y2, -1, 1), AA:=True
Me.Draw кривая, X1, Y1 - абс_верх - 1, OpAlphaTest
End If
End Sub
Кстати, волшебный метод "MaskInterSector", одной командой выставляешь расстояние между станами, чтобы они никогда не пересекались, где бы что ни мешало. Чудо!
Тема в архиве.