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:

[fertig] Median-Cut Farbreduzierung
Gehe zu Seite Zurück  1, 2
 
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: 26.07.2012, 11:16    Titel: Antworten mit Zitat

Klingt eigentlich mal nach gar keiner so schlechten Idee grinsen
hab inzwischen soviele versuchscode das man damit fast ein Code-Baukasten erstellen könnte happy

Experimentiere allerdings doch noch ein wenig damit, mir war aufgefallen das die Farbgewichtungen nicht optimal waren, besonders bei reduzieren < 256 Farben...

Auch das Dithering ist neu für mich und bin mir seiner Interpretation nicht so recht sicher, daher experimentiere ich damit auch noch etwas rum...

Am letzten Versuch hab ich etwas rumgeschraubt und meine das es im allgemeinen nu etwas besser funktioniert, werd aber wohl nochmal ein 14. versuch wagen wo ich von anfang an verschiedene Farbräume testen kann um herauszufinden womit man am besten arbeiten kann...
der (CIE)L*a*b* tauchte bei meinen recherchen immer wieder auf und
mir meinen bedürfnissen entsprechen was zurecht gebastelt um damit zu experimentieren... wobei das rückrechnen von Lab zu RGB abweicht wegen integer runden:
Code:

Randomize Timer

Function RGBtoLab (byval RGBColor as UInteger) as UInteger
    Dim as Single R = lobyte(hiword(RGBColor))/255 , G = hibyte(loword(RGBColor))/255 , B = lobyte(loword(RGBColor))/255
    Dim as Single X ,Y, Z, T, fx, fy, fz, xr, yr, zr, cL, ca, cb
    Dim as byte bL, ba, bb
   
    'RGB to XYZ
    T = 0.04045
    R = IIF(R>T, ((R+.055)/1.055)^2.4,R/12.95) : G = IIF(G>T, ((G+.055)/1.055)^2.4,G/12.95) : B = IIF(B>T, ((B+.055)/1.055)^2.4,B/12.95)
    X = (0.412453*R)+(0.357580*G)+(0.180423*B) : Y = (0.212671*R)+(0.715160*G)+(0.072169*B) : Z = (0.019334*R)+(0.119193*G)+(0.950227*B)
   
    'XYZ to Lab
    T = 0.008856
    xr = X/0.950456 : yr = Y/1.000000 : zr = Z/1.088754
    fx = IIF(xr>T,xr^(1/3),(7.787*xr)+(16/116)) : fy = IIF(yr>T,yr^(1/3),(7.787*yr)+(16/116)) : fz = IIF(zr>T,zr^(1/3),(7.787*zr)+(16/116))
    cL = 116 * fy - 16 : ca = 500 * (fx - fy) : cb = 200 * (fy - fz)
   
    bL = cL : ba = ca : bb = cb
    Function =((bL shl 16) + (ba shl 8) + bb) 'LabColor (24bit)
End Function

Function LabtoRGB (byval LabColor as UInteger) as UInteger
    Dim as byte bL = lobyte(hiword(LabColor)), ba = hibyte(loword(LabColor)), bb = lobyte(loword(LabColor))
    Dim as Single X, Y, Z, R, G, B, T
   
    Y = (bL + 16) / 116 : X = ba / 500 + Y : Z = Y - bb / 200
   
    T = 0.008856
    X = IIF(X^3>T,X^3,(X-16/116)/7.787) : Y = IIF(Y^3>T,Y^3,(Y-16/116)/7.787) : Z = IIF(Z^3>T,Z^3,(Z-16/116)/7.787)
    X *= 0.950456 : Y *= 1.000000 : Z *= 1.088754
   
    T = 0.0031308
    R = ( 3.240479*X)+(-1.537150*Y)+(-0.498535*Z) : G = (-0.969256*X)+( 1.875992*Y)+( 0.041556*Z) : B = ( 0.055648*X)+(-0.204043*Y)+( 1.057311*Z)
    R = IIF(R>T, 1.055*(R^(1/2.4))-0.055,12.92*R) : G = IIF(G>T, 1.055*(G^(1/2.4))-0.055,12.92*G) : B = IIF(B>T, 1.055*(B^(1/2.4))-0.055,12.92*B)
    R = IIF(R>1.0,1.0,IIF(R<0.0,0.0,R)) : G = IIF(G>1.0,1.0,IIF(G<0.0,0.0,G)) : B = IIF(B>1.0,1.0,IIF(B<0.0,0.0,B))
    Function = RGB( R*255, G*255, B*255 ) 'RGBColor (24/32bit)
End Function

Function Lab(byval L as Single, byval a as Single, byval b as Single) as UInteger
    Dim as byte bL, ba, bb
    bL = L : ba = a : bb = b
    Function =((bL shl 16) + (ba shl 8) + bb) 'LabColor (24bit)   
End Function


Function MixRGB(byval RGBColorL as UInteger, byval RGBColorR as UInteger) as UInteger
        Function = RGB( (lobyte(hiword(RGBColorL)) + lobyte(hiword(RGBColorR)))\2, _
                        (hibyte(loword(RGBColorL)) + hibyte(loword(RGBColorR)))\2, _
                        (lobyte(loword(RGBColorL)) + lobyte(loword(RGBColorR)))\2)
End Function

Function MixLab(byval LabColorL as UInteger, byval LabColorR as UInteger) as UInteger
        Dim as byte LL = lobyte(hiword(LabColorL)), La = hibyte(loword(LabColorL)), Lb = lobyte(loword(LabColorL))
        Dim as byte RL = lobyte(hiword(LabColorR)), Ra = hibyte(loword(LabColorR)), Rb = lobyte(loword(LabColorR))
        Function = ( (((LL+RL)/2) shl 16) + (((La+Ra)/2) shl 8) + ((Lb+Rb)/2) )
End Function



screen 19,32

Dim as UByte lR, lG, lB, rR, rG, rB
'Dim as byte Ll, al, bl, Llr, ar, br

Dim as UInteger LabColorL, LabColorR, LabColorM
Dim as UInteger RGBColorL, RGBColorR, RGBColorM, NewRGB

do
lR = rnd*255 : lG = rnd*255 : lB = rnd*255
rR = rnd*255 : rG = rnd*255 : rB = rnd*255

RGBColorL = RGB(lR,lG,lB)
RGBColorR = RGB(rR,rG,rB)
RGBColorM = MixRGB(RGBColorL,RGBColorR)

LabColorL = RGBtoLab(RGBColorL)
LabColorR = RGBtoLab(RGBColorR)
LabColorM = MixLab(LabColorL,LabColorR)
NewRGB = LabtoRGB(LabColorM)


line (0,120)-(399,599),RGBColorM,bf
Line (10,60)-(100,150),RGBColorL,bf
Line (110,60)-(200,150),RGBColorR,bf
line (400,120)-(799,599),NewRGB,bf

locate 1,1

?"RGBMix: R ";str(lobyte(hiword(RGBColorM)));", G ";str(hibyte(loword(RGBColorM)));", B ";str(lobyte(loword(RGBColorM)));"  "
locate 1,52
?"LabMix: R ";str(lobyte(hiword(NewRGB)));", G ";str(hibyte(loword(NewRGB)));", B ";str(lobyte(loword(NewRGB)));"  "
?
?str(lR);" ";str(lG);" ";str(lB);"  |  ";str(rR);" ";str(rG);" ";str(rB);"   "
sleep
loop until multikey(&h01)


zumal das Farbreduzieren nebst optimalen Farb und Visuellen Ergebnis ja auch unterschiedliche einsatzmöglichkeiten beachten sollte... bei GIF denke ich sind ein starkes Dithering von Nachteil da es die codierung und somit die datei vergrössert, bei Fotos oder ähnlichem sind ein mitterleres bis starkes Dithering sicherlich von vorteil...
_________________
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen MSN Messenger
Sebastian
Administrator


Anmeldungsdatum: 10.09.2004
Beiträge: 5969
Wohnort: Deutschland

BeitragVerfasst am: 26.07.2012, 13:12    Titel: Antworten mit Zitat

Eternal, aus den Code-Bausteinen könntest du super ein Tutorial oder zumindest ein Code-Beispiel bauen. lächeln Ich könnte mir vorstellen, dass sich das sehr gut als Stoff für ein Tutorial eignen würde. Jeweils der Code plus einige Erklärungen, wie das funktioniert (Median-Cut, Dithering, ...). lächeln
_________________

Der Markt regelt das! | Opas Leistung muss sich wieder lohnen - für 6 bis 10 Generationen!
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden Website dieses Benutzers besuchen
Eternal_pain



Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA

BeitragVerfasst am: 27.07.2012, 03:15    Titel: Antworten mit Zitat

An sowas wie ein Tutorial habe ich schon gedacht (wenn auch weniger daran selbst eins zu schreiben grinsen)
Ich zähle mich nicht unbedingt zu einem 'Schreiberling' und eigne mich nicht wirklich als 'Erklärbär' aber einen Versuch würde ich mal wagen... vorrausgesetzt ich schaff es mal die Funktion so hinzubiegen das ich endlich mal damit zufrieden bin happy

Jede kleine 'umstellung' in den Berechnungen führt zu anderen Ergebnissen und bisher war ich mit noch keinem vollständig zufrieden happy



Links mit Photofiltre reduziert, in der mitte war ein versuch per Labdelta farbvergleich und rechts wie gehabt RGBdelta...
_________________
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
Gehe zu Seite Zurück  1, 2
Seite 2 von 2

 
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