Farbwert zu Dezimal

[Klaus01]

.. in VB6 ist long ein signed 32bit Datentyp.
Ab VB2005 ist long ein signed 64bit Datentyp.

Grüße Klaus

[EWeiss]

Zitat von Klaus01:

.. 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]

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]

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]

Zitat von Michael II:

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]

.. 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]

Danke für deine Mühe es gibt einen AV direkt in der ersten zeile

alpha := ((imgSpectrum[y,y] and $FF000000) shr 24) and $FF;

gruss

[Klaus01]

Zitat von EWeiss:

Danke für deine Mühe es gibt einen AV direkt in der ersten zeile

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]

Zitat von Klaus01:

Zitat von EWeiss:

Danke für deine Mühe es gibt einen AV direkt in der ersten zeile

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]

Zitat von EWeiss:

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.