Помогите чайнику разобраться с выбором цвета.

[Захарик]

Есть проблема. Пишу маленькую программку - html-редактор для создания специализированных сайтов для партнёрской программы.
Для выбора пользователем цвета шрифта различных элементов будущего сайта, попробывал использовать ComboBox. Однако в Visual Basic цвет имеет многозначное представление,в то время, как в html - шестнадцатиричное восьмизначное.
Как осуществить перевод выбранного пользователе м цвета в программе в близкий ему цвет в html-документе.

[Хакер]

Код: Выделить всё



Function RGB2Hex(ByVal Color as long)
bgrhex="000000"
RSet bgrhex = Hex(Color)
bgrhex = Replace(bgrhex, " ", "0")
RGB2Hex = "#" + Mid$(bgrhex, 5,2) + Mid$(bgrhex, 3,2) +Mid$(bgrhex, 5,2)
End Function


Используется так

Код: Выделить всё

MsgBox RGB2Hex( RGB( 32, 20, 256)) ' Выдаст #2014FF


[Lumen]

На форуме где-то было разложение цвета в VB по трем составляющим: красный, синий, зелёный.
Алгоритм такой: определяешь, сколько в выбранном тобой цвете красного, сколько зелёного и соотвветственно синего, затем переводишь эти значения в HEX (получится три строки). Получить цвет для HTML кода можно, соединив эти три строки в порядке HEX_RED + HEX_GREEN + HEX_BLUE.

[ADDED]Упс... Опоздал немного...

[Хакер]

Lumen. Мне этот способ жутко не нравится, по сравнению с тем, который я предложил.

Но у автора вопроса должно быть право выбора поэтому вот:

Код: Выделить всё

Function RGB2Hex(ByVal Color as long)
Dim bRed   As Byte
Dim bGreen As Byte
Dim bBlue  As Byte

bRed = (Color And vbRed)
bGreen = (Color And vbGreen) \ 255
bBlue = (Color And vbBlue) \ 255 \ 255

RGB2Hex = "#" + CStr(bRed) + CStr(bGreen) + CStr(bBlue)
End Function


использование функции такое же

[Захарик]

Пока сбасибо. Сейчас попробую въехать, опробовать и всё такое...

[keks-n]

Хакер
Твой последний вариант выдаст, при RGB2Hex(RGB(100, 250, 200)):
#100250201

[keks-n]

И ещё... У тебя он заторможенный... Вот, сравни скорость:
Private Declare Function GetTickCount Lib "kernel32" () As Long

Код: Выделить всё

Sub main()
Dim tk As Long, n As Long, result As String
tk = GetTickCount
For n = 0 To 599999
result = RGB2Hex2(&HA0D0F0)
Next
MsgBox "Мой вариант за " & (GetTickCount - tk) & " миллисекунд выполнился 50000 раз"

tk = GetTickCount
For n = 0 To 599999
result = RGB2Hex(&HA0D0F0)
Next
MsgBox "Твой первый вариант за " & (GetTickCount - tk) & " миллисекунд выполнился 50000 раз"

End Sub

Function RGB2Hex2(ByVal Color As Long) As String
RGB2Hex2 = "#" + Hex$((Color And vbRed)) + Hex$((Color And vbGreen) \ 255) + Hex$((Color And vbBlue) \ 255 \ 255)
End Function


Function RGB2Hex(ByVal Color As Long)
bgrhex = "000000"
RSet bgrhex = Hex(Color)
bgrhex = Replace(bgrhex, " ", "0")
RGB2Hex = "#" + Mid$(bgrhex, 5, 2) + Mid$(bgrhex, 3, 2) + Mid$(bgrhex, 5, 2)
End Function

[Хакер]

...Мой вариант за ...

Во блин, а чем это он твой

[keks-n]

Хакер
Я вообще-то скопировал с модуля, написанного года 2 назад... Это так... К сведению.

[tyomitch]

Код: Выделить всё

Function RGB2Hex2(ByVal Color As Long) As String
RGB2Hex2 = "#" + Hex$((Color And vbRed)) + Hex$((Color And vbGreen) \ 255) + Hex$((Color And vbBlue) \ 255 \ 255)
End Function


Хоть бы проверял код, прежде чем постить?

[Хакер]

угу.

особено RGB(255,0,255)

ЗЫ. А почему у тебя интересно также \ всесто / хотя там всегда целый резульатат. И также \255\255 а не \ 65025

странные совпадения, не правда ли?

[keks-n]

Ну, ладно, преувеличил... Та почти такой же код.

[tyomitch]

Так что? Работающую версию RGB2Hex2 запостите, или это будет задача для самостоятельного решения?

[Хакер]

А чё тут думать то

Код: Выделить всё

Function RGB2Hex(ByVal Color as long)
RGB2Hex = "#" + Format$(Hex$(Color And vbRed) , "00") + _
Format$(Hex$((Color And vbGreen) \ 255),"00") + _
Format$(Hex$((Color And vbBlue) \ 65025), "00")
End Function


Добавлено:

вот ещё 1 вариант:

Код: Выделить всё

Function RGB2Hex(ByVal Color As Long)
Dim hexval As String * 6
RSet hexval = Hex$(RGB((Color And vbBlue) \ 65025, (Color And vbGreen) \ 255, (Color And vbRed)))
RGB2Hex = "#" + Replace(hexval, " ", "0")
End Function


