Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

[Gelöst]RGBHue

 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
BeitragVerfasst am: 01.03.2010, 07:06    Titel: [Gelöst]RGBHue Antworten mit Zitat
Hab eine kleine funktion die noch nicht gany so funktioniert wie ich mir das vorstelle und hoffe auf einen kleinen denkanstoss...
die funktion ist der 'HUE' Funktion von PhotoFiltre (Freeware Grafikprogramm) abgekupfert aber irgendwas ist noch niocht gany richtig

Code:
SUB Hue (byref Buffer as any ptr, byval angle as Integer)
   
    'abbruch wenn winkel <1 oder >359 ist
    If (angle<1 or angle>359) or Buffer=0 then Exit sub

    Dim BufferP as UInteger Ptr
    BufferP=Buffer+8
    Dim BSizeX as UInteger
    BSizeX=BufferP[0]
    Dim BSizeY as UInteger
    BSizeY=BufferP[1]
    Dim BPitch as UInteger
    BPitch=BufferP[2]/4
   
    BufferP=Buffer+32


    dim factor  as single = 255/60 '4.25  '255/60
    'der faktor zum umrechnen eines gradwert in einen farbwert
   
    dim afactor as double = 60/255
    'aufteilungs-faktor um aktuellen wert in grad umzurechnen
   
    'HColor von einem Integer in RGB werte aufteilen
    Dim HColor as UInteger
   
    dim red   as integer
    dim green as integer
    dim blue  as integer
   
    dim maxangle as Uinteger
    'maximaler winkel der einzelfarben, ergibt sich aus der farbe
    'mit dem groessten wert
   
    dim midcol as Uinteger
    'midcolor, zum speichern der mittelfarbe die unveraendert bleibt
   
    dim mido as ubyte=0   
    'midoption fuer grau-nah-toene, wenn 2 'mittelwerte vorhanden'
   
   
    For Y as UShort=0 to BSizeY-1
    For X as UShort=0 to BSizeX-1
   
        HColor = BufferP[X+(Y*BPitch)]
       
        red    = ((HColor And &HFF0000) shr 16 )
        green  = ((HColor And &H00FF00) shr 8  )
        blue   = ((HColor And &H0000FF)        )
   
        If red = green and green = blue then
            BufferP[X+(Y*BPitch)]=HColor
        Else
       
        'wenn alle werte gleich sind, abbrechen...
   
        'naechstgroessten Farbwert ermitteln und als maximalen winkel setzen
        'mittelfarbe finden und zwischenspeichern
        'zusaetzlich ermitteln ob gleichwertige mitteltoene vorhanden sind 'graunahtoene'
        'entspricht evtl 2x mittelwert.
        'maxangle=255*afactor
       
        if blue>red-1 and blue>green-1 then
            maxangle=blue*afactor
            if green>red then
                midcol=red
                if green=blue then mido=1
                red=0
            elseif red>green then
                midcol=green
                if red=blue then mido=1
                green=0
            elseif red=green then
                midcol=green
                mido=1
                green=0
            end if

        elseif green>blue-1 and green>red-1 then
            maxangle=green*afactor
            if blue>red then
                midcol=red
                if blue=green then mido=1
                red=0
            elseif red>blue then
                midcol=blue 
                if red=green then mido=1
                blue=0
            elseif red=blue then
                midcol=blue
                mido=1
                blue=0
            end if

        elseif red>blue-1 and red>green-1 then
            maxangle=red*afactor
            if blue>green then
                midcol=green
                if blue=red then mido=1
                green=0
            ElseIf green>blue then
                midcol=blue
                if green=red then mido=1
                blue=0
            elseif green=blue then
                midcol=blue
                mido=1
                blue=0
            end if
   
        end if

        'farbwerte in gradwerte umrechnen
        red   =    red * afactor
        green =  green * afactor
        blue  =   blue * afactor
        '?red,green,blue
        ''' hier muesste eine verbesserung her... :(
        for l as UShort =1 to angle
            If     red < maxangle And green =  0 And blue = maxangle Then
               
                red   = red   + 1
               
            ElseIf red = maxangle And green =  0 And blue >  0 Then
               
                blue  = blue  - 1
               
            ElseIf red = maxangle And green < maxangle And blue =  0 Then
               
                green = green + 1
               
            ElseIf red >  0 And green = maxangle And blue =  0 Then
               
                red   = red   - 1
               
            ElseIf red =  0 And green = maxangle And blue < maxangle Then
               
                blue  = blue  + 1     
               
            ElseIf red =  0 And green >  0 And blue = maxangle Then
               
                green = green - 1
               
            End If
        next l

        'gradwerte zurueck in farbwerte umrechnen
        red=red*factor
        green=green*factor
        blue=blue*factor
   
   
        'den/die zwischengespeicherten mittelwert(e) dazu schreiben
        If midcol > 0 then
       
            if mido=1 then
                if red  = 0 then
                    red   = midcol
                ElseIf blue = 0 then
                    blue  = midcol
                ElseIf green = 0 then
                    green = midcol
                End If
            end if
       
            if red  = 0 then
                red   = midcol
            ElseIf blue = 0 then
                blue  = midcol
            ElseIf green = 0 then
                green = midcol
            End If
   
        End if
   
            'Neuen wert in Buffer schreiben
            BufferP[X+(Y*BPitch)]=(red SHL 16)+(green SHL 8)+blue
           
        End If
       
        midcol=0
    Next X
    Next Y
End SUB


Screen 19,32
Dim test as any ptr=imagecreate(360,40)
bload "huetest.bmp",test

Hue(test,180)

_________________


Zuletzt bearbeitet von Eternal_pain am 03.03.2010, 05:31, insgesamt einmal bearbeitet
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
BeitragVerfasst am: 03.03.2010, 05:30    Titel: Gelöst! Antworten mit Zitat
Nach einigem Googlen und Lesen hab ich hierfuer nun die loesung...
Fuer mein Vorhaben war es noetig ein anderes Farbmodel zu benutzen:

Hier die zwei Hauptfunktionen:
Code:

/'
[Function] RGBToHSV:
    Rechnet Red,Green,Blue Werte in Hue,Saturation,Value Werte um
   
    der Input ist eine UInteger mit den drei Farbwerten Red,Green und Blue
    der OutPut ist eine UInteger mit dem inhalt der HSV Werte
   
    Das erste  Byte enthaelt die 'Value'
    Das zweite Byte enthaelt die 'Saturation'
    Byte 3-4 enthalten die 'Hue'
   
    Example:
    Dim HSV as UInteger
    HSV=RGBToHSV(RGB(255,0,0)
    ?"Hue = ";HiWord(HSV)
    ?"Saturation = ";Hibyte(Loword(HSV))
    ?"Value = ";LoByte(LoWord(HSV))

[Function] HSVToRGB:
    Rechnet Hue,Saturation,Value Werte in Red,Green,Blue Werte um
   
    Der Input sind die drei Werten (Hue (0-359), Saturation (0-100), Value (0-100))
    Der OutPut ist eine UInteger mit einem RGBWert
   
    Example:
    ?Hex(HSVToRGB(0,100,100))
   
    Ausgabe:
    FF0000



    Der HSV-Farbraum ist der Farbraum etlicher Farbmodelle,
    bei denen man die Farbe mit Hilfe des Farbtons (englisch hue),
    der Farbsättigung (saturation) und des
    Hellwerts (bzw. der Dunkelstufe)(value) definiert.

    Andere Definitionen:
    HSL-Farbraum mit der relativen Helligkeit (lightness)
    HSB-Farbraum mit der absoluten Helligkeit (brightness)
    HSI-Farbraum mit der Lichtintensität (intensity)

    Quelle:
    http://de.wikipedia.org/wiki/HSV-Farbraum
'/


Function HSVToRGB(Byval Hue as Integer,Byval Sat as Integer,Byval Bri as Integer) as UInteger
   If Sat=0 or Bri=0 Then Return (RGB(Bri*2.55,Bri*2.55,Bri*2.55))
     
      Dim Hi as Integer
      Dim V  as Integer
      Dim P  as Integer
      Dim Q  as Integer
      Dim T  as Integer
      Dim F  as Single
      Dim S  as Single
      Dim B  as Single
     
      Hue = IIF(Hue<0,Hue+360 Mod 360,Hue Mod 360)     
     
      Hi = Fix(Hue/60)
      F  = (Hue/60)-Hi
      S  = Sat*.01
      V  = Bri
     
      P = (V*(1-S))
      Q = (V*(1-(S*F)))
      T = (V*(1-(S*(1-F))))
     
      V = V*2.55
      P = P*2.55
      Q = Q*2.55
      T = T*2.55
     
      Select Case as Const Hi
        Case 0
            Return RGB(V,T,P)
        Case 1
            Return RGB(Q,V,P)
        Case 2
            Return RGB(P,V,T)
        Case 3
            Return RGB(P,Q,V)
        Case 4
            Return RGB(T,P,V)
        Case 5
            Return RGB(V,P,Q)
      End Select
End Function


Function RGBToHSV(Byval RGBCol as UInteger) as UInteger
   Dim Red   as Integer = LoByte(HiWord(RGBCol))
   Dim Green as Integer = HiByte(LoWord(RGBCol))
   Dim Blue  as Integer = LoByte(LoWord(RGBCol))
   
   Dim MaxValue as Integer=Red
   MaxValue=IIF(Red>Green,IIF(Red>Blue,Red,Blue),IIF(Green>Blue,Green,Blue))
   
   Dim MinValue as Integer=Red
   MinValue=IIF(Red<Green,IIF(Red<Blue,Red,Blue),IIF(Green<Blue,Green,Blue))
   
   Dim Hue as Integer
   Dim Sat as Integer
   Dim Bri as Integer

   If MinValue=MaxValue Then
      Return MaxValue/2.55
   Else
      If     Red   = MaxValue Then
         Hue = ((Green-Blue)/(MaxValue-MinValue))*60
      ElseIf Green = MaxValue Then
         Hue = (2+(Blue-Red)/(MaxValue-MinValue))*60
      ElseIf Blue  = MaxValue Then
         Hue = (4+(Red-Green)/(MaxValue-MinValue))*60
      EndIf
   End If
   
   If Hue<0 Then Hue=((Hue+360) mod 360)
   Sat = (MaxValue-MinValue)/MaxValue*100
   Bri = MaxValue / 2.55
   
   Return (Hue SHL 16)+(Sat SHL 8)+Bri
End Function


Das Ganze dann an ein ganzes Bild angewendet (Beispiel):

Code:

SUB Hue (BYREF Buffer AS ANY PTR, BYVAL angle AS INTEGER)
   
    angle=IIF(angle<0,(angle+360) mod 360,angle mod 360)
   
    Dim RColor as UInteger
    Dim WColor as UInteger
    Dim NHue   as Integer
   
    DIM BufferP AS UINTEGER PTR
    BufferP=Buffer+8
   
    DIM BSizeX AS UINTEGER=BufferP[0]
    DIM BSizeY AS UINTEGER=BufferP[1]
    DIM BPitch AS UINTEGER=BufferP[2]/4
    BufferP=Buffer+32

   
    FOR Y AS USHORT=0 TO BSizeY-1
    FOR X AS USHORT=0 TO BSizeX-1
   
        RColor = BufferP[X+(Y*BPitch)]
       
        WColor=RGBToHSV(RColor)
        NHue=(HiWord(WColor)+angle) mod 360
       
        WColor=HSVToRGB(NHue,HiByte(LoWord(WColor)),LoByte(LoWord(WColor)))
       
        BufferP[X+(Y*BPitch)]=WColor
           
    NEXT X
    NEXT Y
END SUB


Sehr gut geeignet fuer Partikel und Beleuchtungseffekte
_________________
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC. Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz