![]() |
AW: Farbwert zu Dezimal
.. in VB6 ist long ein signed 32bit Datentyp.
Ab VB2005 ist long ein signed 64bit Datentyp. GrьЯe Klaus |
AW: Farbwert zu Dezimal
Zitat:
Es geht hier um die Berechnung von Farben von daher ist Byte falsch und ColorRef oder DWord wie man's nimmt richtig. Muss nur schauen warum der Compiler bei der Umlegung und dem Original so viele Fehler\Warnungen ausgibt. gruss |
AW: Farbwert zu Dezimal
Ich poste nochmal das Original..
Mir geht es darum die Hex werte mit einer Bit Verschiebung zu ersetzen.
Code:
Wenn hier jetzt Fehler sind dann sind sie nicht aus meinem Mist gewachsen
' Процедура анимирует фон
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 destotrotz mцchte ich das fertig machen damit die Effekte funktionieren und ich das TrickSpectrum Projekt abschlieЯen kann. gruss |
AW: Farbwert zu Dezimal
In Delphi kannst du den ersten Teil so schreiben:
Delphi-Quellcode:
a,d: DWORD;
imgSpectrumData: Array of Array of DWORD; … ... a := imgSpectrumData[x, y] shr 24; // Alpha bestimmen if a >= d then a := a-d else a=0; // Alpha дndern c := imgSpectrumData[x,y] and $00ffffff; // nur RGB imgSpectrumData[x,y] := (a shl 24) or c; // Neues Alpha und RGB zurьckschreiben |
AW: Farbwert zu Dezimal
Zitat:
gruss |
AW: Farbwert zu Dezimal
.. ein Versuch:
Delphi-Quellcode:
GrьЯe
var
imgSpectrum: Array[0..9,0..9] of Integer; h,w: Integer; x, dx ,y, dy: Integer; c,d,red,green,blue: Integer; alpha: Integer; fade: Integer; mEffect: Byte; begin try h := 9; w := 9; case mEffect of 0: begin d := fade * 255; for y:= 0 to h do for x := 0 to w do begin alpha := ((imgSpectrum[x,y] and $FF000000) shr 24) and $FF; alpha := alpha - d; if alpha < 0 then alpha := 0; c := imgSpectrum[x,y] and $FFFFFF; if alpha > 127 then imgSpectrum[x,y] := c or ((alpha -256) shl 24) else imgSpectrum[x,y] := c or (alpha shl 24); end; end; 1: begin d:= fade * 10; for y := 0 to h do for x := 0 to w do begin if (x > 0) and (y > 0) and (x < (w-1)) and (y < (h -1))then begin red := 0; green := 0; blue := 0; alpha := 0; for dy := -1 to 1 do for dx := -1 to 1 do begin c := imgSpectrum[x+dx,y+dy]; alpha := (((c and $FF000000) shr 24) and $FF) + cardinal(alpha); red := red + ((c and $FF0000) shr 16); green := green + (( c and $FF00) shr 8); blue := blue + (c and $FF); end; red := red div 9; green := green div 9; blue := blue div 9; alpha := (alpha div 9) - d if alpha < 0 then alpha := 0; c := blue or ( green shl 8) or (red shl 16); if alpha > 127 then imgSpectrum[x,y] := c or ((alpha -256) shl 24) else imgSpectrum[x,y] := c or (alpha shl 24); end; end; end; end; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end. Klaus |
AW: Farbwert zu Dezimal
Danke fьr deine Mьhe es gibt einen AV direkt in der ersten zeile
Delphi-Quellcode:
alpha := ((imgSpectrum[y,y] and $FF000000) shr 24) and $FF;
gruss |
AW: Farbwert zu Dezimal
Zitat:
GrьЯe Klaus |
AW: Farbwert zu Dezimal
Zitat:
Aber nein funktioniert nicht komme niemals ьber 127 hinweg. PS: Danke fьr euer Interesse denke muss es aufgeben komme auf keinen grьnen zweig. Man kann es drehen wie man will aber die Berechnung von VB lдsst sich scheinbar auf Delphi auch in geдnderter Form nicht umlegen. Er wendet da ein paar Tricks an die so einfach nicht nachvollziehbar sind. gruss |
AW: Farbwert zu Dezimal
Zitat:
Du solltest dich eventuell mal mit den Datentypen und binдren Operationen auseinandersetzen, weil du nicht wirklich genau weiЯt was du da ьberhaupt tust. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:29 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz