Das deutsche QBasic- und FreeBASIC-Forum :: Thema anzeigen

Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!

FAQ

Suchen

Mitgliederliste

Benutzergruppen

Registrieren

Profil

Einloggen, um private Nachrichten zu lesen

Zur Begleitseite des Forums / Chat / Impressum

Aktueller Forenpartner:

Farbverlauf

Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC.

Vorheriges Thema anzeigen :: Nächstes Thema anzeigen

Autor

Nachricht

storky

Anmeldungsdatum: 06.01.2013
Beiträge: 68

Verfasst am: 04.06.2013, 14:07 Titel: Farbverlauf

Hallo,

ich versuche seit Stunden eine Funktion zu bauen die mir einen Farbverlauf berechnen kann. Ich poste erstmal den Quelltext.

Code:

Function genColor(last As Integer) As Integer
Open Cons For Output As #1
Dim As UByte Ptr colorPtr
Dim As UByte Ptr lastcPtr
Dim As UByte Ptr cccPtr
Dim As UByte r, g, b
Dim As uByte rr, gg, bb
Dim As integer test

Dim As UByte cr, cg, cb

colorPtr = @newColor
lastcPtr = @last
cccPtr = @ccc

r = Peek(colorPtr)
g = Peek(colorPtr + 1)
b = Peek(colorPtr + 2)

rr = Peek(lastcPtr)
gg = Peek(lastcPtr + 1)
bb = Peek(lastcPtr + 2)

If Not r = rr Then
   test = rr-r
   fr += test*test/100
EndIf

If Not g = gg Then
   test = gg-g
   fg += test*test/100
EndIf

If Not b = bb Then
   test = bb-b
   fb += test*test/100
EndIf

ccc = CInt(fr)
rr = Peek(cccPtr)
ccc = CInt(fg)
gg = Peek(cccPtr)
ccc = CInt(fb)
bb = Peek(cccPtr)

Poke cccPtr + 0, rr
Poke cccPtr + 1, gg
Poke cccPtr + 2, bb

Print #1, String(8-Len(Hex(ccc)), "0") & Hex(ccc) & " " & String(8-Len(Hex(newcolor)), "0") & Hex(newcolor)

If ccc = newcolor Or first = 0 Then
   Print #1, "new"
   newColor = cVal(cIndex)
   r = Peek(colorPtr)
   g = Peek(colorPtr + 1)
   b = Peek(colorPtr + 2)
   first = 1
   cIndex +=1
   If cIndex = 8 Then cIndex = 0
   Print #1, newColor
   ccc=0
EndIf

Close #1
sleep
Return ccc

End Function

^^Das hatte mal ansatzweiße funktioniert, nun geht da gar nix mehr und ich bin zu verwirrt. Also, ich möchte dass immer ein Farbverlauf zwischen den Farbwerten im Array zustande kommt. Damit aber kein Flackern entsteht wenn zb Farbe 0055CC zu Farbe 00FFFF werden soll (da ja der letzte Kanal eine kleinere Differenz hat), sollen die Känale in der Geschwindigkeit abhängig vom Unterschied steigen/sinken.

Deswegen versuche ich den Wert in einem Float zu berechnen und immer das volle Byte vom FLoat in den ULong zu poken. Aber wie gesagt, langsam weiß ich nicht mehr...

Guckt einfmach mal, wär super.
Danke

Edit: Einmal auf neuststen Stand geupdated, man sieht nun in der Konsole, dass es ansatzweiße klappt, aber das keine richtige quadratische Funktion ist, er auch mal übser Ziel hinausschießen kann und dann von hinten nochmal neu loslegt.

Nach oben

Eternal_pain

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

Verfasst am: 05.06.2013, 10:25 Titel:

Vielleicht hilft Dir mein kleines Beispiel:

Code:

Sub GradientW(byref fromX as Integer , byref fromY as Integer, byref toX as Integer, byref toY as Integer, _
byref color1 as UInteger, byref color2 as UInteger)

Dim Com1A as Integer = hibyte(hiword(color1))
Dim Com1R as Integer = lobyte(hiword(color1))
Dim Com1G as Integer = hibyte(loword(color1))
Dim Com1B as Integer = lobyte(loword(color1))

Dim Com2A as Integer = hibyte(hiword(color2))
Dim Com2R as Integer = lobyte(hiword(color2))
Dim Com2G as Integer = hibyte(loword(color2))
Dim Com2B as Integer = lobyte(loword(color2))

Dim as Double DifA = (Com2A-Com1A) / (toX-fromX)
Dim as Double DifR = (Com2R-Com1R) / (toX-fromX)
Dim as Double DifG = (Com2G-Com1G) / (toX-fromX)
Dim as Double DifB = (Com2B-Com1B) / (toX-fromX)

For X as Integer = 0 to (toX-fromX)
Com2A = Com1A + (DifA * X)
Com2R = Com1R + (DifR * X)
Com2G = Com1G + (DifG * X)
Com2B = Com1B + (DifB * X)

line (fromX+X,fromY)-(fromX+X,toY),RGBA(Com2R,Com2G,Com2B,Com2A)
Next X
End Sub

screenres 640,480,32
GradientW (0,0,639,479,&hFFFF0000,&hFF0000FF)

sleep

_________________

Nach oben

storky

Anmeldungsdatum: 06.01.2013
Beiträge: 68

Verfasst am: 06.06.2013, 22:48 Titel:

Danke, macht genau das was ich wollte Und sogar was neues gelernt (hibyte, lobyte, ..) Thx.

Nach oben

Beiträge der letzten Zeit anzeigen:

	Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC.	Alle Zeiten sind GMT + 1 Stunde
Seite 1 von 1

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