PDA

Vollständige Version anzeigen : Farbe aus einer ID berechnen


struppi
03.11.2001, 08:57
Hallo
Wer hat eine gute Idee?
Ich möchte aus der ID eines Datensatzes eine Farbe berechnen lassen.
Bedingung:
1.Auch bei Erhöhung der ID um 1 soll ein sofort sichtbarer Farbunterschied zur vorherig berechneten Farbe zu sehen sein.
2.Keine Zufallsgeschichten - Es muß sich zu jeder Zeit aus der ID wieder die selbe Farbe berechnen lassen.
3.Nach ca 100 Datensätzen darf auch eine schon existierende Farbe wieder entstehen.

Ich habe zwar schon Vorstellungen wie man aus RGB(255, 255, 255) durch wechselnde Änderung der Zahlen eine neue Farbe erhält.
Aber der richtig geniale Einfall (einfach und zuverlässsig) fehlt noch.
Vielleicht hat jemand so etwas Ähnliches schon mal gemacht oder gesehen oder einfach eine gute Idee.

Würde mich freuen, vielen Dank
Struppi

erwin
03.11.2001, 12:08
sicher nicht optimal, aber mal so als ausbaufähige Gedankenstütze:
Public Function MyColor(ID As Long) As Long
Dim r%, g%, b%
Dim h%
h = Val(Right(Format(Abs(ID - 1), "00"), 2))
Select Case (h Mod 3)
Case 0
r = h * 2.5757: g = Abs((h * 2.5757) - 127): b = h / 2
Case 1
r = (h + 99) * 1.2878: g = Abs((h * 2.5757) - 65): b = h * 2
Case 2
r = Abs((h - 50) * 5.1): g = Abs((h * 2.5757) - 127): b = Abs((h - 50) * 3)
Case Else
r = 255: g = 255: b = 255
End Select
MyColor = RGB(r, g, b)
End Function

so long erwin...

AWSW
03.11.2001, 12:21
Das ist ja mal eine witzige Idee...

PS: Glückwunsch Erwin zum 333ten Beitrag :D

struppi
03.11.2001, 13:03
Hallo Erwin
Recht vielen Dank für die Mühe.
Klappt wunderbar!
So als Lacher kopiere ich mal meinen alten Code hier rein:

Public Function Farbe(index As Long) As Long
Dim indexNeu As Long
Dim R1, G1, B1, i As Integer
R1 = 128
G1 = 64
B1 = 8

If (Len(CStr(index))) <= 2 Then
indexNeu = index
Else
indexNeu = CLng(Mid(CStr(index), CLng(Len(CStr(index)) - 1)))
End If

indexNeu = IIf(indexNeu < 0, indexNeu * -1, indexNeu)

For i = 0 To indexNeu
R1 = IIf(R1 <= 255 - 8, R1 + 16, 8)
G1 = IIf(G1 <= 255 - 8, G1 + 16, 64)
B1 = IIf(B1 <= 255 - 8, B1 + 16, 128)
Next
Farbe = RGB(R1, G1, B1)
End Function

Geht auch aber die Schleife ist irgendwie blöd und die Variablen-Umwandlungen.....

Also nochmal Danke für die schnelle
Hilfe.
Gruß struppi

struppi
03.11.2001, 13:57
Hallo
Ich hätte da noch eine Frage...
Finde leider nix mit "Suchen".
Wie erhalte ich denn jetzt die gegensätzliche Farbe zu der neu berechneten?
Also die Farbe die bei markieren des Feldes entsteht.
Ich muß doch die Schriftfarbe noch anpassen...

Danke!
Gruß Struppi

erwin
03.11.2001, 18:46
sollte doch eigentlich

RGB(255 - r, 255 - g, 255 - b) sein.

so long erwin...

struppi
03.11.2001, 19:18
Hallo Erwin
Das hatte ich mir anfangs auch gedacht..
Klappt aber nicht mit allen Farbe, kein Ahnung warum?

Danke und Grüße
struppi

erwin
04.11.2001, 08:43
vielleicht deshalb, weil bei 50% Grau die Komplementärfarbe auch 50% Grau ist.

Dazu müsstest du die o.a. Fu. so abwandeln, dass "mittlere" Einzelfarbanteile (ca. 90 - 160) nicht als Ergebnis auftreten, oder überhaupt das Konzept ändern, indem du i.e Tab. einmalig eine "hübsche" Folge von 100 verschiedenen Farben enträgst und diese per MyColor(ID) zurückgibst.

so long erwin...

struppi
04.11.2001, 10:51
Hallo Erwin
Das Konzept ...habe ich noch mal überdacht.
Ich benutze jetzt die 256 Grundfarben. Da geht es einigermaßen mit der Schrift. Vielleicht setze ich nochmal eine Bedingung für die Schrift wenn der Kontrast zu niedrig ist.
Die Farben lese ich jetzt doch mit Schleife aus.. egal :-)

For i = 0 To indexNeu
If R1 <= 255 - 51 Then
R1 = R1 + 51
Else
If G1 <= 255 - 51 Then
G1 = G1 + 51
R1 = 0
Else
If B1 <= 255 - 51 Then
B1 = B1 + 51
G1 = 0
Else
R1 = 0
G1 = 0
B1 = 0
End If
End If
End If
Next

Danke für Deine Hilfe!
Macht wirklich Spaß das Forum abzuhören..
Gruß struppi