Delphi-PRAXiS
Seite 3 von 8     123 45     Letzte »    

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi Farbwert zu Dezimal (https://www.delphipraxis.net/200198-farbwert-zu-dezimal.html)

Klaus01 29. Mдr 2019 05:34

AW: Farbwert zu Dezimal
 
.. in VB6 ist long ein signed 32bit Datentyp.
Ab VB2005 ist long ein signed 64bit Datentyp.

GrьЯe Klaus

EWeiss 29. Mдr 2019 05:40

AW: Farbwert zu Dezimal
 
Zitat:

Zitat von Klaus01 (Beitrag 1429054)
.. in VB6 ist long ein signed 32bit Datentyp.
Ab VB2005 ist long ein signed 64bit Datentyp.

GrьЯe Klaus

Habe nochmal drьber geschlafen.
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

EWeiss 29. Mдr 2019 05:58

AW: Farbwert zu Dezimal
 
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

Michael II 29. Mдr 2019 06:57

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

EWeiss 29. Mдr 2019 07:09

AW: Farbwert zu Dezimal
 
Zitat:

Zitat von Michael II (Beitrag 1429062)
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

Super Danke ein Problem weniger.

gruss

Klaus01 29. Mдr 2019 07:50

AW: Farbwert zu Dezimal
 
.. ein Versuch:
Delphi-Quellcode:
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.
GrьЯe
Klaus

EWeiss 29. Mдr 2019 08:05

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

Klaus01 29. Mдr 2019 08:10

AW: Farbwert zu Dezimal
 
Zitat:

Zitat von EWeiss (Beitrag 1429073)
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

ein Schreibfehler meinerseits: sollte imgSpectrum[x,y] heiЯen nit [y,y]

GrьЯe
Klaus

EWeiss 29. Mдr 2019 08:24

AW: Farbwert zu Dezimal
 
Zitat:

Zitat von Klaus01 (Beitrag 1429074)
Zitat:

Zitat von EWeiss (Beitrag 1429073)
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

ein Schreibfehler meinerseits: sollte imgSpectrum[x,y] heiЯen nit [y,y]

GrьЯe
Klaus

Kein Problem ;)
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

Neutral General 29. Mдr 2019 09:12

AW: Farbwert zu Dezimal
 
Zitat:

Zitat von EWeiss (Beitrag 1429076)
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.

Der Code von VB lдsst sich definitiv auf Delphi umlegen und das ganz ohne Tricks.
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 02:29 Uhr.
Seite 3 von 8     123 45     Letzte »    

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz