mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-12 14:29:36 +02:00
TurboPower_iPro: Implement css function rgb().
git-svn-id: trunk@59259 -
This commit is contained in:
parent
38389bb56f
commit
10690a117f
@ -398,6 +398,7 @@ end;
|
||||
function ColorFromString(S: String): TColor;
|
||||
var
|
||||
R, G, B, Err : Integer;
|
||||
L: TStringList;
|
||||
begin
|
||||
Result := -1;
|
||||
if S = '' then
|
||||
@ -421,6 +422,24 @@ begin
|
||||
else
|
||||
if BinSearchNamedColor(S, result) then exit
|
||||
else
|
||||
if pos('RGB', S) = 1 then begin
|
||||
S := Copy(S, 4, MaxInt);
|
||||
while (S <> '') and (IsWhiteSpace(S[1]) or (S[1] = '(')) do
|
||||
Delete(S, 1, 1);
|
||||
while (S <> '') and (IsWhiteSpace(S[Length(S)]) or (S[Length(S)] = ')')) do
|
||||
SetLength(S, Length(S)-1);
|
||||
L := TStringList.Create;
|
||||
try
|
||||
L.CommaText := S;
|
||||
if L.Count > 0 then R := StrToIntDef(L[0], 255);
|
||||
if L.Count > 1 then G := StrToIntDef(L[1], 255);
|
||||
if L.Count > 2 then B := StrToIntDef(L[2], 255);
|
||||
Exit(RGB(R, G, B));
|
||||
finally
|
||||
L.Free;
|
||||
end;
|
||||
end
|
||||
else
|
||||
if length(S) = 6 then
|
||||
try
|
||||
val('$'+Copy(S,1,2), R, Err);
|
||||
@ -582,12 +601,14 @@ var
|
||||
Start: Integer;
|
||||
Quote: char;
|
||||
WantChar: Boolean;
|
||||
WantPar: Boolean;
|
||||
Len: Integer;
|
||||
begin
|
||||
Result := TStringList.Create;
|
||||
Start := Pos(':', ACommand)+1;
|
||||
|
||||
WantArg := True;
|
||||
WantPar := false;
|
||||
Quote := #0;
|
||||
for i := Start to Length(ACommand) do
|
||||
begin
|
||||
@ -616,7 +637,9 @@ begin
|
||||
else // we have an arg we are reading ...
|
||||
begin
|
||||
WantChar:=not (ACommand[i] in [';',' ',#9]);
|
||||
if (i<Length(ACommand)) and WantChar
|
||||
if ACommand[i] = '(' then WantPar := True;
|
||||
if ACommand[i] = ')' then WantPar := False;
|
||||
if (i<Length(ACommand)) and (WantChar or WantPar)
|
||||
then
|
||||
continue;
|
||||
WantArg := True;
|
||||
|
Loading…
Reference in New Issue
Block a user