---

Hallo miteinander,

bin gerade dabei ein kleines VBA-Prog zu schreiben, welches mir die WindowsFarbe, welche ich über ShowColor bekomme, in eine RGB-Farbe umwandelt und letztlich eine ACADfarbe auswirft.

Code:

---

Function start_prog()

Dim strWert As String
Dim lWert As Long
Dim hexWert As String

Dim R As String, G As String, B As String

Dim Abfrage As Recordset
Dim db As Database

Set db = OpenDatabase("K:\ACAD-Color.mdb")

strWert = InputBox("Windows-Farbwert eingeben", "WINcol 2 ACADcol")
lWert = CLng(strWert)
hexWert = Hex(lWert)

R = Left(hexWert, 2)
G = Mid(hexWert, 3, 2)
B = Mid(hexWert, 5, 2)

If G = "" Then G = "00"
If B = "" Then B = "00"

On Error GoTo err_Farbe

Set Abfrage = db.OpenRecordset("SELECT ACAD2RGB.ACADCol, ACAD2RGB.RR, ACAD2RGB.GG, ACAD2RGB.BB FROM ACAD2RGB WHERE (((ACAD2RGB.RR)=" & Val("&h" & R) & ") AND ((ACAD2RGB.GG)=" & Val("&h" & G) & ") AND ((ACAD2RGB.BB)=" & Val("&h" & B) & "))")

MsgBox "Die ACADfarbe sollte heißen " & Abfrage.Fields(0)

exit_farbe:
Exit Function

err_Farbe:
MsgBox "Leider gibtŽs die Farbe nicht ... ;("
Resume exit_farbe

End Function

---

Das Problem an der Sache ist nun, wenn ich hier zahlen eingebe, es einfach mal zu Problemen kommt.
Zum Beispiel ergeben die Zahlen 65280(grün) und 255(rot) einfach mal ein und die selbe ACADFarbe, sprich den selben RGB-Wert. Genauso wie 16776960(Cyan) und 65535(gelb). Als Tabelle in der Datenbank ist die Tabelle von der AutodeskSeite mit dem Wert 256 multipliziert hinterlegt.

Das ich nicht zig 1000 WindowsFarben in 255 AutocadFarben unterbekomme ist mir auch klar, aber zum größten Teil müßte es ja wenigstens hinhauen. Oder irre ich mich da jetzt???

... vielleicht jemand ne Idee ??? 

Gruß TP

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

wird in windows die farbe nicht im modus BGR gespeichert

rot = FF
grün = FF00
blau = FF0000

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

probier mal folgendes

Private Sub Form_Load()

    strWert = InputBox("zahl eingeben")
   
    lWert = CLng(strWert)
    hexwert = Padl(Hex(lWert), 6, "0") ' mit padl auf 6 stellen erweitern

    b = Mid$(hexwert, 1, 2)
    g = Mid$(hexwert, 3, 2)
    r = Mid$(hexwert, 5, 2)

End Sub

Function Padl(text, länge, Füllstring)
    Dim a1
    a1 = Len(text)
    If a1 = länge Then
        Padl = text
    ElseIf a1 > länge Then
        Padl = Right$(text, länge)
    Else
        Padl = String(länge - a1, Füllstring) & text
    End If
End Function

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

dicken Einser, wie immer ... 

Danke ... muß erstmal kuckn, was Du da jetzt besser/anders machst als ich.

BGR - habŽs irgendwo gelesen. hatte mich dann aber auch nicht zum Ziel gebracht.

Vielen Dank ... lg TP

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

eigentlich nichts anderes , ausser dass ich mit blau von links ins lesen beginne

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

dein fehler ist

r = left(hexwert,2)

bei rot (FF) stimmts
bei grün (FF00) stimmts nicht
und bei blau (FF0000) schon gar nicht

mit meiner funktion PADL fülle ich linksbündig den strin mit 0 auf 6 stellen auf

rot  0000FF
grün 00FF00
blau FF0000

dann kannst mit mid$(hexwert,1,2) blau
mid$(hexwert ,3,2) grün
und mit$(hexwert,5,2) rot auslesen

------------------

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Sorry, daß ich erst so spät antworte, bin leider noch nicht dazu gekommen, mich quält gerade mal wieder ein anderes Problem.
Hab vielen Dank, aber ich muß mir das bei Gelegenheit und in Ruhe mal anschauen.

DANKE ... Gruß TP

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP