{$IFDEF CSS_INTERFACE} TCSSGroup = class end; TCSSFontStyle = (cfsNormal, cfsItalic, cfsOblique, cfsInherit); TCSSFontWeight = (cfwNormal, cfwBold, cfwBolder, cfwLighter, cfw100, cfw200, cfw300, cfw400 , cfw500, cfw600, cfw700, cfw800, cfw900); TCSSFontVariant = (cfvNormal, cfvSmallCaps, cfvInherit); TCSSBorderStyle = (cbsNone, cbsHidden, cbsDotted, cbsDashed, cbsSolid, cbsDouble, cbsGroove, cbsRidge, cbsInset, cbsOutset); TCSSTextDecoration = (ctdUnderline, ctdOverline,ctdLinethrough,ctdNone); TCSSTextDecorations = set of TCSSTextDecoration; { TCSSFont } TCSSFont = class private FFamily: String; FSize: String; FStyle: TCSSFontStyle; FWeight: TCSSFontWeight; published property Name: String read FFamily write FFamily; property Size: String read FSize write FSize; property Style: TCSSFontStyle read FStyle write FStyle; //proprety Variant: TCSSFontVariant property Weight: TCSSFontWeight read FWeight write FWeight; end; { TCSSBorder } TCSSBorder = class private FColor: TColor; FStyle: TCSSBorderStyle; published property Color: TColor read FColor write FColor; property Style: TCSSBorderStyle read FStyle write FStyle; end; { TCSSProps } TCSSProps = class private FClassIDs: TStringList; FBGColor: TColor; FBorderBottom: TCSSBorderStyle; FBorderLeft: TCSSBorderStyle; FBorderRight: TCSSBorderStyle; FBorderTop: TCSSBorderStyle; FColor: TColor; FFont: TCSSFont; fTextDecoration: TCSSTextDecorations; function GetCommandArgs(ACommand: String): TStringList; function GetCommandName(ACommand: String): String; published property TextDecoration:TCSSTextDecorations read fTextDecoration write fTextDecoration; property Font: TCSSFont read FFont write FFont; property Color: TColor read FColor write FColor; property BGColor: TColor read FBGColor write FBGColor; property BorderTop: TCSSBorderStyle read FBorderTop write FBorderTop; property BorderLeft: TCSSBorderStyle read FBorderLeft write FBorderLeft; property BorderBottom: TCSSBorderStyle read FBorderBottom write FBorderBottom; property BorderRight: TCSSBorderStyle read FBorderRight write FBorderRight; public constructor Create; destructor Destroy; override; procedure ReadCommands(ACommands: TStrings); end; { TCSSGlobalProps } TCSSGlobalProps = class FElements: TStringList; public constructor Create; destructor Destroy; override; function GetElement(AElementID: String; ClassID: String = ''; CreateIfNotExist: Boolean = False): TCSSProps; end; {$ELSE implementation} type { TCSSReader } TCSSReader = class FStream: TStream; FGlobalProps: TCSSGlobalProps; function GetStatementElements(AStatement: String): TStringList; function GetStatementCommands(AStatement: String): TStringList; function CheckIsComment: Boolean; procedure EatWhiteSpace; procedure ParseCSS; procedure EatComment; function FindStatement(out AStatement: String): Boolean; function EOF: Boolean; constructor Create(AStream: TStream; AGlobalProps: TCSSGlobalProps); end; function IsWhiteSpace(AChar: Char; ExcludeSpaces: Boolean = False): Boolean; begin Result := AChar in [#9, #10, #11, #13]; if not Result and not ExcludeSpaces then Result := AChar = ' '; end; function SeperateCommands(Commands: String): TStringList; var i, fpos1, fpos2: Integer; Command: String; begin Result := TStringList.Create; FPos1 := 1; for i := 1 to Length(Commands) do begin if Commands[i] = ';' then begin Command := Copy(Commands, FPos1, i-FPos1); FPos1 := i+1; for FPos2 := Length(Command) downto 1 do if IsWhiteSpace(Command[FPos2], True) then Delete(Command, FPos2, 1); Result.Add(Trim(Command)); end; end; Command := Trim(Copy(Commands, FPos1, Length(Commands))); if Command <> '' then begin Result.Add(Command); end; end; function TextDecorationFromSting(args:TStrings):TCSSTextDecorations; var i:integer; s:String; begin result:=[]; for i:=0 to args.Count-1 do begin s:=LowerCase(args[i]); if S = 'underline' then result:=result+[ctdUnderline]; if S = 'overline' then result:=result+[ctdOverline]; if S = 'line-through' then result:=result+[ctdLinethrough]; end; end; function FontWeightFromString(S: String): TCSSFontWeight; begin Result := cfwNormal; S := LowerCase(S); if S = 'bold' then Result := cfwBold else if S = 'bolder' then Result := cfwBolder else if S = 'lighter' then Result := cfwLighter else if S = '100' then Result := cfw100 else if S = '200' then Result := cfw200 else if S = '300' then Result := cfw300 else if S = '400' then Result := cfw400 else if S = '500' then Result := cfw500 else if S = '600' then Result := cfw600 else if S = '700' then Result := cfw700 else if S = '800' then Result := cfw800 else if S = '900' then Result := cfw900 end; function ColorFromString(S: String): TColor; var R, G, B, Err : Integer; begin Result := -1; if S = '' then Exit; S := UpperCase(S); if S[1] = '#' then if length(S) <> 7 then exit else begin val('$'+Copy(S,2,2), R, Err); if Err <> 0 then R := 255; val('$'+Copy(S,4,2), G, Err); if Err <> 0 then G := 255; val('$'+Copy(S,6,2), B, Err); if Err <> 0 then B := 255; Exit(RGB(R, G, B)); end else if S = 'BLACK' then Result := clBlack else if S = 'STEELBLUE' then Result := $B48246 else if S = 'ROYALBLUE' then Result := $901604 else if S = 'CORNFLOWERBLUE' then Result := $ED9564 else if S = 'LIGHTSTEELBLUE' then Result := $DEC4B0 else if S = 'MEDIUMSLATEBLUE' then Result := $EE687B else if S = 'SLATEBLUE' then Result := $CD5A6A else if S = 'DARKSLATEBLUE' then Result := $8B3D48 else if S = 'MIDNIGHTBLUE' then Result := $701919 else if S = 'NAVY' then Result := $800000 else if S = 'DARKBLUE' then Result := $8B0000 else if S = 'MEDIUMBLUE' then Result := $CD0000 else if S = 'BLUE' then Result := $FF0000 else if S = 'DODGERBLUE' then Result := $FF901E else if S = 'DEEPSKYBLUE' then Result := $FFBF00 else if S = 'LIGHTSKYBLUE' then Result := $FACE87 else if S = 'SKYBLUE' then Result := $EBCE87 else if S = 'LIGHTBLUE' then Result := $E6D8AD else if S = 'POWDERBLUE' then Result := $E6E0B0 else if S = 'AZURE' then Result := $FFFFF0 else if S = 'LIGHTCYAN' then Result := $FFFFE0 else if S = 'PALETURQUOISE' then Result := $EEEEAF else if S = 'MEDIUMTURQUOISE' then Result := $CCD148 else if S = 'LIGHTSEAGREEN' then Result := $AAB220 else if S = 'DARKCYAN' then Result := $8B8B00 else if S = 'TEAL' then Result := $808000 else if S = 'CADETBLUE' then Result := $A09E5F else if S = 'DARKTURQUOISE' then Result := $D1CE00 else if S = 'AQUA' then Result := $FFFF00 else if S = 'CYAN' then Result := $FFFF00 else if S = 'TURQUOISE' then Result := $D0E040 else if S = 'AQUAMARINE' then Result := $D4FF7F else if S = 'MEDIUMAQUAMARINE' then Result := $AACD66 else if S = 'DARKSEAGREEN' then Result := $8FBC8F else if S = 'MEDIUMSEAGREEN' then Result := $71B33C else if S = 'SEAGREEN' then Result := $578B2E else if S = 'DARKGREEN' then Result := $006400 else if S = 'GREEN' then Result := $008000 else if S = 'FORESTGREEN' then Result := $228B22 else if S = 'LIMEGREEN' then Result := $32CD32 else if S = 'LIME' then Result := $00FF00 else if S = 'CHARTREUSE' then Result := $00FF7F else if S = 'LAWNGREEN' then Result := $00FC7C else if S = 'GREENYELLOW' then Result := $2FFFAD else if S = 'YELLOWGREEN' then Result := $32CD9A else if S = 'PALEGREEN' then Result := $98FB98 else if S = 'LIGHTGREEN' then Result := $90EE90 else if S = 'SPRINGGREEN' then Result := $7FFF00 else if S = 'MEDIUMSPRINGGREEN' then Result := $9AFA00 else if S = 'DARKOLIVEGREEN' then Result := $2F6B55 else if S = 'OLIVEDRAB' then Result := $238E6B else if S = 'OLIVE' then Result := $008080 else if S = 'DARKYELLOW' then Result := $008080 else if S = 'DARKKHAKI' then Result := $6BB7BD else if S = 'DARKGOLDENROD' then Result := $0B86B8 else if S = 'GOLDENROD' then Result := $20A5DA else if S = 'GOLD' then Result := $00D7FF else if S = 'YELLOW' then Result := $00FFFF else if S = 'KHAKI' then Result := $8CE6F0 else if S = 'PALEGOLDENROD' then Result := $AAE8EE else if S = 'BLANCHEDALMOND' then Result := $CDEBFF else if S = 'MOCCASIN' then Result := $B5E4FF else if S = 'WHEAT' then Result := $B3DEF5 else if S = 'NAVAJOWHITE' then Result := $ADDEFF else if S = 'BURLYWOOD' then Result := $87B8DE else if S = 'TAN' then Result := $8CB4D2 else if S = 'ROSYBROWN' then Result := $8F8FBC else if S = 'SIENNA' then Result := $2D52A0 else if S = 'SADDLEBROWN' then Result := $13458B else if S = 'CHOCOLATE' then Result := $1E69D2 else if S = 'PERU' then Result := $3F85CD else if S = 'SANDYBROWN' then Result := $60A4F4 else if S = 'DARKRED' then Result := $00008B else if S = 'MAROON' then Result := $000080 else if S = 'BROWN' then Result := $2A2AA5 else if S = 'FIREBRICK' then Result := $2222B2 else if S = 'INDIANRED' then Result := $5C5CCD else if S = 'LIGHTCORAL' then Result := $8080F0 else if S = 'SALMON' then Result := $7280FA else if S = 'DARKSALMON' then Result := $7A96E9 else if S = 'LIGHTSALMON' then Result := $7AA0FF else if S = 'CORAL' then Result := $507FFF else if S = 'TOMATO' then Result := $4763FF else if S = 'DARKORANGE' then Result := $008CFF else if S = 'ORANGE' then Result := $00A5FF else if S = 'ORANGERED' then Result := $0045FF else if S = 'CRIMSON' then Result := $3C14DC else if S = 'RED' then Result := $0000FF else if S = 'DEEPPINK' then Result := $9314FF else if S = 'FUCHSIA' then Result := $FF00FF else if S = 'MAGENTA' then Result := $FF00FF else if S = 'HOTPINK' then Result := $B469FF else if S = 'LIGHTPINK' then Result := $C1B6FF else if S = 'PINK' then Result := $CBC0FF else if S = 'PALEVIOLETRED' then Result := $9370DB else if S = 'MEDIUMVIOLETRED' then Result := $8515C7 else if S = 'PURPLE' then Result := $800080 else if S = 'DARKMAGENTA' then Result := $8B008B else if S = 'MEDIUMPURPLE' then Result := $DB7093 else if S = 'BLUEVIOLET' then Result := $E22B8A else if S = 'INDIGO' then Result := $82004B else if S = 'DARKVIOLET' then Result := $D30094 else if S = 'DARKORCHID' then Result := $CC3299 else if S = 'MEDIUMORCHID' then Result := $D355BA else if S = 'ORCHID' then Result := $D670DA else if S = 'VIOLET' then Result :=$EE82EE else if S = 'PLUM' then Result := $DDA0DD else if S = 'THISTLE' then Result := $D8BFD8 else if S = 'LAVENDER' then Result := $FAE6E6 else if S = 'GHOSTWHITE' then Result := $FFF8F8 else if S = 'ALICEBLUE' then Result := $FFF8F0 else if S = 'MINTCREAM' then Result := $FAFFF5 else if S = 'HONEYDEW' then Result := $F0FFF0 else if S = 'LIGHTGOLDENRODYELLOW' then Result := $D2FAFA else if S = 'LEMONCHIFFON' then Result := $CDFAFF else if S = 'CORNSILK' then Result := $DCF8FF else if S = 'LIGHTYELLOW' then Result := $E0FFFF else if S = 'IVORY' then Result := $F0FFFF else if S = 'FLORALWHITE' then Result := $F0FAFF else if S = 'LINEN' then Result := $E6F0FA else if S = 'OLDLACE' then Result := $E6F5FD else if S = 'ANTIQUEWHITE' then Result := $D7EBFA else if S = 'BISQUE' then Result := $C4E4FF else if S = 'PEACHPUFF' then Result := $B9DAFF else if S = 'PAPAYAWHIP' then Result := $D5EFFF else if S = 'BEIGE' then Result := $DCF5F5 else if S = 'SEASHELL' then Result := $EEF5FF else if S = 'LAVENDERBLUSH' then Result := $F5F0FF else if S = 'MISTYROSE' then Result := $E1E4FF else if S = 'SNOW' then Result := $FAFAFF else if S = 'WHITE' then Result := $FFFFFF else if S = 'WHITESMOKE' then Result := $F5F5F5 else if S = 'GAINSBORO' then Result := $DCDCDC else if S = 'LIGHTGREY' then Result := $D3D3D3 else if S = 'SILVER' then Result := $C0C0C0 else if S = 'DARKGRAY' then Result := $A9A9A9 else if S = 'GRAY' then Result := $808080 else if S = 'LIGHTSLATEGRAY' then Result := $998877 else if S = 'SLATEGRAY' then Result := $908070 else if S = 'DIMGRAY' then Result := $696969 else if S = 'DARKSLATEGRAY' then Result := $4F4F2F else if length(S) = 6 then try val('$'+Copy(S,1,2), R, Err); if Err <> 0 then R := 255; val('$'+Copy(S,3,2), G, Err); if Err <> 0 then G := 255; val('$'+Copy(S,5,2), B, Err); if Err <> 0 then B := 255; Result := RGB(R, G, B); except Result := -1; end //else WriteLn('>>>>> Unknwn Color! = ', S); end; function CSSFontStyleFromName(Args:TStringList): TCSSFontStyle; var i:Integer; s:string; begin Result := cfsNormal; for i:=0 to args.Count-1 do begin s:=LowerCase(args[i]); if S = 'italic' then Result := cfsItalic else if S = 'oblique' then Result := cfsOblique else if S = 'inherit' then Result := cfsInherit; end; end; { TCSSReader } function TCSSReader.GetStatementElements(AStatement: String): TStringList; var i, fpos: Integer; Elements : String; Element: String; ElementClass: String; begin Result := TStringList.Create; fpos := Pos('{', AStatement); if fpos > 0 then begin Elements := Copy(AStatement,1,fpos-1); for i := Length(Elements) downto 0 do if IsWhiteSpace(Elements[i]) then Delete(Elements, i, 1); Result.Delimiter := ','; Result.DelimitedText := Elements; end; for i := 0 to Result.Count-1 do begin Element := LowerCase(Result[i]); ElementClass := ''; fpos := Pos('.', Element); if fpos = 0 then begin Result.Objects[i] := FGlobalProps.GetElement(Element, '', True); end else begin ElementClass := LowerCase(Copy(Element, FPos+1, Length(Element))); Element := LowerCase(Copy(Element, 1, FPos-1)); Result.Objects[i] := FGlobalProps.GetElement(Element, ElementClass, True); end; end; end; function TCSSReader.GetStatementCommands(AStatement: String): TStringList; var fpos1, fpos2: Integer; Commands: String; begin fpos1 := Pos('{', AStatement)+1; fpos2 := Pos('}', AStatement)-1; Commands := Copy(AStatement, fpos1, fpos2-fpos1+1); Result := SeperateCommands(Commands); end; function TCSSProps.GetCommandArgs(ACommand: String): TStringList; var i: Integer; WantArg: Boolean; Arg: String; Start: Integer; Quote: char; begin Result := TStringList.Create; Start := Pos(':', ACommand)+1; ACommand := ACommand + ' '; WantArg := True; Quote := #0; for i := Start to Length(ACommand) do begin if (Quote = #0) and (ACommand[i] in ['"','''']) then begin Quote := ACommand[i]; Start := i+1; continue; end; if (Quote<>#0) then begin if ACommand[i]=Quote then begin Quote:=#0; Arg := Copy(ACommand, Start, i-Start); Result.Add(Trim(Arg)); end; continue; end; if (WantArg) or (ACommand[i] = ',') then begin if IsWhiteSpace(ACommand[i]) then Continue; if ACommand[i] = ',' then begin Arg := Copy(ACommand, Start, i-start); Result.Add(Trim(Arg)); end; Start := i; if ACommand[i] = ',' then Start := i+1; WantArg := False; continue; end else // we have an arg we are reading ... begin if ((i';')) then continue; WantArg := True; Arg := Copy(ACommand, Start, i-1); Result.Add(Trim(Arg)); end; end; end; function TCSSProps.GetCommandName(ACommand: String): String; begin Result := Copy(ACommand, 1, Pos(':', ACommand)-1); end; function TCSSReader.CheckIsComment: Boolean; begin Result := False; if EOF then exit; Result := char(FStream.ReadByte) = '*'; if not Result then FStream.Position := FStream.Position-1; end; procedure TCSSReader.EatWhiteSpace; var Buf: char; //comment: integer; begin //comment:=0; while not EOF do begin Buf := char(FStream.ReadByte); if (Buf = '/') and not EOF then begin if CheckIsComment then begin EatComment; Buf := ' '; end; end; if (IsWhiteSpace(Buf) = False) then begin FStream.Position := FStream.Position-1; break; end; end; end; procedure TCSSReader.ParseCSS; var Statement: String; Elements: TStringList; Commands: TStringList; Element: TCSSProps; I: Integer; begin while FindStatement(Statement) do begin Elements := GetStatementElements(Statement); Commands := GetStatementCommands(Statement); for I := 0 to Elements.Count-1 do begin Element := TCSSProps(Elements.Objects[I]); Element.ReadCommands(Commands); end; Elements.Free; Commands.Free; end; end; procedure TCSSReader.EatComment; var Buf: array[0..1] of char; begin Buf := #0#0; while (EOF = False) and (Buf <> '*/') do begin Buf[0] := Buf[1]; FStream.Read(Buf[1], 1); end; end; function TCSSReader.FindStatement(out AStatement: String): Boolean; var Buf: char; Buf1: array[0..255] of char; RCount: Integer; FStart, FEnd: Integer; begin Result := False; EatWhiteSpace; AStatement := ''; FStart := FStream.Position; while not EOF do begin Buf := Char(FStream.ReadByte); FEnd := FStream.Position; if (Buf = '/') and CheckIsComment then begin FStream.Position := FStart; RCount := FStream.Read(Buf1[0], FEnd-FStart-1); AStatement := AStatement + Copy(Buf1,0,RCount); FStream.Position := FEnd+1; EatComment; FStart := FStream.Position; end else if Buf = '}' then begin Result := True; FStream.Position := FStart; RCount := FStream.Read(Buf1[0], FEnd-FStart); AStatement := AStatement + Copy(Buf1,0,RCount); break; end; end; end; function TCSSReader.EOF: Boolean; begin Result := FStream.Position >= FStream.Size-1; end; constructor TCSSReader.Create(AStream: TStream; AGlobalProps: TCSSGlobalProps); begin inherited Create; FStream := AStream; FGlobalProps:= AGlobalProps; end; { TCSSProps } constructor TCSSProps.Create; begin FClassIDs := TStringList.Create; FFont := TCSSFont.Create; FBGColor := -1; FColor := -1; fTextDecoration:=[ctdNone]; end; destructor TCSSProps.Destroy; var i: Integer; begin for i := 0 to FClassIDs.Count-1 do FClassIDs.Objects[i].Free; FClassIDs.Free; FFont.Free; inherited Destroy; end; procedure TCSSProps.ReadCommands(ACommands: TStrings); var Args: TStringlist; ACommand: String; Command: String; I: Integer; Lines:array of string; begin for I := 0 to ACommands.Count-1 do begin ACommand := ACommands[I]; Args := GetCommandArgs(ACommand); // for x:=0 to Length(Args.Text)-1 do begin // // end; // for x Command := LowerCase(GetCommandName(ACommand)); if Command = 'color' then begin if Args.Count > 0 then Color := ColorFromString(Args[0]) else Color := clDefault; end else if Command = 'background-color' then if Args.Count > 0 then BGColor := ColorFromString(Args[0]) else BGColor := clDefault else if Command = 'background' then begin if Args.Count > 0 then BGColor := ColorFromString(Args[0]); if Args.Count > 1 then ; // background image if Args.Count > 2 then ; // background image repeat if Args.Count > 3 then ; // background attachment if Args.Count > 4 then ; // background position end else if Command = 'font-family' then Font.Name := Args[0] else if Command = 'font-size' then Font.Size := Args[0] else if Command = 'font-style' then Font.Style := CSSFontStyleFromName(Args) else if Command = 'font-weight' then Font.Weight := FontWeightFromString(Args[0]) else if Command = 'text-decoration' then TextDecoration:=TextDecorationFromSting(Args); Args.Free; end; end; { TCSSGlobalProps } constructor TCSSGlobalProps.Create; begin FElements := TStringList.Create; end; destructor TCSSGlobalProps.Destroy; var i: Integer; begin for i := 0 to FElements.Count-1 do FElements.Objects[i].Free; FElements.Free; inherited Destroy; end; function TCSSGlobalProps.GetElement(AElementID: String; ClassID: String; CreateIfNotExist: Boolean): TCSSProps; var ElementName: String; procedure LookForElement(const aElement: string); var ElementIndex: Integer; begin if ClassID <> '' then ElementName := Lowercase(aElement+'.'+ClassId) else ElementName := lowercase(aElement); ElementIndex := FElements.IndexOf(ElementName); if ElementIndex>=0 then begin result := TCSSProps(FElements.Objects[ElementIndex]); end; end; begin Result := nil; if (ClassID = '') and (AElementID = '') then exit; LookForElement(aElementID); if (Result=nil) and not CreateIfNotExist then LookForelement('*'); if (Result = nil) and CreateIfNotExist then begin Result := TCSSProps.Create; FElements.AddObject(ElementName, Result); end; end; {$ENDIF}