Thema: Delphi Farbwert zu Dezimal

Einzelnen Beitrag anzeigen

EWeiss
(Gast)

n/a Beitrдge
 
#23

AW: Farbwert zu Dezimal

  Alt 29. Mдr 2019, 06:58
Ich poste nochmal das Original..
Mir geht es darum die Hex werte mit einer Bit Verschiebung zu ersetzen.

Code:
' Процедура анимирует фон
Private Sub Release()
    Dim x As Long, y As Long, c As Long, d As Long, w As Long, h As Long
    Dim r As Long, g As Long, b As Long, a As Long, dx As Long, dy As Long
    Dim cx As Single, cy As Single, Buf() As Long, o As Single, s As Single
   
    ' Определяем ширину и высоту рисунка - 1
    h = UBound(imgSpectrumData, 2): w = UBound(imgSpectrumData, 1)
   
    ' В зависимости от эффекта
    Select Case mEffect
    Case 0
        ' ==========Без эффекта (просто изменяем прозрачность фона)=========
        ' Определяем коэффициент изменения альфа компоненты
        d = Fade * 255
        ' Проход по битам рисунка
        For y = 0 To h: For x = 0 To w
            ' Получаем альфу
            a = (((imgSpectrumData(x, y) And &HFF000000) \ &H1000000) And &HFF&)
            ' Уменьшаем
            a = a - d
            ' Ограничиваем
            If a < 0 Then a = 0
            ' Выделяем только компоненты цвета
            c = imgSpectrumData(x, y) And &HFFFFFF
            ' Записываем назад с измененной альфой
            If a > 127 Then
                imgSpectrumData(x, y) = c Or ((a - 256) * &H1000000)
            Else: imgSpectrumData(x, y) = c Or (a * &H1000000)
            End If
        Next: Next
    Case 1
        ' ===========================Размытие================================
        ' Определяем коэффициент изменения альфа компоненты
        d = Fade * 10
        ' Проход по битам рисунка
        For y = 0 To h: For x = 0 To w
            ' Размываем внутри (1,1,w-1,h-1)
            If x > 0 And y > 0 And x < w - 1 And y < h - 1 Then
                ' Обнуляем значения накопления компонент
                r = 0: g = 0: b = 0: a = 0
                ' Проход по соседним пикселям
                For dy = -1 To 1: For dx = -1 To 1
                    ' Выделяем каждую компоненту и записываем в аккумуляторы
                    c = imgSpectrumData(x + dx, y + dy)
                    a = a + (((c And &HFF000000) \ &H1000000) And &HFF&)
                    r = r + (c And &HFF0000) \ &H10000
                    g = g + (c And &HFF00&) \ &H100
                    b = b + (c And &HFF)
                Next: Next
                ' Усредняем значения в аккумуляторах и уменьшаем альфу
                r = r \ 9: g = g \ 9: b = b \ 9: a = a \ 9 - d
                ' Ограничиваем альфу снизу
                If a < 0 Then a = 0
                ' Находим значения в RGB
                c = b Or (g * &H100&) Or (r * &H10000)
                ' Добавляем альфу
                If a > 127 Then
                    imgSpectrumData(x, y) = c Or ((a - 256) * &H1000000)
                Else: imgSpectrumData(x, y) = c Or (a * &H1000000)
                End If
                ' Иначе обнуляем (полностью прозрачный)
            Else: imgSpectrumData(x, y) = 0
            End If
        Next: Next
    Case 2
        ' ============================Горение================================
        ' Определяем коэффициент изменения альфа компоненты
        d = Fade * 64
        ' Копируем биты рисунка в буфер
        Buf = imgSpectrumData
        ' Вычисляем сдвиги и ширину в зависимости от отображения
        If mSymmetrical Then o = 0: s = w * 2 Else o = 0.5: s = w
        ' Проход по битам рисунка
        For y = 0 To h: For x = 0 To w
            ' Трансформируем координату в зависимости от центра
            cx = x / s - o: cy = y / h - 0.5
            ' Находим длину относительно центра
            r = Sqr(cx * cx + cy * cy)
            ' Находим результтирующий пиксель
            dx = (cx + o + 0.01 * cx * ((r - 1) / 0.5)) * s
            dy = (cy + 0.5 + 0.01 * cy * ((r - 1) / 0.5)) * h
            ' Находим и уменьшаем его альфу
            a = (((Buf(dx, dy) And &HFF000000) \ &H1000000) And &HFF&) - d
            ' Ограничиваем альфу снизу
            If a < 0 Then a = 0
            ' Выделяем только компоненты цвета
            c = Buf(dx, dy) And &HFFFFFF
            ' Записываем назад с измененной альфой
            If a > 127 Then
                imgSpectrumData(x, y) = c Or ((a - 256) * &H1000000)
            Else: imgSpectrumData(x, y) = c Or (a * &H1000000)
            End If
        Next: Next
    End Select
End Sub
Wenn hier jetzt Fehler sind dann sind sie nicht aus meinem Mist gewachsen
destotrotz mцchte ich das fertig machen damit die Effekte funktionieren und ich das TrickSpectrum Projekt abschlieЯen kann.


gruss

Geдndert von EWeiss (29. Mдr 2019 um 07:02 Uhr)
  Mit Zitat antworten Zitat