pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: HTML reader understands horizontal and vertical cell alignment

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4253 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-08-05 11:14:58 +00:00
parent 525c51cd9e
commit 2241febbd4
1 changed files with 51 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

51
components/fpspreadsheet/fpshtml.pas
View File

@ -36,7 +36,9 @@ type
FHRef: String; FHRef: String;
procedure ExtractBackgroundColor; procedure ExtractBackgroundColor;
procedure ExtractHRef; procedure ExtractHRef;
procedure ExtractHorAlign;
procedure ExtractMergedRange; procedure ExtractMergedRange;
procedure ExtractVertAlign;
procedure InitFont(AFont: TsFont); procedure InitFont(AFont: TsFont);
procedure InitCellFormat; procedure InitCellFormat;
procedure TagFoundHandler(NoCaseTag, ActualTag: string); procedure TagFoundHandler(NoCaseTag, ActualTag: string);
@ -531,6 +533,29 @@ begin
end; end;
end; end;
procedure TsHTMLReader.ExtractHorAlign;
var
idx: Integer;
s: String;
begin
idx := FAttrList.IndexOfName('align'); // html tag
if idx = -1 then
idx := FAttrList.IndexOfName('text-align'); // value taken from "style"
if idx > -1 then
begin
case FAttrList[idx].Value of
'left' : FCurrCellFormat.HorAlignment := haLeft;
'center' : FCurrCellFormat.HorAlignment := haCenter;
'right' : FCurrCellFormat.HorAlignment := haRight;
// -- not implemented in fps
// 'justify'
// 'char"
else exit;
end;
Include(FCurrCellFormat.UsedFormattingFields, uffHorAlign);
end;
end;
procedure TsHTMLReader.ExtractHRef; procedure TsHTMLReader.ExtractHRef;
var var
idx: Integer; idx: Integer;
@ -556,6 +581,26 @@ begin
// -1 to compensate for correct determination of the range end cell // -1 to compensate for correct determination of the range end cell
end; end;
procedure TsHTMLReader.ExtractVertAlign;
var
idx: Integer;
s: String;
begin
idx := FAttrList.IndexOfName('valign'); // html tag
if idx = -1 then
idx := FAttrList.IndexOfName('vertical-align'); // style tag
if idx > -1 then
begin
case FAttrList[idx].Value of
'top' : FCurrCellFormat.VertAlignment := vaTop;
'middle': FCurrCellFormat.VertAlignment := vaCenter;
'bottom': FCurrCellFormat.VertAlignment := vaBottom;
else exit; // others not supported
end;
Include(FCurrCellFormat.UsedFormattingFields, uffVertAlign);
end;
end;
procedure TsHTMLReader.InitFont(AFont: TsFont); procedure TsHTMLReader.InitFont(AFont: TsFont);
var var
fnt: TsFont; fnt: TsFont;
@ -575,6 +620,10 @@ begin
// HTML tables, by default, have word-wrapped cell texts. // HTML tables, by default, have word-wrapped cell texts.
Include(FCurrCellFormat.UsedFormattingFields, uffWordwrap); Include(FCurrCellFormat.UsedFormattingFields, uffWordwrap);
// Vertical alignment, by default, is "middle"
FCurrCellFormat.VertAlignment := vaCenter;
Include(FCurrCellFormat.UsedFormattingFields, uffVertAlign);
end; end;
procedure TsHTMLReader.ReadFromStream(AStream: TStream); procedure TsHTMLReader.ReadFromStream(AStream: TStream);
@ -640,6 +689,8 @@ begin
FAttrList.Parse(ActualTag); FAttrList.Parse(ActualTag);
ExtractMergedRange; ExtractMergedRange;
ExtractBackgroundColor; ExtractBackgroundColor;
ExtractHorAlign;
ExtractVertAlign;
end else end else
if ((NoCaseTag = '<TH>') or (pos('<TH ', NoCaseTag) = 1)) and FInTable then if ((NoCaseTag = '<TH>') or (pos('<TH ', NoCaseTag) = 1)) and FInTable then
begin begin