On 7/23/17, Ondrej Pokorny <laza...@kluug.net> wrote: > Great, I will!
My try ... { Try to translate HTML color code into TFPColor Supports following formats '#rgb' '#rrggbb' W3C Html color name } function TryHtmlToFPColorDef(const S: String; out FPColor: TFPColor; Def: TFPColor): Boolean; function TryHexStrToWord(const Hex: String; out W: Word): Boolean; var Code: Integer; begin Val('$'+Hex, W, Code); Result := (Code = 0); if not Result then W := 0; end; begin Result := False; FPColor := Def; if (Length(S) = 0) then Exit; if (S[1] = '#') then begin if Length(S) = 4 then begin // #rgb Result := (TryHexstrToWord(S[2]+S[2], FPColor.red) and TryHexstrToWord(S[3]+S[3], FPColor.green) and TryHexstrToWord(S[4]+S[4], FPColor.blue)); end else if Length(S) = 7 then begin // #rrggbb Result := (TryHexstrToWord(S[2]+S[3], FPColor.red) and TryHexstrToWord(S[4]+S[5], FPColor.green) and TryHexstrToWord(S[6]+S[7], FPColor.blue)); end; end else begin case LowerCase(S) of 'white' : begin Result := True; FPColor.red := $ff; FPColor.green := $ff; FPColor.blue := $ff; end; 'silver' : begin Result := True; FPColor.red := $c0; FPColor.green := $c0; FPColor.blue := $c0; end; 'gray' : begin Result := True; FPColor.red := $80; FPColor.green := $80; FPColor.blue := $80; end; 'black' : begin Result := True; FPColor.red := $00; FPColor.green := $00; FPColor.blue := $00; end; 'red' : begin Result := True; FPColor.red := $ff; FPColor.green := $00; FPColor.blue := $00; end; 'maroon' : begin Result := True; FPColor.red := $80; FPColor.green := $00; FPColor.blue := $00; end; 'yellow' : begin Result := True; FPColor.red := $ff; FPColor.green := $00; FPColor.blue := $00; end; 'olive' : begin Result := True; FPColor.red := $80; FPColor.green := $80; FPColor.blue := $00; end; 'lime' : begin Result := True; FPColor.red := $00; FPColor.green := $ff; FPColor.blue := $00; end; 'green' : begin Result := True; FPColor.red := $00; FPColor.green := $80; FPColor.blue := $00; end; 'aqua' : begin Result := True; FPColor.red := $00; FPColor.green := $ff; FPColor.blue := $ff; end; 'teal' : begin Result := True; FPColor.red := $00; FPColor.green := $80; FPColor.blue := $80; end; 'blue' : begin Result := True; FPColor.red := $00; FPColor.green := $00; FPColor.blue := $ff; end; 'navy' : begin Result := True; FPColor.red := $00; FPColor.green := $00; FPColor.blue := $80; end; 'fuchsia': begin Result := True; FPColor.red := $ff; FPColor.green := $00; FPColor.blue := $ff; end; 'purple' : begin Result := True; FPColor.red := $80; FPColor.green := $00; FPColor.blue := $80; end; end; end; end; Bart _______________________________________________ fpc-devel maillist - fpc-devel@lists.freepascal.org http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-devel