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

fpspreadsheet: Add cell-based BiDiMode. Read/write to/from biff8, xlsx, ods.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4469 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-01-25 18:55:33 +00:00
parent 15d43e4035
commit 8184c4b609
8 changed files with 164 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
components/fpspreadsheet/fpsclasses.pas
View File

@ -1175,6 +1175,7 @@ begin
P^.NumberFormatIndex := AItem.NumberFormatIndex;
P^.NumberFormat := AItem.NumberFormat;
P^.NumberFormatStr := AItem.NumberFormatStr;
P^.BiDiMode := AItem.BiDiMode;
Result := inherited Add(P);
end;
end;
@ -1293,6 +1294,9 @@ begin
if (P^.NumberFormatStr <> AItem.NumberFormatStr) then continue;
end;
if (uffBiDi in AItem.UsedFormattingFields) then
if (P^.BiDiMode <> AItem.BiDiMode) then continue;
// If we arrive here then the format records match.
exit;
end;

23
components/fpspreadsheet/fpsopendocument.pas
View File

@ -170,6 +170,7 @@ type
procedure WriteVirtualCells(AStream: TStream; ASheet: TsWorksheet);
function WriteBackgroundColorStyleXMLAsString(const AFormat: TsCellFormat): String;
function WriteBiDiModeStyleXMLAsString(const AFormat: TsCellFormat): String;
function WriteBorderStyleXMLAsString(const AFormat: TsCellFormat): String;
function WriteCommentXMLAsString(AComment: String): String;
function WriteDefaultFontXMLAsString: String;
@ -3555,6 +3556,14 @@ begin
fmt.HorAlignment := haCenter;
if fmt.HorAlignment <> haDefault then
Include(fmt.UsedFormattingFields, uffHorAlign);
// BiDi mode
s := GetAttrValue(styleChildNode, 'style:writing-mode');
if s = 'lr-tb' then
fmt.BiDiMode := bdRTL
else if s = 'rl-tb' then
fmt.BiDiMode := bdRTL;
if fmt.BiDiMode <> bdDefault then
Include(fmt.UsedFormattingFields, uffBiDi);
end;
styleChildNode := styleChildNode.NextSibling;
end;
@ -4282,7 +4291,7 @@ begin
'<style:table-cell-properties ' + s + '/>');
// style:paragraph-properties
s := WriteHorAlignmentStyleXMLAsString(fmt);
s := WriteHorAlignmentStyleXMLAsString(fmt) + WriteBiDiModeStyleXMLAsString(fmt);
if s <> '' then
AppendToStream(AStream,
'<style:paragraph-properties ' + s + '/>');
@ -4981,6 +4990,18 @@ begin
Result := Format('fo:background-color="%s" ', [ColorToHTMLColorStr(TsColor(mix))]);
end;
function TsSpreadOpenDocWriter.WriteBiDiModeStyleXMLAsString(
const AFormat: TsCellFormat): String;
begin
Result := '';
if not (uffBiDi in AFormat.UsedFormattingFields) then
exit;
case AFormat.BiDiMode of
bdLTR : Result := 'style:writing-mode="lr-tb" ';
bdRTL : Result := 'style:writing-mode="rl-tb" ';
end;
end;
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of borders and border styles into the
written file from the border settings in the given format record.

44
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -205,6 +205,7 @@ type
function ReadTextRotation(ACell: PCell): TsTextRotation;
function ReadVertAlignment(ACell: PCell): TsVertAlignment;
function ReadWordwrap(ACell: PCell): boolean;
function ReadBiDiMode(ACell: PCell): TsBiDiMode;
{ Writing of values }
function WriteBlank(ARow, ACol: Cardinal): PCell; overload;
@ -369,6 +370,9 @@ type
function WriteWordwrap(ARow, ACol: Cardinal; AValue: boolean): PCell; overload;
procedure WriteWordwrap(ACell: PCell; AValue: boolean); overload;
function WriteBiDiMode(ARow, ACol: Cardinal; AValue: TsBiDiMode): PCell; overload;
procedure WriteBiDiMode(ACell: PCell; AValue: TsBiDiMode); overload;
{ Formulas }
function BuildRPNFormula(ACell: PCell; ADestCell: PCell = nil): TsRPNFormula;
procedure CalcFormula(ACell: PCell);
@ -3075,6 +3079,22 @@ begin
end;
end;
{@@ ----------------------------------------------------------------------------
Returns the BiDi mode of the cell (right-to-left or left-to-right)
-------------------------------------------------------------------------------}
function TsWorksheet.ReadBiDiMode(ACell: PCell): TsBiDiMode;
var
fmt: PsCellFormat;
begin
Result := bdDefault;
if (ACell <> nil) then
begin
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
if (uffBiDi in fmt^.UsedFormattingFields) then
Result := fmt^.BiDiMode;
end;
end;
{ Merged cells }
@ -5741,6 +5761,28 @@ begin
ChangedCell(ACell^.Row, ACell^.Col);
end;
function TsWorksheet.WriteBiDiMode(ARow, ACol: Cardinal; AValue: TsBiDiMode): PCell;
begin
Result := GetCell(ARow, ACol);
WriteBiDiMode(Result, AVAlue);
end;
procedure TsWorksheet.WriteBiDiMode(ACell: PCell; AValue: TsBiDiMode);
var
fmt: TsCellFormat;
begin
if ACell = nil then
exit;
fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
fmt.BiDiMode := AValue;
if AValue <> bdDefault then
Include(fmt.UsedFormattingFields, uffBiDi)
else
Exclude(fmt.UsedFormattingFields, uffBiDi);
ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
ChangedCell(ACell^.Row, ACell^.Col);
end;
function TsWorksheet.GetFormatSettings: TFormatSettings;
begin
Result := FWorkbook.FormatSettings;
@ -7525,6 +7567,8 @@ begin
else s := s + '+' + GetEnumName(TypeInfo(TsCellBorder), ord(cb));
Result := Format('%s; %s', [Result, s]);
end;
if (uffBiDi in fmt^.UsedFormattingFields) then
Result := Format('%s; %s', [Result, GetEnumName(TypeInfo(TsBiDiMode), ord(fmt^.BiDiMode))]);
if Result <> '' then Delete(Result, 1, 2);
end;

6
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

@ -3015,6 +3015,12 @@ begin
AStrings.Add('NumberFormatStr=' + numFmt.NumFormatStr);
end;
if (ACell = nil) or not (uffBiDi in fmt.UsedFormattingFields) then
AStrings.Add('BiDi=(bdDefault)')
else
AStrings.Add(Format('BiDiMode=%s', [
GetEnumName(TypeInfo(TsBiDiMode), ord(fmt.BiDiMode))]));
if (Worksheet = nil) or not Worksheet.IsMerged(ACell) then
AStrings.Add('Merged range=(none)')
else

106
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -82,6 +82,7 @@ type
// Setter/Getter
function GetBackgroundColor(ACol, ARow: Integer): TsColor;
function GetBackgroundColors(ALeft, ATop, ARight, ABottom: Integer): TsColor;
function GetCellBiDiMode(ACol, ARow: Integer): TsBiDiMode;
function GetCellBorder(ACol, ARow: Integer): TsCellBorders;
function GetCellBorders(ALeft, ATop, ARight, ABottom: Integer): TsCellBorders;
function GetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder): TsCellBorderStyle;
@ -122,6 +123,7 @@ type
procedure SetAutoCalc(AValue: Boolean);
procedure SetBackgroundColor(ACol, ARow: Integer; AValue: TsColor);
procedure SetBackgroundColors(ALeft, ATop, ARight, ABottom: Integer; AValue: TsColor);
procedure SetCellBiDiMode(ACol, ARow: Integer; AValue: TsBiDiMode);
procedure SetCellBorder(ACol, ARow: Integer; AValue: TsCellBorders);
procedure SetCellBorders(ALeft, ATop, ARight, ABottom: Integer; AValue: TsCellBorders);
procedure SetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder;
@ -209,7 +211,8 @@ type
procedure InternalDrawTextInCell(AText: String; ARect: TRect;
ACellHorAlign: TsHorAlignment; ACellVertAlign: TsVertAlignment;
ATextRot: TsTextRotation; ATextWrap: Boolean; AFontIndex: Integer;
AOverrideTextColor: TColor; ARichTextParams: TsRichTextParams);
AOverrideTextColor: TColor; ARichTextParams: TsRichTextParams;
AIsRightToLeft: Boolean);
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
procedure Loaded; override;
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
@ -327,6 +330,9 @@ type
Expressed as index into the workbook's color palette. }
property BackgroundColors[ALeft, ATop, ARight, ABottom: Integer]: TsColor
read GetBackgroundColors write SetBackgroundColors;
{@@ Override system or sheet right-to-left mode for cell }
property CellBiDiMode[ACol,ARow: Integer]: TsBiDiMode
read GetCellBiDiMode write SetCellBiDiMode;
{@@ Set of flags indicating at which cell border a border line is drawn. }
property CellBorder[ACol, ARow: Integer]: TsCellBorders
read GetCellBorder write SetCellBorder;
@ -990,10 +996,12 @@ var
w, maxw: Integer;
txt: String;
cell: PCell;
RTL: Boolean;
begin
if Worksheet = nil then
exit;
RTL := IsRightToLeft;
maxw := -1;
for cell in Worksheet.Cells.GetColEnumerator(GetWorkSheetCol(ACol)) do
begin
@ -1001,9 +1009,13 @@ begin
txt := GetCellText(ACol, gRow);
if txt = '' then
Continue;
case Worksheet.ReadBiDiMode(cell) of
bdRTL: RTL := true;
bdLTR: RTL := false;
end;
w := RichTextWidth(Canvas, Workbook, Rect(0, 0, MaxInt, MaxInt),
txt, cell^.RichTextParams, Worksheet.ReadCellFontIndex(cell),
Worksheet.ReadTextRotation(cell), false, IsRightToLeft);
Worksheet.ReadTextRotation(cell), false, RTL);
if w > maxw then maxw := w;
end;
if maxw > -1 then
@ -2174,8 +2186,8 @@ begin
temp_rct := rct;
// for i := gc1 to gc2 do begin
for i:= gc2 downto gc1 do begin
// Starting from last col will insure drawing grid lines below text
// when text is overflow in RTL and have no problem in LTR
// Starting from last col will ensure drawing grid lines below text
// when text is overflowing in RTL, no problem in LTR
// (Modification by "shobits1" - ok)
ColRowToOffset(true, true, i, temp_rct.Left, temp_rct.Right);
if HorizontalIntersect(temp_rct, clipArea) and (i <> gc) then
@ -2349,6 +2361,7 @@ var
numfmt: TsNumFormatParams;
numFmtColor: TColor;
sidx: Integer; // number format section index
RTL: Boolean;
begin
if (Worksheet = nil) then
exit;
@ -2379,6 +2392,12 @@ begin
fmt := Workbook.GetPointerToCellFormat(lCell^.FormatIndex);
wrapped := (uffWordWrap in fmt^.UsedFormattingFields) or (fmt^.TextRotation = rtStacked);
RTL := IsRightToLeft;
if (uffBiDi in fmt^.UsedFormattingFields) then
case Worksheet.ReadBiDiMode(lCell) of
bdRTL : RTL := true;
bdLTR : RTL := false;
end;
// Text rotation
if (uffTextRotation in fmt^.UsedFormattingFields)
@ -2400,7 +2419,7 @@ begin
begin
if (lCell^.ContentType in [cctNumber, cctDateTime]) then
begin
if IsRightToLeft then
if RTL then
horAlign := haLeft
else
horAlign := haRight;
@ -2408,7 +2427,7 @@ begin
if (lCell^.ContentType in [cctBool]) then
horAlign := haCenter
else begin
if IsRightToLeft then
if RTL then
horAlign := haRight
else
horAlign := haLeft;
@ -2441,7 +2460,7 @@ begin
InflateRect(ARect, -constCellPadding, -constCellPadding);
InternalDrawTextInCell(txt, ARect, horAlign, vertAlign, txtRot, wrapped,
fntIndex, numfmtColor, lCell^.RichTextParams);
fntIndex, numfmtColor, lCell^.RichTextParams, RTL);
end;
{@@ ----------------------------------------------------------------------------
@ -2698,6 +2717,16 @@ begin
end;
end;
function TsCustomWorksheetGrid.GetCellBiDiMode(ACol,ARow: Integer): TsBiDiMode;
var
cell: PCell;
begin
cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if cell <> nil then
Result := Worksheet.ReadBiDiMode(cell) else
Result := bdDefault;
end;
{@@ ----------------------------------------------------------------------------
Returns the cell borders which are drawn around a given cell.
If the cell is part of a merged block then the borders of the merge base
@ -2935,6 +2964,7 @@ var
fmt: PsCellFormat;
fntIndex: Integer;
txtRot: TsTextRotation;
RTL: Boolean;
begin
Result := 0;
if ShowHeaders and ((ACol = 0) or (ARow = 0)) then
@ -2972,6 +3002,13 @@ begin
txtRot := fmt^.TextRotation else txtRot := trHorizontal;
wrapped := (uffWordWrap in fmt^.UsedFormattingFields);
RTL := IsRightToLeft;
if (uffBiDi in fmt^.UsedFormattingFields) then
case fmt^.BiDiMode of
bdRTL: RTL := true;
bdLTR: RTL := false;
end;
case txtRot of
trHorizontal: ;
rt90DegreeClockwiseRotation,
@ -2982,47 +3019,8 @@ begin
end;
Result := RichTextHeight(Canvas, Workbook, cellR, s, lCell^.RichTextParams,
fntIndex, txtRot, wrapped, IsRightToLeft)
fntIndex, txtRot, wrapped, RTL)
+ 2 * constCellPadding;
(*
wrapped := (uffWordWrap in fmt^.UsedFormattingFields)
or (fmt^.TextRotation = rtStacked);
// *** multi-line text ***
if wrapped then
begin
// horizontal
if ( (uffTextRotation in fmt^.UsedFormattingFields) and
(fmt^.TextRotation in [trHorizontal, rtStacked]))
or not (uffTextRotation in fmt^.UsedFormattingFields)
then
begin
cellR := CellRect(ACol, ARow);
InflateRect(cellR, -constCellPadding, -constCellPadding);
txtR := Bounds(cellR.Left, cellR.Top, cellR.Right-cellR.Left, cellR.Bottom-cellR.Top);
flags := DT_WORDBREAK and not DT_SINGLELINE;
LCLIntf.DrawText(Canvas.Handle, PChar(s), Length(s), txtR,
DT_CALCRECT or flags);
Result := txtR.Bottom - txtR.Top + 2*constCellPadding;
end;
// rotated wrapped text:
// do not consider this because wrapping affects cell height.
end else
// *** single-line text ***
begin
// not rotated
if ( not (uffTextRotation in fmt^.UsedFormattingFields) or
(fmt^.TextRotation = trHorizontal) )
then
Result := Canvas.TextHeight(s) + 2*constCellPadding
else
// rotated by +/- 90°
if (uffTextRotation in fmt^.UsedFormattingFields) and
(fmt^.TextRotation in [rt90DegreeClockwiseRotation, rt90DegreeCounterClockwiseRotation])
then
Result := Canvas.TextWidth(s) + 2*constCellPadding;
end;
*)
end;
end;
@ -3517,6 +3515,7 @@ end;
@param AFontIndex Font index to be used for drawing non-rich-text.
@param ARichTextParams an array of character and font index combinations for
rich-text formatting of text in cell
@param AIsRightToLeft if true cell must be drawn in right-to-left mode.
@Note The reason to separate AJustification from ACellHorAlign and ACelVertAlign is
the output of nfAccounting formatted numbers where the numbers are always
@ -3526,7 +3525,8 @@ end;
procedure TsCustomWorksheetGrid.InternalDrawTextInCell(AText: String;
ARect: TRect; ACellHorAlign: TsHorAlignment; ACellVertAlign: TsVertAlignment;
ATextRot: TsTextRotation; ATextWrap: Boolean; AFontIndex: Integer;
AOverrideTextColor: TColor; ARichTextParams: TsRichTextParams);
AOverrideTextColor: TColor; ARichTextParams: TsRichTextParams;
AIsRightToLeft: Boolean);
begin
// Since - due to the rich-text mode - characters are drawn individually their
// background occasionally overpaints the prev characters (italic). To avoid
@ -3536,7 +3536,7 @@ begin
// Work horse for text drawing, both standard text and rich-text
DrawRichText(Canvas, Workbook, ARect, AText, ARichTextParams, AFontIndex,
ATextWrap, ACellHorAlign, ACellVertAlign, ATextRot, AOverrideTextColor,
IsRightToLeft
AIsRightToLeft
);
end;
(*
@ -3730,6 +3730,7 @@ begin
end;
end;
*)
{@@ ----------------------------------------------------------------------------
Standard key handling method inherited from TCustomGrid. Is overridden to
catch some keys for special processing.
@ -5104,6 +5105,13 @@ begin
end;
end;
procedure TsCustomWorksheetGrid.SetCellBiDiMode(ACol, ARow: Integer;
AValue: TsBiDiMode);
begin
if Assigned(Worksheet) then
Worksheet.WriteBiDiMode(GetWorksheetRow(ARow), GetWorksheetCol(ACol), AValue);
end;
procedure TsCustomWorksheetGrid.SetCellBorder(ACol, ARow: Integer;
AValue: TsCellBorders);
var

8
components/fpspreadsheet/fpstypes.pas
View File

@ -209,8 +209,8 @@ type
);
{@@ List of possible formatting fields }
TsUsedFormattingField = (uffTextRotation, uffFont, {uffBold, }uffBorder,
uffBackground, uffNumberFormat, uffWordWrap, uffHorAlign, uffVertAlign
TsUsedFormattingField = (uffTextRotation, uffFont, uffBorder, uffBackground,
uffNumberFormat, uffWordWrap, uffHorAlign, uffVertAlign, uffBiDi
);
{ NOTE: "uffBackgroundColor" of older versions replaced by "uffBackground" }
@ -596,6 +596,9 @@ type
Keys: TsSortKeys;
end;
{@@ Switch a cell from left-to-right to right-to-left orientation }
TsBiDiMode = (bdDefault, bdLTR, bdRTL);
{@@ Record containing all details for cell formatting }
TsCellFormat = record
Name: String;
@ -609,6 +612,7 @@ type
BorderStyles: TsCelLBorderStyles;
Background: TsFillPattern;
NumberFormatIndex: Integer;
BiDiMode: TsBiDiMode;
// next two are deprecated...
NumberFormat: TsNumberFormat;
NumberFormatStr: String;

14
components/fpspreadsheet/xlsbiff8.pas
View File

@ -361,6 +361,9 @@ const
{%H-}MASK_HLINK_TARGETFRAME = $00000080;
{%H-}MASK_HLINK_UNCPATH = $00000100;
{ RIGHT-TO-LEFT FLAG }
MASK_XF_BIDI = $C0;
SHAPEID_BASE = 1024;
@ -1515,6 +1518,11 @@ begin
if (rec.Align_TextBreak and MASK_XF_TEXTWRAP) <> 0 then
Include(fmt.UsedFormattingFields, uffWordwrap);
// BiDi mode
b := (rec.Indent_Shrink_TextDir and MASK_XF_BIDI) shr 6;
if b in [0..2] then fmt.BiDiMode := TsBiDiMode(b);
if b > 0 then Include(fmt.UsedFormattingFields, uffBiDi);
// TextRotation
case rec.TextRotation of
XF_ROTATION_HORIZONTAL : fmt.TextRotation := trHorizontal;
@ -3338,6 +3346,12 @@ begin
Bit 5: MergeCell
Bits 6-7: Reading direction }
rec.Indent_Shrink_TextDir := 0;
if (AFormatRecord <> nil) and (uffBiDi in AFormatRecord^.UsedFormattingFields) then
begin
b := ord(AFormatRecord^.BiDiMode);
if b > 0 then
rec.Indent_Shrink_TextDir := rec.Indent_Shrink_TextDir or (b shl 6);
end;
{ Used attributes }
rec.UsedAttrib :=

