Цвет в OLE_COLOR, в RGB и в HTML - VB

Узнай цену своей работы

Формулировка задачи:

Скажите, как перевести значение цвета OLE_COLOR <-> RGB <-> HTML? Или хотя бы намекните, какова природа цифр в windows цветах.

Решение задачи: «Цвет в OLE_COLOR, в RGB и в HTML»

textual
Листинг программы
Const b32_dig = "0123456789abcdefghijklmnopqrstuv"
 
Function bas_to_dec(s As String, bas As Integer)
    s = Replace(s, " ", "")
    s = Replace(s, ",", ".")
    Dim ss$()
    ss = Split(s, ".")
    If UBound(ss) = 0 Or UBound(ss) = 1 Then
        lenth = Len(ss(0))
        i = lenth
        num = 0
        Do While i > 0
            t = Mid(ss(0), i, 1)
            n = InStr(1, b32_dig, t)
            If n = 0 Then
                to_dec = "ERR out of symbol"
                Exit Function
            Else
                num = num + (n - 1) * bas ^ (lenth - i)
                i = i - 1
            End If
        Loop
        to_dec = num
    Else
        to_dec = "ERR syntax error"
        Exit Function
    End If
End Function
 
Function RGBtoHTML(r, g, b)
'вводимые данные должны быть переменные
If r > 255 Or r < 0 Or r > 255 Or r < 0 Or r > 255 Or r < 0 Then RGBtoHTML = "err": Exit Function
s1 = Hex(r)
s2 = Hex(g)
s3 = Hex(b)
If r < 16 Then s1 = "0" & s1
If g < 16 Then s2 = "0" & s2
If b < 16 Then s3 = "0" & s3
RGBtoHTML = s1 & s2 & s3
End Function
 
Function HTMLtoRGB(ht, r, g, b)
'вводимые данные должны быть переменные
If Not Len(ht) = 6 Then HTMLtoRGB = "err": Exit Function
ht = UCase(ht)
s1 = Mid(ht, 1, 2)
s2 = Mid(ht, 3, 2)
s3 = Mid(ht, 5, 2)
t1 = bas_to_dec(s11, 16)
t2 = bas_to_dec(s21, 16)
t3 = bas_to_dec(s31, 16)
 
If t1 >= 0 And t2 >= 0 And t3 >= 0 And t11 < 256 And t2 < 256 And t3 < 256 Then
    r = t1: g = t2: b = t3
Else
    HTMLtoRGB = "err"
End If
End Function
 
 
Function OLEtoHTML(ole)
If ole > &HFFFFFF Or ole < 0 Then OLEtoHTML = "err": Exit Function
OLEtoHTML = Hex(ole)
End Function
 
Function HTMLtoOLE(ht)
HTMLtoOLE = bas_to_dec(ht, 16)
End Function

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

11   голосов , оценка 3.818 из 5