|
Поговорим о...
|
|
| AleXStam | Дата: Вторник, 2025-06-24, 13:55 | Сообщение # 121 |
Генералиссимус
Группа: Администраторы
Сообщений: 189
Награды: 1
Репутация: 10003
Статус: Оффлайн
| Function RGBAToHex(R As Integer, G As Integer, B As Integer, Optional A As Integer = 255) As String
' Преобразует RGBA в HEX-формат #AARRGGBB
' A (альфа) — опциональный параметр (по умолчанию 255 = непрозрачный)
' Проверка на допустимые значения (0–255)
If R < 0 Or R > 255 Or G < 0 Or G > 255 Or B < 0 Or B > 255 Or A < 0 Or A > 255 Then
RGBAToHex = "Invalid RGBA value (0-255)"
Else
RGBAToHex = "#" & Right("0" & Hex(A), 2) & _
Right("0" & Hex®, 2) & _
Right("0" & Hex(G), 2) & _
Right("0" & Hex(B), 2)
End If
End Function
|
|
|
| |
| AleXStam | Дата: Вторник, 2025-06-24, 14:19 | Сообщение # 122 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 189
Награды: 1
Репутация: 10003
Статус: Оффлайн
| Function RGBAToHex(R As Integer, G As Integer, B As Integer, Optional A As Integer = -1) As String
' Конвертирует RGBA в HEX, но без #FF, если альфа=255 (полная непрозрачность)
' A = -1 — значит альфа не указана, и её не нужно добавлять
' Проверка на допустимые значения (0–255)
If R < 0 Or R > 255 Or G < 0 Or G > 255 Or B < 0 Or B > 255 Or (A <> -1 And (A < 0 Or A > 255)) Then
RGBAToHex = "Invalid RGBA value (0-255)"
Exit Function
End If
' Если альфа НЕ указана (A = -1) или альфа=255 (полная непрозрачность), выводим #RRGGBB
If A = -1 Or A = 255 Then
RGBAToHex = "#" & Right("0" & Hex®, 2) & _
Right("0" & Hex(G), 2) & _
Right("0" & Hex(B), 2)
' Если альфа указана и не равна 255, выводим #AARRGGBB
Else
RGBAToHex = "#" & Right("0" & Hex(A), 2) & _
Right("0" & Hex®, 2) & _
Right("0" & Hex(G), 2) & _
Right("0" & Hex(B), 2)
End If
End Function
|
|
|
| |
| AleXStam | Дата: Вторник, 2025-06-24, 14:29 | Сообщение # 123 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 189
Награды: 1
Репутация: 10003
Статус: Оффлайн
| Function RGBToHex(R As Integer, G As Integer, B As Integer, Optional A As Variant = -1) As String
' Конвертирует RGB или RGBA в HEX без лишних нулей
' A = -1 (по умолчанию) — альфа не учитывается
' A = 0-255 — учитывается прозрачность
Dim hexR As String, hexG As String, hexB As String, hexA As String
' Проверка на корректные значения RGB (0-255)
If R < 0 Or R > 255 Or G < 0 Or G > 255 Or B < 0 Or B > 255 Then
RGBToHex = "Invalid RGB value (0-255)"
Exit Function
End If
' Преобразование R, G, B в HEX (без лишних нулей)
hexR = IIf(Hex® = "0", "00", Hex®)
hexG = IIf(Hex(G) = "0", "00", Hex(G))
hexB = IIf(Hex(B) = "0", "00", Hex(B))
' Корректировка однозначных HEX-значений (например, "F" → "0F")
hexR = Right("0" & hexR, 2)
hexG = Right("0" & hexG, 2)
hexB = Right("0" & hexB, 2)
' Если альфа-канал указан (0-255)
If A >= 0 And A <= 255 Then
hexA = Hex(A)
hexA = Right("0" & hexA, 2)
RGBToHex = "#" & hexA & hexR & hexG & hexB
ElseIf A <> -1 Then
RGBToHex = "Invalid Alpha value (0-255)"
Else
RGBToHex = "#" & hexR & hexG & hexB
End If
End Function
|
|
|
| |
| AleXStam | Дата: Вторник, 2025-06-24, 14:33 | Сообщение # 124 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 189
Награды: 1
Репутация: 10003
Статус: Оффлайн
| Function RGBToHex(R As Integer, G As Integer, B As Integer, Optional A As Variant = -1) As String
' Конвертирует RGB в HEX, гарантированно выдавая 6 символов (или 8 с альфой)
' A = -1 (по умолчанию) — без альфа-канала
' A = 0-255 — с альфа-каналом (формат #AARRGGBB)
' Проверка диапазонов
If R < 0 Or R > 255 Or G < 0 Or G > 255 Or B < 0 Or B > 255 Then
RGBToHex = "Invalid RGB (0-255)"
Exit Function
End If
' Преобразование в HEX с обязательными двумя символами
Dim hexR As String, hexG As String, hexB As String, hexA As String
hexR = Right("0" & Hex®, 2)
hexG = Right("0" & Hex(G), 2)
hexB = Right("0" & Hex(B), 2)
' Обработка альфа-канала (если указан)
If IsNumeric(A) Then
If A >= 0 And A <= 255 Then
hexA = Right("0" & Hex(A), 2)
RGBToHex = "#" & hexA & hexR & hexG & hexB
ElseIf A <> -1 Then
RGBToHex = "Invalid Alpha (0-255)"
Else
RGBToHex = "#" & hexR & hexG & hexB
End If
Else
RGBToHex = "#" & hexR & hexG & hexB
End If
End Function
|
|
|
| |
| AleXStam | Дата: Вторник, 2025-06-24, 14:42 | Сообщение # 125 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 189
Награды: 1
Репутация: 10003
Статус: Оффлайн
| Function RGBToHex(R As Integer, G As Integer, B As Integer) As String
' Конвертирует RGB в HEX без альфа-канала
' Пример: 239, 231, 203 → #EFE7CB
' Проверка на корректные значения (0-255)
If R < 0 Or R > 255 Or G < 0 Or G > 255 Or B < 0 Or B > 255 Then
RGBToHex = "Invalid RGB (0-255)"
Exit Function
End If
' Формируем HEX, добавляя "0" если нужно (например, "F" → "0F")
RGBToHex = "#" & _
Right("0" & Hex®, 2) & _
Right("0" & Hex(G), 2) & _
Right("0" & Hex(B), 2)
End Function
|
|
|
| |
| AleXStam | Дата: Вторник, 2025-06-24, 14:44 | Сообщение # 126 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 189
Награды: 1
Репутация: 10003
Статус: Оффлайн
| Function RGBToHex(R As Integer, G As Integer, B As Integer) As String
' Конвертирует RGB в 6-значный HEX в формате #RRGGBB
' Пример: 239, 231, 203 → #EFE7CB
' Проверка диапазона (0-255)
If R < 0 Or R > 255 Or G < 0 Or G > 255 Or B < 0 Or B > 255 Then
RGBToHex = "Invalid RGB (0-255)"
Exit Function
End If
' Форматирование каждого компонента в 2 символа (добавляем ведущий ноль при необходимости)
Dim hexR As String, hexG As String, hexB As String
hexR = Right("0" & UCase(Hex®), 2)
hexG = Right("0" & UCase(Hex(G)), 2)
hexB = Right("0" & UCase(Hex(B)), 2)
' Сборка HEX-строки
RGBToHex = "#" & hexR & hexG & hexB
End Function
|
|
|
| |
| AleXStam | Дата: Вторник, 2025-06-24, 14:46 | Сообщение # 127 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 189
Награды: 1
Репутация: 10003
Статус: Оффлайн
| Function RGBToHex(R As Integer, G As Integer, B As Integer) As String
' Преобразует RGB в HEX в формате #RRGGBB
' Пример: 239, 231, 203 → #EFE7CB
' Проверка на корректные значения (0-255)
If R < 0 Or R > 255 Or G < 0 Or G > 255 Or B < 0 Or B > 255 Then
RGBToHex = "Invalid RGB (0-255)"
Exit Function
End If
' Форматирование каждого компонента в 2 символа
Dim hexR As String, hexG As String, hexB As String
hexR = Right("00" & Hex®, 2)
hexG = Right("00" & Hex(G), 2)
hexB = Right("00" & Hex(B), 2)
' Сборка HEX-строки (в верхнем регистре)
RGBToHex = "#" & UCase(hexR & hexG & hexB)
End Function
|
|
|
| |
| AleXStam | Дата: Вторник, 2025-06-24, 14:48 | Сообщение # 128 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 189
Награды: 1
Репутация: 10003
Статус: Оффлайн
| Function RGBToHex(R As Integer, G As Integer, B As Integer) As String
' Преобразует RGB в HEX в формате #RRGGBB
' Пример: 239, 231, 203 → #EFE7CB
' Проверка, что числа в диапазоне 0-255
If R < 0 Or R > 255 Or G < 0 Or G > 255 Or B < 0 Or B > 255 Then
RGBToHex = "Invalid RGB (0-255)"
Exit Function
End If
' Форматирование каждого компонента в 2 символа
RGBToHex = "#" & _
Right("0" & Hex®, 2) & _
Right("0" & Hex(G), 2) & _
Right("0" & Hex(B), 2)
' Принудительно переводим в верхний регистр
RGBToHex = UCase(RGBToHex)
End Function
|
|
|
| |
| AleXStam | Дата: Вторник, 2025-06-24, 14:49 | Сообщение # 129 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 189
Награды: 1
Репутация: 10003
Статус: Оффлайн
| Function RGBToHex(R As Integer, G As Integer, B As Integer) As String
' Преобразует RGB в корректный 6-значный HEX (#RRGGBB)
' Пример: 239, 231, 203 → #EFE7CB
' Проверка диапазона
If R < 0 Or R > 255 Or G < 0 Or G > 255 Or B < 0 Or B > 255 Then
RGBToHex = "Invalid RGB (0-255)"
Exit Function
End If
' Функция для гарантированного двузначного HEX
Dim ToFixedHex As String
ToFixedHex = Right("0" & Hex®, 2) & Right("0" & Hex(G), 2) & Right("0" & Hex(B), 2)
' Сборка результата (верхний регистр)
RGBToHex = "#" & UCase(ToFixedHex)
End Function
|
|
|
| |
| AleXStam | Дата: Вторник, 2025-06-24, 14:51 | Сообщение # 130 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 189
Награды: 1
Репутация: 10003
Статус: Оффлайн
| Function RGBToHex(R As Integer, G As Integer, B As Integer) As String
' Преобразует RGB в корректный 6-значный HEX (#RRGGBB)
' Пример: 239, 231, 203 → #EFE7CB
' Проверка, что значения в диапазоне 0-255
If R < 0 Or R > 255 Or G < 0 Or G > 255 Or B < 0 Or B > 255 Then
RGBToHex = "Invalid RGB (0-255)"
Exit Function
End If
' Функция для гарантированного двузначного HEX
Dim ToHex As String
ToHex = _
Right("0" & Hex®, 2) & _
Right("0" & Hex(G), 2) & _
Right("0" & Hex(B), 2)
' Возвращаем результат в верхнем регистре
RGBToHex = "#" & UCase(ToHex)
End Function
|
|
|
| |
| AleXStam | Дата: Среда, Вчера, 09:41 | Сообщение # 131 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 189
Награды: 1
Репутация: 10003
Статус: Оффлайн
| Function RGBtoHEX(r As Range, g As Range, b As Range) As String
' Проверка на допустимые значения (0-255)
If r.Value < 0 Or r.Value > 255 Or _
g.Value < 0 Or g.Value > 255 Or _
b.Value < 0 Or b.Value > 255 Then
RGBtoHEX = "Ошибка: значения должны быть от 0 до 255"
Exit Function
End If
' Конвертация в HEX с добавлением ведущих нулей при необходимости
RGBtoHEX = "#" & _
Right("0" & Hex(r.Value), 2) & _
Right("0" & Hex(g.Value), 2) & _
Right("0" & Hex(b.Value), 2)
' Преобразование в нижний регистр (опционально)
RGBtoHEX = LCase(RGBtoHEX)
End Function
|
|
|
| |
| AleXStam | Дата: Среда, Вчера, 11:19 | Сообщение # 132 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 189
Награды: 1
Репутация: 10003
Статус: Оффлайн
| Function RGBtoHEX(r As Range, g As Range, b As Range) As String
' Проверка на пустые ячейки
If IsEmpty® Or IsEmpty(g) Or IsEmpty(b) Then
RGBtoHEX = "Ошибка: все ячейки должны содержать значения"
Exit Function
End If
' Проверка на числовые значения
If Not IsNumeric(r.Value) Or Not IsNumeric(g.Value) Or Not IsNumeric(b.Value) Then
RGBtoHEX = "Ошибка: значения должны быть числами"
Exit Function
End If
' Проверка на допустимые значения (0-255)
Dim red As Integer, green As Integer, blue As Integer
On Error Resume Next ' На случай переполнения
red = CInt(r.Value)
green = CInt(g.Value)
blue = CInt(b.Value)
On Error GoTo 0
If red < 0 Or red > 255 Or green < 0 Or green > 255 Or blue < 0 Or blue > 255 Then
RGBtoHEX = "Ошибка: значения должны быть от 0 до 255"
Exit Function
End If
' Конвертация в HEX с добавлением ведущих нулей
RGBtoHEX = "#" & _
Right("0" & Hex(red), 2) & _
Right("0" & Hex(green), 2) & _
Right("0" & Hex(blue), 2)
' Преобразование в верхний регистр (стандарт для HEX цветов)
RGBtoHEX = UCase(RGBtoHEX)
End Function
|
|
|
| |
| Гость | Дата: Среда, Вчера, 11:20 | Сообщение # 133 |
Группа: Гости
| SELECT
pp,
Lcode,
name,
strat,
color,
HEX,
TO_NUMBER(SUBSTR(HEX, 5, 2), 'XX') RED,
TO_NUMBER(SUBSTR(HEX, 3, 2), 'XX') GREEN,
TO_NUMBER(SUBSTR(HEX, 1, 2), 'XX') BLUE
FROM
(
SELECT
clra.NUMBER_PP_CLRA pp,
clra.LCODE_CLRA Lcode,
clra.NAME_FULL_CLRA name,
clra.COLOR_SAMPLE_CLRA color,
SUBSTR(TRIM(TO_CHAR(clra.COLOR_SAMPLE_CLRA, 'XXXXXX')) || '000000', 1, 6) HEX,
clsf.NODE_NAME strat
FROM
MR_DBA.CLASSIFIER clsf,
MR_DBA.COLOR_CLRA clra
where clra.ID_COLOR_CLRA = clsf.LCODE_COLOR
order by clra.NUMBER_PP_CLRA
)Добавлено (2025-06-25, 11:21)
---------------------------------------------
SELECT
pp,
Lcode,
name,
strat,
color,
HEX,
TO_NUMBER(SUBSTR(HEX, 5, 2), 'XX') RED,
TO_NUMBER(SUBSTR(HEX, 3, 2), 'XX') GREEN,
TO_NUMBER(SUBSTR(HEX, 1, 2), 'XX') BLUE
FROM
(
SELECT
clra.NUMBER_PP_CLRA pp,
clra.LCODE_CLRA Lcode,
clra.NAME_FULL_CLRA name,
clra.COLOR_SAMPLE_CLRA color,
SUBSTR(TRIM(TO_CHAR(clra.COLOR_SAMPLE_CLRA, 'XXXXXX')) || '000000', 1, 6) HEX,
clsf.NODE_NAME strat
FROM
MR_DBA.CLASSIFIER clsf,
MR_DBA.COLOR_CLRA clra
where clra.ID_COLOR_CLRA = clsf.LCODE_COLOR
order by clra.NUMBER_PP_CLRA
)
|
|
|
| |
| AleXStam | Дата: Среда, Вчера, 11:23 | Сообщение # 134 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 189
Награды: 1
Репутация: 10003
Статус: Оффлайн
| SELECT
pp,
Lcode,
name,
strat,
color,
HEX,
TO_NUMBER(SUBSTR(HEX, 1, 2), 'XX') RED,
TO_NUMBER(SUBSTR(HEX, 3, 2), 'XX') GREEN,
TO_NUMBER(SUBSTR(HEX, 5, 2), 'XX') BLUE
FROM
(
SELECT
clra.NUMBER_PP_CLRA pp,
clra.LCODE_CLRA Lcode,
clra.NAME_FULL_CLRA name,
clra.COLOR_SAMPLE_CLRA color,
SUBSTR(TRIM(TO_CHAR(clra.COLOR_SAMPLE_CLRA, 'XXXXXX')) || '000000', 1, 6) HEX,
clsf.NODE_NAME strat
FROM
MR_DBA.CLASSIFIER clsf,
MR_DBA.COLOR_CLRA clra
WHERE clra.ID_COLOR_CLRA = clsf.LCODE_COLOR
ORDER BY clra.NUMBER_PP_CLRA
)
|
|
|
| |