[tyomitch]

Теперь RGB2Hex(RGB(255, 0, 255)) возвращает "#FF00101".
Тебя это устраивает?

[Хакер]

Нифига. Только что проверил. #FF00FF.

[vvs_adm]

Да не может твоя функция возвращать #FF00FF, потому что там две ошибки. Точнее полторы, потому что вторая вытекает из первой.

И также \255\255 а не \ 65025
странные совпадения, не правда ли?

Как там у нас в бриллиантовой руке... Странные, если не сказать больше

[vvs_adm]

И зачем вообще извращаться, если можно написать

Код: Выделить всё

Private Function RGB2Hex(ByVal Color As Long) As String
    RGB2Hex = "#" & Format$(Hex$(Color), "000000")
End Function

[keks-n]

vvs_adm
Скорость... Строковые операции выполняются медленнее.

[vvs_adm]

vvs_adm
Скорость... Строковые операции выполняются медленнее.

Т.е. твой неработающий код с тремя хексами и тройным сложением строк работает быстрее моего "со строковыми операциями"? Надо проверить

P.S. ну вообще проверка показала, что

Код: Выделить всё

Right$("000000" & Hex$(Color),6)

гораздо быстрее, чем format$ и в пару раз быстрее, чем твой неработающий код. А что касается кода Хакера, то даже не надо проверять, что format$ вместо right$ всё таки, по идее, быстрее, чем три формата.

[keks-n]

Убедил... Кстати, нашёл тот модуль о котором говорил... Там использовалась такая конструкция:

Код: Выделить всё

Function RGB2Hex(color As Long) As String
RGB2Hex = "#" + Hex$(color And &HFF) + Hex$((color And &HFF00) / &H100 And &HFF) + Hex$((color And &HFF0000) / &H10000)
End Function

Которая таки медленнее...

[Захарик]

Lumen. Мне этот способ жутко не нравится, по сравнению с тем, который я предложил.

Но у автора вопроса должно быть право выбора поэтому вот:

Код: Выделить всё

Function RGB2Hex(ByVal Color as long)
Dim bRed   As Byte
Dim bGreen As Byte
Dim bBlue  As Byte

bRed = (Color And vbRed)
bGreen = (Color And vbGreen) \ 255
bBlue = (Color And vbBlue) \ 255 \ 255

RGB2Hex = "#" + CStr(bRed) + CStr(bGreen) + CStr(bBlue)
End Function


использование функции такое же

Всё Огромноре спасибо. Получил, что хотел. Программа работает..

[keks-n]

Захарик
Юзай вариант от vvs_adm-он быстрее и компактнее.

[Хакер]

И зачем вообще извращаться, если можно написать

Код: Выделить всё

Private Function RGB2Hex(ByVal Color As Long) As String
    RGB2Hex = "#" & Format$(Hex$(Color), "000000")
End Function

Круто, вот только функцию переименуй в BGR...

[Хакер]

Покажите мне хоть один рабочий вариант от vss_adm

[vvs_adm]

Так вот зачем извращаться А я проверил, как Тёмыч и просил, на RGB(255, 0, 255) Ну тогда все равно формат замени на Right$, но самое главное - 255 на 256

[keks-n]

Гы... Не проверял. Но моя конструкция, по сравнению с тем, что выбрал Захарик на 11.5% быстрее

Код: Выделить всё

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

Sub main()
Dim tk As Long, n As Long, result As String
tk = GetTickCount()
For n = 0 To 599999
result = RGB2Hex2(&HA0D0F0)
Next
MsgBox "Ìîé âàðèàíò çà " & (GetTickCount - tk) & " ìèëëèñåêóíä âûïîëíèëñÿ 50000 ðàç"

tk = GetTickCount
For n = 0 To 599999
result = RGB2Hex(&HA0D0F0)
Next
MsgBox "Òâîé âàðèàíò çà " & (GetTickCount - tk) & " ìèëëèñåêóíä âûïîëíèëñÿ 50000 ðàç"

End Sub

Function RGB2Hex2(color As Long) As String
RGB2Hex2 = "#" + Hex$(color And &HFF) + Hex$((color And &HFF00) / &H100 And &HFF) + Hex$((color And &HFF0000) / &H10000)
End Function

Function RGB2Hex(ByVal color As Long)
Dim bRed   As Byte
Dim bGreen As Byte
Dim bBlue  As Byte

bRed = (color And vbRed)
bGreen = (color And vbGreen) \ 255
bBlue = (color And vbBlue) \ 255 \ 255

RGB2Hex = "#" + CStr(bRed) + CStr(bGreen) + CStr(bBlue)
End Function

[Хакер]

Вот блин народ. Вот, суммарный код:

Код: Выделить всё

Function RGB2Hex(ByVal Color As Long)
RGB2Hex = "#" + Right$("000000" + Hex$(RGB((Color And vbBlue) \ 65536, (Color And vbGreen) \ 256, (Color And vbRed))), 6)
End Function


И нафиг тут мерить скорость. Если это делается только при List1_Click.

Ну нафиг здесь скорости вы мне объясните.

[vvs_adm]

keks-n да неправильно они у тебя склеиваются!!! У тебя RGB(5,17,5) вернет 5115, а должна 051105.

[tyomitch]

Нет, ну Хакеру трое показывали на 65025 в коде, который он выдавал за рабочий, а он потом ещё возмущается.