[VB] Gradient laten kiezen door gebruiker.

[Verwijderd]

Ok, ben bezig met een proggie, en wil daarbij zelf de gebruiker een gradient laten kiezen van text. Het word een soort van HTMLeditor, en de RGB2HEX-kleur daar heb ik een routine voor die goed werkt.

De gebruiker kiest dus zelf 2 kleuren die hij naar een overloop wil hebben, en een overloop bestaat uit 4 kleuren dus >> Gebruikersgekozenkleur >> een kwart daarvanaf > De helft daarvanaf >> Andere GEbruikersgekozenkleur.

Nu heb ik best een aardige routine, maar weet niet hoe ik nu verder moet om de 4 kleuren daaruit te halen. Als ik dit gebruik, geeft hij in mijn textbox 4 dezelfde kleuren in plaats van 4 verschillende.

Visual Basic:

Option Explicit
Private Type TypeRGB        'This user type is used to convert long decimals to Bytes
    r As Byte
    G As Byte
    b As Byte
End Type

Private Type TypeLong       'This user type is used to convert long decimals to Bytes
    RGBColor As Long
End Type


Private Function MaakGradient(ByVal Text As String, Color1 As Long, Color2 As Long)


Dim count As Long, i As Long
'count = Len(Text) + 1: If count = 1 Then Exit Function

Dim r1 As Integer, r2 As Integer
Dim g1 As Integer, g2 As Integer
Dim b1 As Integer, b2 As Integer

Dim Col1 As TypeRGB, Col2 As TypeRGB

Col1 = RGB2typeRGB(Color1)
Col2 = RGB2typeRGB(Color2)

r1 = Col1.r: g1 = Col1.G: b1 = Col1.b
r2 = Col2.r: g2 = Col2.G: b2 = Col2.b

Dim rD As Integer, gD As Integer, bD As Integer
Dim rF As Integer, gF As Integer, bF As Integer

Dim s As String, Code As String, out As String

rD = r1 - r2
gD = g1 - g2
bD = b1 - b2

    For i = 1 To 4
       
        
        'rf = Int(IIf(rd < 0, r1 + Int(Abs(rd / Ccount * i)), r1 - Int(Abs(rd / Ccount * i)))) Mod 255
        'gf = Int(IIf(gd < 0, r1 + Int(Abs(gd / Ccount * i)), r1 - Int(Abs(gd / Ccount * i)))) Mod 255
        'bf = Int(IIf(bd < 0, r1 + Int(Abs(bd / Ccount * i)), r1 - Int(Abs(bd / Ccount * i)))) Mod 255
        
        rF = Int(r1 - (rD / i * i)) 'Mod 255
        gF = Int(g1 - (gD / i * i)) 'Mod 255
        bF = Int(b1 - (bD / i * i)) 'Mod 255

        If rD = 0 Then rF = r1
        If gD = 0 Then gF = g1
        If bD = 0 Then bF = b1
        
        On Error Resume Next
     Text1.Text = Text1.Text & RGB2HTML(RGB(rF, gF, bF)) & vbCrLf
    
    
    
    
    Next i
End Function

Function RGB2HTML(ByVal RGBColor As Long) As String

Dim tmpCol As TypeRGB

With tmpCol
.r = RGBColor Mod 256
.G = (RGBColor \ 256) Mod 256
.b = RGBColor \ 65536
End With

Dim RString As String, GString As String, BString As String

RString = Trim(Hex$(tmpCol.r))
GString = Trim(Hex$(tmpCol.G))
BString = Trim(Hex$(tmpCol.b))

If Len(RString) = 1 Then RString = "0" & RString
If Len(GString) = 1 Then GString = "0" & GString
If Len(BString) = 1 Then BString = "0" & BString

RGB2HTML = "#" & RString & GString & BString

End Function

Function HTML2RGB(ByVal sHexColor As String) As Long
    Dim lCol As Long, i, n
    If Left(sHexColor, 1) = "#" Then sHexColor = Mid(sHexColor, 2)
    sHexColor = UCase(sHexColor)
    
    For i = 1 To Len(sHexColor) Step 2
        lCol = lCol + Dec(Mid(sHexColor, i, 2)) * 256 ^ n
        n = n + 1
    Next i
    HTML2RGB = lCol
End Function

Private Function RGB2typeRGB(ByVal RGBColor As Long) As TypeRGB
With RGB2typeRGB
.r = RGBColor Mod 256
.G = (RGBColor \ 256) Mod 256
.b = RGBColor \ 65536
End With
End Function

Private Function HTML2typeRGB(ByVal HTMLColor As String) As TypeRGB
Dim temp As String
temp = HTML2RGB(HTMLColor)
Dim out As TypeRGB
out = RGB2typeRGB(temp)
With HTML2typeRGB
.r = out.r
.G = out.G
.b = out.b
End With
End Function

Private Sub Command1_Click()
MaakGradient Text1.Text, 255, 16744576

End Sub

Dit is zo een beetje de code... ik kies dus ROOD en PAARS, onder command_click, maar hij geeft 4 dezelfde kleuren weer in de textbox daarna...bij dit voorbeeld : #8080FF 4 x...

Volgens mij zou hij op deze manier moeten werken, maar niet dus....
Als iemand ff tijd heb om hiernaar te kijken, graag.

[Glimi]

Welkom in P&W -> Quickstart (update 2/10/2002)
Geef even aan wat meer informatie wat er niet goed gaat. Draai de boel met de debugger, isoleer de fout, bekijke welke methode het is, bij welke waardes, wat het verband is ed ed.
Zou je daarom wat meer info kunnen posten en de fout wat meer kunnen isoleren?
Nu komt het nl. over als 'ik snap het niet- snel op GoT posten!!', wat niet echt de bedoeling is

[WildernessChild]

Het relevante stukje code:

code:

rD = r1 - r2
gD = g1 - g2
bD = b1 - b2

    For i = 1 To 4
        
        rF = Int(r1 - (rD / i * i)) 'Mod 255
        gF = Int(g1 - (gD / i * i)) 'Mod 255
        bF = Int(b1 - (bD / i * i)) 'Mod 255

        If rD = 0 Then rF = r1
        If gD = 0 Then gF = g1
        If bD = 0 Then bF = b1
        
        On Error Resume Next
        Text1.Text = Text1.Text & RGB2HTML(RGB(rF, gF, bF)) & vbCrLf

    Next i
End Function

Logisch dat ze dezelfde kleuren geven... je rF etc. hangen niet af van loopcounter i, want je doet / i en dan gelijk weer * i dus dat valt weg...
Wat je moet doen is gewoon * i / 3 en dan i van 0 tot 3 laten lopen. Bij i=0 is het dan rD * 0 / 3 dus gewoon r1 dus je eerste kleur;
Bij i=3 is het rD * 3 / 3 dur rD dur r1 - rD dus r1 - (r1 - r2) dus r2;
Bij i=1 of i=2 ertussenin;
Dus precies wat je wilde.

edit:
layoutvern**king met commentaar is wat zonde

[ Voor 21% gewijzigd door WildernessChild op 26-03-2003 14:59 ]

[Verwijderd]

Glimi schreef op 26 March 2003 @ 14:49:
Welkom in P&W -> Quickstart (update 2/10/2002)
Geef even aan wat meer informatie wat er niet goed gaat. Draai de boel met de debugger, isoleer de fout, bekijke welke methode het is, bij welke waardes, wat het verband is ed ed.
Zou je daarom wat meer info kunnen posten en de fout wat meer kunnen isoleren?
Nu komt het nl. over als 'ik snap het niet- snel op GoT posten!!', wat niet echt de bedoeling is

ik ga het snel op GoT posten want ik snap het niet???
Ik zit hier al UREN aan, vriend.

[Verwijderd]

WildernessChild, heel netjes vriend, heel netjes..
Maar nu krijg ik 3 kleuren ipv 4... Als ik hem door 4 deel krijg ik 4 kleuren, maar de laatste is dan nogal erg afwijkend van de rest... oftewel de gradient klopt niet meer.

[whoami]

Verwijderd schreef op 26 March 2003 @ 15:08:
[...]


ik ga het snel op GoT posten want ik snap het niet???
Ik zit hier al UREN aan, vriend.

Wel beste vriend, doordat je hier alle code zo maar post ipv enkel de relevante krijgt men bij dit topic idd de indruk dat je hier gewoon maar je code post en hoopt dat iemand anders voor jou ze zal gaan debuggen.
Daarnaast geef je ook niet aan of je al eens gedebugged hebt, of wat je verder zelf al geprobeerd hebt.
Als je er idd al uren hebt aangezeten, dan kunnen wij dat niet weten.

[WildernessChild]

code:

rD = r1 - r2
gD = g1 - g2
bD = b1 - b2

    For i = 0 To 3
        
        rF = Int(r1 - (rD * i / 3))
        gF = Int(g1 - (gD * i / 3))
        bF = Int(b1 - (bD * i / 3))

        Text1.Text = Text1.Text & RGB2HTML(RGB(rF, gF, bF)) & vbCrLf

    Next i
End Function

Hoezo krijg je 3 kleuren? Gewoon echt maar 3 of 4 met 2 gelijke?
Iig, zoals het hierboven staat moet het werken IMHO. Het zou kunnen dat hier en daar nog wat afrondingsfoutjes optreden, maar dat zou je met het blote oog niet moeten merken.
BTW, ik heb die If rD=0... etc regels er ook uit gehaald, die zijn niet meer nodig nu.

edit:
En die Mod's kunnen ook weg, commentaar of niet

edit:
En On error is ook niet nodig

[ Voor 15% gewijzigd door WildernessChild op 26-03-2003 15:27 ]

[Verwijderd]

Edit

[ Voor 117% gewijzigd door Verwijderd op 26-03-2003 15:52 . Reden: Niet relevant meer ]

[Verwijderd]

Ja, jouw stukje werkt... Zie je niet dat de laatste kleur dan heel erg afwijkt?? neem FEL geel, en FEL blauw

[ Voor 8% gewijzigd door Verwijderd op 26-03-2003 15:40 . Reden: sfd ]

[WildernessChild]

Ik kan het hier niet testen, dus ik zie niets... post eens de hexwaarden die hij in de textbox dumpt? Dat zou moeten zijn, uit de losse pols:
#FFFF00 (fel geel)
#AAAA55
#5555AA
#0000FF (fel blauw)
Klopt dit een beetje?

[ Voor 38% gewijzigd door WildernessChild op 26-03-2003 16:01 ]

[Verwijderd]

#00FF00
#55FF00
#AAFF00
#FFFF00

[WildernessChild]

Kloppen de eerste en laatste kleur met de kleuren die je had ingesteld? Dit gaat van felgroen naar felgeel hoor...

[Verwijderd]

WildernessChild schreef op 26 maart 2003 @ 15:58:
Ik kan het hier niet testen, dus ik zie niets... post eens de hexwaarden die hij in de textbox dumpt? Dat zou moeten zijn, uit de losse pols:
#FFFF00 (fel geel)
#AAAA55
#5555AA
#0000FF (fel blauw)
Klopt dit een beetje?

Ja dat had ik drnet.. waardoor die geel afsteekt tegen het blauwe
die vorige post van mij, heb ik het met groen gedaan... daarmee steekt geel ook heel erg af.. de laatste/eerste waarde, hoe je het noemen wil. iig Geel

[WildernessChild]

Jah wat wil je ook, in 3 stappen van geel naar blauw lopen gaat ook wat sprongsgewijs natuurlijk.

[Verwijderd]

ja, maar het zou wel iets beter verdeeld kunnen worden... het hoeft niet vloeiend, ik ben ff aant kloten met die waarden... maar als je me eruit kan helpen... top!

[WildernessChild]

Nou, als je alle 3'en in 10'en verandert gaat het al beter, of maak er een variabele van die je aan je functie meegeeft. Dat is natuurlijk het mooiste.
Ik ga er nu vandoor, dus nog veel succes ermee!

[Glimi]

Waarom werk je eigenlijk met RGB ipv HSB met dit model? Ik vind RGB hier nooit zo geschikt voor omdat de schaal niet echt loopt op een manier die dit soort overgangen in acht neemt (qua mooiheid voor de mens)

Verder schreef ik in mijn eerste reactie 'lijkt'. Ik vroeg je dus vriendelijk om aan te geven dat het niet zo was. Dan hoef je niet zo vijandig te antwoorden hoor

[Verwijderd]

Glimi schreef op 26 March 2003 @ 18:41:
Waarom werk je eigenlijk met RGB ipv HSB met dit model? Ik vind RGB hier nooit zo geschikt voor omdat de schaal niet echt loopt op een manier die dit soort overgangen in acht neemt (qua mooiheid voor de mens)

Kan dat in VB?? Nog nooit van gehoord, zal is een blik werpen

Verder schreef ik in mijn eerste reactie 'lijkt'. Ik vroeg je dus vriendelijk om aan te geven dat het niet zo was. Dan hoef je niet zo vijandig te antwoorden hoor

Sorrie