11
components/fpspreadsheet/xlsxooxml.pas
View File

@ -838,6 +838,10 @@ begin
if s1 = 'bottom' then
fmt.VertAlignment := vaBottom;
s1 := GetAttrValue(childNode, 'readingOrder');
if (s1 = '1') or (s1 = '2') then
fmt.BiDiMode := TsBiDiMode(StrToInt(s1));
s1 := GetAttrValue(childNode, 'wrapText');
if (s1 <> '0') then
Include(fmt.UsedFormattingFields, uffWordWrap);
@ -867,6 +871,8 @@ begin
Include(fmt.UsedFormattingFields, uffVertAlign);
if fmt.TextRotation <> trHorizontal then
Include(fmt.UsedFormattingFields, uffTextRotation);
if fmt.BiDiMode <> bdDefault then
Include(fmt.UsedFormattingFields, uffBiDi);
FCellFormatList.Add(fmt);
end;
node := node.NextSibling;
@ -3040,9 +3046,14 @@ begin
vaBottom: sAlign := sAlign + 'vertical="bottom" ';
end;
{ Word wrap }
if (uffWordWrap in fmt^.UsedFormattingFields) then
sAlign := sAlign + 'wrapText="1" ';
{ BiDi mode }
if (uffBiDi in fmt^.UsedFormattingFields) and (fmt^.BiDiMode <> bdDefault) then
sAlign := sAlign + Format('readingOrder="%d" ', [Ord(fmt^.BiDiMode)]);
{ Fill }
if (uffBackground in fmt^.UsedFormattingFields) then
begin