csscolors.pas

delphi 中用于 css 样式表的解析的类

      (Name: 'CaptionText';        Value: clCaptionText),
      (Name: 'fuchsia';           Value: clFuchsia ),
      (Name: 'gray';              Value: clGray    ),
      (Name: 'GrayText';           Value: clGrayText),
      (Name: 'green';             Value: clGreen   ),
      (Name: 'Highlight';          Value: clHighlight),
      (Name: 'HighlightText';      Value: clHighlightText),
      (Name: 'InactiveBorder';     Value: clInactiveBorder),
      (Name: 'InactiveCaption';    Value: clInactiveCaption),
      (Name: 'InactiveCaptionText';Value: clInactiveCaptionText),
      (Name: 'InfoBackground';     Value: clInfoBk),
      (Name: 'InfoText';           Value: clInfoText),
      (Name: 'inherit';           Value: clDefault),
      (Name: 'lime';              Value: clLime    ),
      (Name: 'maroon';            Value: clMaroon  ),
      (Name: 'Menu';               Value: clMenu),
      (Name: 'MenuText';           Value: clMenuText),
      (Name: 'navy';              Value: clNavy    ),
      (Name: 'olive';             Value: clOlive   ),
      (Name: 'purple';            Value: clPurple  ),
      (Name: 'red';               Value: clRed     ),
      (Name: 'Scrollbar';          Value: clScrollbar),
      (Name: 'silver';            Value: clSilver  ),
      (Name: 'teal';              Value: clTeal    ),
      (Name: 'ThreeDDarkShadow';   Value: cl3DDkShadow),
      (Name: 'ThreeDFace';         Value: clBtnFace),
      (Name: 'ThreeDHighlight';    Value: cl3DLight),
      (Name: 'ThreeDLightShadow';  Value: clBtnShadow), //?
      (Name: 'ThreeDShadow';       Value: clBtnShadow),
      (Name: 'transparent';       Value: clNone    ),
      (Name: 'white';             Value: clWhite   ),
      (Name: 'Window';             Value: clWindow),
      (Name: 'WindowFrame';        Value: clWindowFrame),
      (Name: 'WindowText';         Value: clWindowText),
      (Name: 'yellow';            Value: clYellow  )
  );

function RGBSpace(S: string; out N: Byte): boolean;
var
  LN: Int64;
begin
  Result:=false;
  N:=0;
  S:=Trim(S);
  try
    LN:=StrToInt(S);
    if LN<0 then N:=0 else
    if LN>255 then N:=255 else N:=LN;
    Result:=true;
    Exit;
  except
    try
      if S[Length(S)]='%' then
      begin
        SetLength(S, Length(S)-1);
        LN:=Round(StrToFloat(S)/100*255);
        if LN<0 then N:=0 else
        if LN>255 then N:=255 else N:=LN;
        Result:=true;
        Exit;
      end
    except
      Exit;
    end;
  end;
end;

function CSSColor(S: string; DefaultColor: TColor = clBlack): TColor; overload;
var
  ColorType: TCSSColorType;
begin
  Result:=CSSColor(S, ColorType, DefaultColor);
end;

function CSSColor(S: string; out ColorType: TCSSColorType; DefaultColor: TColor = clBlack; SysToRGB: boolean = false): TColor; overload;
var
  C: TARGB absolute Result;
  i, L: Integer;
  R,G,B: Byte;
  SN: string;

procedure IsNamedColor;
var
  L, H, I, CT: Integer;
begin
  L:=Low(CSS2NamedColors);
  H:=High(CSS2NamedColors);
  repeat
    I := (L + H) shr 1;
    CT := CompareText(CSS2NamedColors[I].Name, S);
    if CT<0 then L:=I+1 else
    if CT>0 then H:=I-1 else
    begin
      Result:=CSS2NamedColors[I].Value;
      if SysToRGB then UnSystem(Result);
      ColorType:=ctKeyword;
      Exit;
    end;
  until L > H;
end;

begin
   Result:=$00000000;
   Result:=DefaultColor;
   ColorType:=ctNotColor;
   S:=LowerCase(Trim(S));
   i:=1;
   while i <= Length(S) do
   case S[i] of
     '#':
     begin
       Inc(i);
       L:=0;
       while (i <=Length(S)) and (S[i] in ['0'..'9', 'a'..'f']) do
       begin
         Inc(L);
         Inc(i);
       end;

       SN:=Copy(S, i-L, L);
       case L of
         3:
         begin
           C.R:=Hex[SN[1]]+(Hex[SN[1]] shl 4);
           C.G:=Hex[SN[2]]+(Hex[SN[2]] shl 4);
           C.B:=Hex[SN[3]]+(Hex[SN[3]] shl 4);
           ColorType:=ctHexadecimal;
           Exit;
         end;
         6:
         begin
           C.R:=Hex[SN[2]]+(Hex[SN[1]] shl 4);
           C.G:=Hex[SN[4]]+(Hex[SN[3]] shl 4);
           C.B:=Hex[SN[6]]+(Hex[SN[5]] shl 4);
           ColorType:=ctHexadecimal;
           Exit;
         end;
         else Exit;
       end;
     end;
     '(': if (i>3) and (S[i-1]='b') and (S[i-2]='g') and (S[i-3]='r') then
          begin

            Inc(i);
            L:=0;
            if i>Length(S) then Exit;
            while S[i]<>',' do
            begin
              if not (S[i] in RGBChar) then Exit;
              Inc(i);
              Inc(L);
              if i>Length(S) then Exit;
            end;

            if not RGBSpace(Copy(S, i-L, L), R) then Exit;

            Inc(i);
            L:=0;
            if i>Length(S) then Exit;
            while S[i]<>',' do
            begin
              if not (S[i] in RGBChar) then Exit;
              Inc(i);
              Inc(L);
              if i>Length(S) then Exit;
            end;

            if not RGBSpace(Copy(S, i-L, L), G) then Exit;

            Inc(i);
            L:=0;
            if i>Length(S) then Exit;
            while S[i]<>')' do
            begin
              if not (S[i] in RGBChar) then Exit;
              Inc(i);
              Inc(L);
              if i>Length(S) then Exit;
            end;

            if not RGBSpace(Copy(S, i-L, L), B) then Exit;

            C.R:=R;
            C.G:=G;
            C.B:=B;

            if Pos('%', S)<>0
            then ColorType:=ctPercentage
            else ColorType:=ctDecimal;

            Exit;

          end
          else Inc(i)
     else Inc(i);
   end;

   IsNamedColor;

end;

function _Hex(Color: TColor): string;
var
  S: array[1..4] of Byte absolute Color;
  C: TARGB absolute Color;
  i: Integer;
const
  H: array[0..15] of Char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
begin
  UnSystem(Color);
  SetLength(Result, 7);
  Result[1]:='#';
  for i:=1 to 3 do
  begin
    Result[i*2+1]:=H[S[i] and $0F];
    Result[i*2  ]:=H[S[i] shr 4  ];
  end;
end;

procedure UnSystem(var Color: TColor);
var
  C: TARGB absolute Color;
begin
{$IFDEF MSWINDOWS}
  if C.A=$FF then Color:=GetSysColor(C.R);
{$ENDIF}
{$IFDEF LINUX}
  Result:=Color; //?
{$ENDIF}
end;

function _RGB(Color: TColor): string;
var
  C: TARGB absolute Color;
begin
  UnSystem(Color);
  Result:='rgb('+_(C.R)+','+_(C.G)+','+_(C.B)+')';
end;

function _Percent(Color: TColor): string;
var
  C: TARGB absolute Color;
begin
  UnSystem(Color);
  Result:='rgb('+_(Round(C.R/255*100))+'%,'+_(Round(C.G/255*100))+'%,'+_(Round(C.B/255*100))+'%)';
end;

function _Keyword(Color: TColor; ColorType: TCSSColorType = ctHexadecimal): string;
var
  C: TARGB absolute Color;
  i: Integer;
begin
  UnSystem(Color);
  for i:=Low(KeywordColors) to High(KeywordColors) do
  begin
    if Color=KeywordColors[i].Value then
    begin
      Result:=KeywordColors[i].Name;
      Exit;
    end;
  end;
  case ColorType of
    ctDecimal: Result:=_RGB(Color);
    ctPercentage: Result:=_Percent(Color);
    else Result:=_Hex(Color);
  end;
end;


end.