Перевод строки HTML кода в цвет

Delphi , Графика и Игры , Цвета и Палитра

Автор: Fenik
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Перевод строки HTML кода в цвет

Зависимости: Graphics
Автор:       Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright:   Автор Федоровских Николай
Дата:        26 октября 2002 г.
***************************************************** }

function HTMLToColor(const s: string; var Color: TColor): Boolean;
{Функция переводит строку HTML кода в цвет.
 Если результат успешен, то возвращает True
 и записывает цвет в переменную Color,
 иначе возвращает False.
 Строка должна быть например такой: #2A09F4
 в диапазоне #000000 - #FFFFFF}

  function No16: Boolean;
    {Функция проверяет относятся ли символы с 2 по 7
     к шестнадцатеричной системе счисления.
     Если относятся, то результат - False,
     иначе - True}
  var
    i: Integer;
  begin
    Result := False;
    for i := 2 to 7 do
      if not ((s[i] in ['0'..'9']) or (s[i] in ['A'..'F'])) then
      begin
        Break;
        Result := True;
      end;
  end;

  function GetNum(pos: Byte): Byte;
    {перевод строки с шетнадцатеричным двухзначным
     числом в десятичное число}
  var
    ms: string;
    E: Integer;
  begin
    {выделяем фрагмент строки длиной в 2 символа
     начиная с заданной позиции и переводим его в число}
    ms := '$' + Copy(s, pos, 2);
    Val(ms, Result, E);
  end;

begin
  Result := False;

  {Функция потерпит неудачу,
   если строка имеет неверный формат.}
  if (Length(s) <> 7) then
    Exit
  else if (s[1] <> '#') then
    Exit
  else if No16 then
    Exit;

  Color := GetNum(6) shl 16 {синий}
  or GetNum(4) shl 8 {зелёный}
  or GetNum(2); {красный}
  {или Color := RGB(GetNum(2), GetNum(4), GetNum(6));}

  Result := True;
end;

Пример использования:

if HTMLToColor(HTMLEdit.Text, C) then
begin
  Panel1.Color := C;
  ChangeColor;
end;

HTMLToColor('#808080', C) {C := clGray}

Статья Перевод строки HTML кода в цвет раздела Графика и Игры Цвета и Палитра может быть полезна для разработчиков на Delphi и FreePascal.

Комментарии и вопросы

:: Главная :: Цвета и Палитра ::