AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Ntzliche Links
Registrieren

Farbwert zu Dezimal

Ein Thema von EWeiss · begonnen am 28. Mr 2019 · letzter Beitrag vom 3. Apr 2019
Antwort Antwort
Seite 3 von 8     123 45     Letzte » 
Klaus01

Registriert seit: 30. Nov 2005
Ort: Mnchen
5.314 Beitrge
 
Delphi XE7 Professional
 
#21

AW: Farbwert zu Dezimal

  Alt 29. Mr 2019, 06:34
.. in VB6 ist long ein signed 32bit Datentyp.
Ab VB2005 ist long ein signed 64bit Datentyp.

Gre Klaus
Klaus
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beitrge
 
#22

AW: Farbwert zu Dezimal

  Alt 29. Mr 2019, 06:40
.. in VB6 ist long ein signed 32bit Datentyp.
Ab VB2005 ist long ein signed 64bit Datentyp.

Gre Klaus
Habe nochmal drber 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

Gendert von EWeiss (29. Mr 2019 um 06:42 Uhr)
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beitrge
 
#23

AW: Farbwert zu Dezimal

  Alt 29. Mr 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 mchte ich das fertig machen damit die Effekte funktionieren und ich das TrickSpectrum Projekt abschlieen kann.


gruss

Gendert von EWeiss (29. Mr 2019 um 07:02 Uhr)
  Mit Zitat antworten Zitat
Michael II

Registriert seit: 1. Dez 2012
Ort: Region Bern CH
317 Beitrge
 
Delphi 10.3 Rio
 
#24

AW: Farbwert zu Dezimal

  Alt 29. Mr 2019, 07:57
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 zurckschreiben
Michael Gasser
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beitrge
 
#25

AW: Farbwert zu Dezimal

  Alt 29. Mr 2019, 08:09
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 zurckschreiben
Super Danke ein Problem weniger.

gruss
  Mit Zitat antworten Zitat
Klaus01

Registriert seit: 30. Nov 2005
Ort: Mnchen
5.314 Beitrge
 
Delphi XE7 Professional
 
#26

AW: Farbwert zu Dezimal

  Alt 29. Mr 2019, 08:50
.. 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.
Gre
Klaus
Klaus

Gendert von Klaus01 (29. Mr 2019 um 10:35 Uhr)
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beitrge
 
#27

AW: Farbwert zu Dezimal

  Alt 29. Mr 2019, 09:05
Danke fr deine Mhe es gibt einen AV direkt in der ersten zeile

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

gruss
  Mit Zitat antworten Zitat
Klaus01

Registriert seit: 30. Nov 2005
Ort: Mnchen
5.314 Beitrge
 
Delphi XE7 Professional
 
#28

AW: Farbwert zu Dezimal

  Alt 29. Mr 2019, 09:10
Danke fr deine Mhe 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] heien nit [y,y]

Gre
Klaus
Klaus
  Mit Zitat antworten Zitat
EWeiss
(Gast)

n/a Beitrge
 
#29

AW: Farbwert zu Dezimal

  Alt 29. Mr 2019, 09:24
Danke fr deine Mhe 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] heien nit [y,y]

Gre
Klaus
Kein Problem
Aber nein funktioniert nicht komme niemals ber 127 hinweg.

PS:
Danke fr euer Interesse denke muss es aufgeben komme auf keinen grnen zweig.
Man kann es drehen wie man will aber die Berechnung von VB lsst sich scheinbar auf Delphi auch in genderter Form nicht umlegen.
Er wendet da ein paar Tricks an die so einfach nicht nachvollziehbar sind.

gruss

Gendert von EWeiss (29. Mr 2019 um 09:37 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Neutral General
Neutral General

Registriert seit: 16. Jan 2004
Ort: Bendorf
5.078 Beitrge
 
Delphi 10.2 Tokyo Professional
 
#30

AW: Farbwert zu Dezimal

  Alt 29. Mr 2019, 10:12
PS:
Danke fr euer Interesse denke muss es aufgeben komme auf keinen grnen zweig.
Man kann es drehen wie man will aber die Berechnung von VB lsst sich scheinbar auf Delphi auch in genderter Form nicht umlegen.
Er wendet da ein paar Tricks an die so einfach nicht nachvollziehbar sind.
Der Code von VB lsst sich definitiv auf Delphi umlegen und das ganz ohne Tricks.
Du solltest dich eventuell mal mit den Datentypen und binren Operationen auseinandersetzen, weil du nicht wirklich genau weit was du da berhaupt tust.
Michael
"Programmers talk about software development on weekends, vacations, and over meals not because they lack imagination,
but because their imagination reveals worlds that others cannot see."
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 3 von 8     123 45     Letzte » 

Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beitrge zu antworten.
Es ist dir nicht erlaubt, Anhnge hochzuladen.
Es ist dir nicht erlaubt, deine Beitrge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 00:43 Uhr.
Powered by vBulletin® Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2019 by Daniel R. Wolf