diff --git a/components/fpspreadsheet/fpsactions.pas b/components/fpspreadsheet/fpsactions.pas
index 8af3de2fc..f6b58be65 100644
--- a/components/fpspreadsheet/fpsactions.pas
+++ b/components/fpspreadsheet/fpsactions.pas
@@ -1525,7 +1525,7 @@ var
sfnt: TsFont;
begin
sfnt := TsFont.Create;
- Convert_Font_to_sFont(Workbook, GetDialog.Font, sfnt);
+ Convert_Font_to_sFont(GetDialog.Font, sfnt);
Worksheet.WriteFont(ACell, Workbook.AddFont(sfnt));
end;
@@ -1550,7 +1550,7 @@ begin
else
sfnt := Workbook.GetDefaultFont;
end;
- Convert_sFont_to_Font(Workbook, sfnt, fnt);
+ Convert_sFont_to_Font(sfnt, fnt);
GetDialog.Font.Assign(fnt);
finally
fnt.Free;
diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas
index 8daeecfaa..509a524af 100755
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -172,6 +172,7 @@ type
function ReadCellBorderStyle(ACell: PCell; ABorder: TsCellBorder): TsCellBorderStyle;
function ReadCellBorderStyles(ACell: PCell): TsCellBorderStyles;
function ReadCellFont(ACell: PCell): TsFont;
+ function ReadCellFontIndex(ACell: PCell): Integer;
function ReadCellFormat(ACell: PCell): TsCellFormat;
function ReadHorAlignment(ACell: PCell): TsHorAlignment;
procedure ReadNumFormat(ACell: PCell; out ANumFormat: TsNumberFormat;
@@ -239,7 +240,8 @@ type
AFormula: TsRPNFormula); overload;
function WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring): PCell; overload;
- procedure WriteUTF8Text(ACell: PCell; AText: ansistring); overload;
+// procedure WriteUTF8Text(ACell: PCell; AText: ansistring); overload;
+ procedure WriteUTF8Text(ACell: PCell; AText: String; ARichTextparams: TsRichTextParams = nil); overload;
{ Writing of cell attributes }
function WriteBackground(ARow, ACol: Cardinal; AStyle: TsFillStyle;
@@ -286,9 +288,11 @@ type
procedure WriteDecimals(ACell: PCell; ADecimals: Byte); overload;
function WriteFont(ARow, ACol: Cardinal; const AFontName: String;
- AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload;
+ AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor;
+ APosition: TsFontPosition = fpNormal): Integer; overload;
function WriteFont(ACell: PCell; const AFontName: String;
- AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload;
+ AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor;
+ APosition: TsFontPosition = fpNormal): Integer; overload;
function WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer): PCell; overload;
procedure WriteFont(ACell: PCell; AFontIndex: Integer); overload;
function WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer; overload;
@@ -644,12 +648,12 @@ type
function GetPointerToCellFormat(AIndex: Integer): PsCellFormat;
{ Font handling }
- function AddFont(const AFontName: String; ASize: Single;
- AStyle: TsFontStyles; AColor: TsColor): Integer; overload;
+ function AddFont(const AFontName: String; ASize: Single; AStyle: TsFontStyles;
+ AColor: TsColor; APosition: TsFontPosition = fpNormal): Integer; overload;
function AddFont(const AFont: TsFont): Integer; overload;
procedure DeleteFont(AFontIndex: Integer);
- function FindFont(const AFontName: String; ASize: Single;
- AStyle: TsFontStyles; AColor: TsColor): Integer;
+ function FindFont(const AFontName: String; ASize: Single; AStyle: TsFontStyles;
+ AColor: TsColor; APosition: TsFontPosition = fpNormal): Integer;
function GetBuiltinFontCount: Integer;
function GetDefaultFont: TsFont;
function GetDefaultFontSize: Single;
@@ -660,7 +664,8 @@ type
procedure InitFonts;
procedure RemoveAllFonts;
procedure ReplaceFont(AFontIndex: Integer; AFontName: String;
- ASize: Single; AStyle: TsFontStyles; AColor: TsColor);
+ ASize: Single; AStyle: TsFontStyles; AColor: TsColor;
+ APosition: TsFontPosition = fpNormal);
procedure SetDefaultFont(const AFontName: String; ASize: Single);
{ Number format handling }
@@ -2710,8 +2715,7 @@ end;
{@@ ----------------------------------------------------------------------------
Determines the font used by a specified cell. Returns the workbook's default
- font if the cell does not exist. Considers the uffBold and uffFont formatting
- fields of the cell
+ font if the cell does not exist.
-------------------------------------------------------------------------------}
function TsWorksheet.ReadCellFont(ACell: PCell): TsFont;
var
@@ -2727,6 +2731,23 @@ begin
Result := Workbook.GetDefaultFont;
end;
+{@@ ----------------------------------------------------------------------------
+ Determines the index of the font used by a specified cell, referring to the
+ workbooks font list. Returns 0 (the default font index) if the cell does not
+ exist.
+-------------------------------------------------------------------------------}
+function TsWorksheet.ReadCellFontIndex(ACell: PCell): Integer;
+var
+ fmt: PsCellFormat;
+begin
+ Result := DEFAULT_FONTINDEX;
+ if ACell <> nil then
+ begin
+ fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
+ Result := fmt^.FontIndex;
+ end;
+end;
+
{@@ ----------------------------------------------------------------------------
Returns the format record that is assigned to a specified cell
-------------------------------------------------------------------------------}
@@ -3460,9 +3481,11 @@ end;
@param ACell Pointer to the cell
@param AText The text to be written encoded in utf-8
-------------------------------------------------------------------------------}
-procedure TsWorksheet.WriteUTF8Text(ACell: PCell; AText: ansistring);
+procedure TsWorksheet.WriteUTF8Text(ACell: PCell; AText: String;
+ ARichTextParams: TsRichTextParams = nil);
var
r, c: Cardinal;
+ i: Integer;
hyperlink: TsHyperlink;
begin
if ACell = nil then
@@ -3499,6 +3522,12 @@ begin
ACell^.ContentType := cctUTF8String;
ACell^.UTF8StringValue := AText;
+ if Length(ARichTextParams) > 0 then begin
+ SetLength(ACell^.RichTextParams, Length(ARichTextParams));
+ for i:=0 to High(ARichTextParams) do
+ ACell^.RichTextParams[i] := ARichTextParams[i];
+ end;
+
ChangedCell(ACell^.Row, ACell^.Col);
end;
@@ -4558,12 +4587,16 @@ end;
@param AFontSize Size of the font, in points
@param AFontStyle Set with font style attributes
(don't use those of unit "graphics" !)
+ @param AFontColor RGB value of the font's color
+ @param APosition Specifies sub- or superscript text
@return Index of the font in the workbook's font list.
-------------------------------------------------------------------------------}
function TsWorksheet.WriteFont(ARow, ACol: Cardinal; const AFontName: String;
- AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer;
+ AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor;
+ APosition: TsFontPosition = fpNormal): Integer;
begin
- Result := WriteFont(GetCell(ARow, ACol), AFontName, AFontSize, AFontStyle, AFontColor);
+ Result := WriteFont(GetCell(ARow, ACol), AFontName, AFontSize, AFontStyle,
+ AFontColor, APosition);
end;
{@@ ----------------------------------------------------------------------------
@@ -4576,10 +4609,13 @@ end;
@param AFontSize Size of the font, in points
@param AFontStyle Set with font style attributes
(don't use those of unit "graphics" !)
+ @param AFontColor RGB value of the font's color
+ @param APosition Specified subscript or superscript text.
@return Index of the font in the workbook's font list.
-------------------------------------------------------------------------------}
function TsWorksheet.WriteFont(ACell: PCell; const AFontName: String;
- AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer;
+ AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor;
+ APosition: TsFontPosition = fpNormal): Integer;
var
fmt: TsCellFormat;
begin
@@ -4589,9 +4625,9 @@ begin
Exit;
end;
- Result := FWorkbook.FindFont(AFontName, AFontSize, AFontStyle, AFontColor);
+ Result := FWorkbook.FindFont(AFontName, AFontSize, AFontStyle, AFontColor, APosition);
if Result = -1 then
- result := FWorkbook.AddFont(AFontName, AFontSize, AFontStyle, AFontColor);
+ result := FWorkbook.AddFont(AFontName, AFontSize, AFontStyle, AFontColor, APosition);
fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
Include(fmt.UsedFormattingFields, uffFont);
@@ -7036,10 +7072,12 @@ end;
@param ASize Size of the font in points
@param AStyle Style of the font, a combination of TsFontStyle elements
@param AColor RGB valoe of the font color
+ @param APosition Specifies subscript or superscript text.
@return Index of the font in the workbook's font list
-------------------------------------------------------------------------------}
function TsWorkbook.AddFont(const AFontName: String; ASize: Single;
- AStyle: TsFontStyles; AColor: TsColor): Integer;
+ AStyle: TsFontStyles; AColor: TsColor;
+ APosition: TsFontPosition = fpNormal): Integer;
var
fnt: TsFont;
begin
@@ -7048,6 +7086,7 @@ begin
fnt.Size := ASize;
fnt.Style := AStyle;
fnt.Color := AColor;
+ fnt.Position := APosition;
Result := AddFont(fnt);
end;
@@ -7088,10 +7127,11 @@ end;
@param ASize Size of the font in points
@param AStyle Style of the font, a combination of TsFontStyle elements
@param AColor RGB value of the font color
+ @param APosition Specified subscript or superscript text.
@return Index of the font in the font list, or -1 if not found.
-------------------------------------------------------------------------------}
function TsWorkbook.FindFont(const AFontName: String; ASize: Single;
- AStyle: TsFontStyles; AColor: TsColor): Integer;
+ AStyle: TsFontStyles; AColor: TsColor; APosition: TsFontPosition = fpNormal): Integer;
const
EPS = 1e-3;
var
@@ -7104,7 +7144,8 @@ begin
SameText(AFontName, fnt.FontName) and
SameValue(ASize, fnt.Size, EPS) and // careful when comparing floating point numbers
(AStyle = fnt.Style) and
- (AColor = fnt.Color)
+ (AColor = fnt.Color) and
+ (APosition = fnt.Position)
then
exit;
end;
@@ -7164,17 +7205,19 @@ end;
Replaces the built-in font at a specific index with different font parameters
-------------------------------------------------------------------------------}
procedure TsWorkbook.ReplaceFont(AFontIndex: Integer; AFontName: String;
- ASize: Single; AStyle: TsFontStyles; AColor: TsColor);
+ ASize: Single; AStyle: TsFontStyles; AColor: TsColor;
+ APosition: TsFontPosition = fpNormal);
var
fnt: TsFont;
begin
- if (AFontIndex < FBuiltinFontCount) and (AFontIndex <> 4) then
+ if (AFontIndex < FBuiltinFontCount) then //and (AFontIndex <> 4) then
begin
fnt := TsFont(FFontList[AFontIndex]);
fnt.FontName := AFontName;
fnt.Size := ASize;
fnt.Style := AStyle;
fnt.Color := AColor;
+ fnt.Position := APosition;
end;
end;
@@ -7255,6 +7298,8 @@ begin
if (fssItalic in fnt.Style) then Result := Result + '; italic';
if (fssUnderline in fnt.Style) then Result := Result + '; underline';
if (fssStrikeout in fnt.Style) then result := Result + '; strikeout';
+ if fnt.Position = fpSubscript then Result := Result + '; subscript';
+ if fnt.Position = fpSuperscript then Result := Result + '; superscript';
end else
Result := '';
end;
diff --git a/components/fpspreadsheet/fpspreadsheetctrls.pas b/components/fpspreadsheet/fpspreadsheetctrls.pas
index 817ed9d5e..13baa9829 100644
--- a/components/fpspreadsheet/fpspreadsheetctrls.pas
+++ b/components/fpspreadsheet/fpspreadsheetctrls.pas
@@ -2675,6 +2675,7 @@ var
r1, r2, c1, c2: Cardinal;
fmt: TsCellFormat;
numFmt: TsNumFormatParams;
+ rtp: TsRichTextParam;
begin
if (ACell <> nil) then
fmt := Workbook.GetCellFormat(ACell^.FormatIndex)
@@ -2692,6 +2693,17 @@ begin
Workbook.GetFontAsString(fmt.FontIndex)
]));
+ if (ACell <> nil) and (Length(ACell^.RichTextParams) > 0) then
+ begin
+ s := '';
+ for rtp in ACell^.RichTextParams do
+ s := Format('%s; Font #%d @ %d-%d', [s, rtp.FontIndex, rtp.StartIndex, rtp.EndIndex]);
+ Delete(s, 1, 2);
+ if s = '' then s := '(none)';
+ AStrings.Add('Rich-text parameters='+s);
+ end else
+ AStrings.Add('Rich-text parameters=(none)');
+
if (ACell=nil) or not (uffTextRotation in fmt.UsedFormattingFields)
then AStrings.Add('TextRotation=(default)')
else AStrings.Add(Format('TextRotation=%s', [
diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas
index 77f7ff877..1330f85ff 100644
--- a/components/fpspreadsheet/fpspreadsheetgrid.pas
+++ b/components/fpspreadsheet/fpspreadsheetgrid.pas
@@ -168,10 +168,16 @@ type
function GetEditText(ACol, ARow: Integer): String; override;
function HasBorder(ACell: PCell; ABorder: TsCellBorder): Boolean;
procedure HeaderSized(IsColumn: Boolean; AIndex: Integer); override;
+ procedure InternalDrawTextInCell(AText: String; ARect: TRect;
+ ACellHorAlign: TsHorAlignment; ACellVertAlign: TsVertAlignment;
+ ATextRot: TsTextRotation; ATextWrap: Boolean; AFontIndex: Integer;
+ ARichTextParams: TsRichTextParams);
+ {
procedure InternalDrawTextInCell(AText, AMeasureText: String; ARect: TRect;
AJustification: Byte; ACellHorAlign: TsHorAlignment;
ACellVertAlign: TsVertAlignment; ATextRot: TsTextRotation;
- ATextWrap, ReplaceTooLong: Boolean);
+ ATextWrap, ReplaceTooLong: Boolean; ARichTextParams: TsRichTextParams);
+ }
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
procedure Loaded; override;
procedure LoadFromWorksheet(AWorksheet: TsWorksheet);
@@ -1164,7 +1170,7 @@ end;
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.Convert_sFont_to_Font(sFont: TsFont; AFont: TFont);
begin
- fpsVisualUtils.Convert_sFont_to_Font(Workbook, sFont, AFont);
+ fpsVisualUtils.Convert_sFont_to_Font(sFont, AFont);
end;
{@@ ----------------------------------------------------------------------------
@@ -1176,7 +1182,7 @@ end;
procedure TsCustomWorksheetGrid.Convert_Font_to_sFont(AFont: TFont;
sFont: TsFont);
begin
- fpsVisualUtils.Convert_Font_to_sFont(Workbook, AFont, sFont);
+ fpsVisualUtils.Convert_Font_to_sFont(AFont, sFont);
end;
{@@ ----------------------------------------------------------------------------
@@ -2081,6 +2087,7 @@ var
horAlign: TsHorAlignment;
vertAlign: TsVertAlignment;
txtRot: TsTextRotation;
+ fntIndex: Integer;
lCell: PCell;
justif: Byte;
fmt: PsCellFormat;
@@ -2110,10 +2117,29 @@ begin
// Cells
fmt := Workbook.GetPointerToCellFormat(lCell^.FormatIndex);
wrapped := (uffWordWrap in fmt^.UsedFormattingFields) or (fmt^.TextRotation = rtStacked);
- txtRot := fmt^.TextRotation;
- vertAlign := fmt^.VertAlignment;
- if vertAlign = vaDefault then vertAlign := vaBottom;
- if fmt^.HorAlignment <> haDefault then
+ if (uffTextRotation in fmt^.UsedFormattingFields)
+ then txtRot := fmt^.TextRotation
+ else txtRot := trHorizontal;
+ if (uffVertAlign in fmt^.UsedFormattingFields)
+ then vertAlign := fmt^.VertAlignment
+ else vertAlign := vaDefault;
+ if vertAlign = vaDefault then
+ vertAlign := vaBottom;
+ if (uffHorAlign in fmt^.UsedFormattingFields)
+ then horAlign := fmt^.HorAlignment
+ else horAlign := haDefault;
+ if (horAlign = haDefault) then
+ begin
+ if (lCell^.ContentType in [cctNumber, cctDateTime]) then
+ horAlign := haRight
+ else
+ if (lCell^.ContentType in [cctBool]) then
+ horAlign := haCenter
+ else
+ horAlign := haLeft;
+ end;
+ {
+ fmt^.HorAlignment <> haDefault then
horAlign := fmt^.HorAlignment
else
begin
@@ -2121,11 +2147,14 @@ begin
horAlign := haRight
else
horAlign := haLeft;
- end;
+ end; }
+
+ if (uffFont in fmt^.UsedFormattingFields)
+ then fntIndex := fmt^.FontIndex
+ else fntIndex := DEFAULT_FONTINDEX;
InflateRect(ARect, -constCellPadding, -constCellPadding);
-// txt := GetCellText(ACol, ARow);
txt := GetCellText(GetGridRow(lCell^.Col), GetGridCol(lCell^.Row));
if txt = '' then
exit;
@@ -2151,8 +2180,12 @@ begin
vaBottom: justif := 0;
end;
end;
+ InternalDrawTextInCell(txt, ARect, horAlign, vertAlign, txtRot, wrapped,
+ fntIndex, lCell^.RichTextParams);
+{
InternalDrawTextInCell(txt, txt, ARect, justif, horAlign, vertAlign,
- txtRot, wrapped, false);
+ txtRot, wrapped, false, lCell^.RichTextParams);
+ }
end;
{@@ ----------------------------------------------------------------------------
@@ -3084,18 +3117,34 @@ end;
@param ACellVertAlign Is the VertAlignment property stored in the cell
@param ATextRot Determines the rotation angle of the text.
@param ATextWrap Determines if the text can wrap into multiple lines
- @param ReplaceTooLang If true too-long texts are replaced by a series of
- # chars filling the cell.
+ @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
@Note The reason to separate AJustification from ACellHorAlign and ACelVertAlign is
the output of nfAccounting formatted numbers where the numbers are always
right-aligned, and the currency symbol is left-aligned.
THIS FEATURE IS CURRENTLY NO LONGER SUPPORTED.
-------------------------------------------------------------------------------}
+procedure TsCustomWorksheetGrid.InternalDrawTextInCell(AText: String;
+ ARect: TRect; ACellHorAlign: TsHorAlignment; ACellVertAlign: TsVertAlignment;
+ ATextRot: TsTextRotation; ATextWrap: Boolean; AFontIndex: Integer;
+ ARichTextParams: TsRichTextParams);
+begin
+ // Since - due to the rich-text mode - characters are drawn individually their
+ // background occasionally overpaints the prev characters (italic). To avoid
+ // this we do not paint the character background - it is not needed anyway.
+ Canvas.Brush.Style := bsClear;
+
+ // Work horse for text drawing, both standard text and rich-text
+ DrawRichText(Canvas, Workbook, ARect, AText, AFontIndex, ARichTextParams,
+ ATextWrap, ACellHorAlign, ACellVertAlign, ATextRot);
+end;
+(*
procedure TsCustomWorksheetGrid.InternalDrawTextInCell(AText, AMeasureText: String;
ARect: TRect; AJustification: Byte; ACellHorAlign: TsHorAlignment;
ACellVertAlign: TsVertAlignment; ATextRot: TsTextRotation;
- ATextWrap, ReplaceTooLong: Boolean);
+ ATextWrap, ReplaceTooLong: Boolean; ARichTextParams: TsRichTextParams);
var
ts: TTextStyle;
flags: Cardinal;
@@ -3281,7 +3330,7 @@ begin
end;
end;
end;
-
+ *)
{@@ ----------------------------------------------------------------------------
Standard key handling method inherited from TCustomGrid. Is overridden to
catch the ESC key during editing in order to restore the old cell text
diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas
index b08b2dc71..5a10954e0 100644
--- a/components/fpspreadsheet/fpstypes.pas
+++ b/components/fpspreadsheet/fpstypes.pas
@@ -403,6 +403,9 @@ type
{@@ Set of font styles }
TsFontStyles = set of TsFontStyle;
+ {@@ Font position (subscript or superscript) }
+ TsFontPosition = (fpNormal, fpSubscript, fpSuperscript);
+
{@@ Font record used in fpspreadsheet. Contains the font name, the font size
(in points), the font style, and the font color. }
TsFont = class
@@ -414,8 +417,20 @@ type
Style: TsFontStyles;
{@@ Text color given as rgb value }
Color: TsColor;
+ {@@ Text position }
+ Position: TsFontPosition;
end;
+ {@@ Parameter describing formatting of an text range in cell text }
+ TsRichTextParam = record
+ FontIndex: Integer;
+ StartIndex: Integer; // zero-based
+ EndIndex: Integer; // zero-based, next character!
+ end;
+
+ {@@ Parameters describing formatting of text ranges in cell text }
+ TsRichTextParams = array of TsRichTextParam;
+
{@@ Indicates the border for a cell. If included in the CellBorders set the
corresponding border is drawn in the style defined by the CellBorderStyle. }
TsCellBorder = (cbNorth, cbWest, cbEast, cbSouth, cbDiagUp, cbDiagDown);
@@ -583,7 +598,8 @@ type
{ Index of format record in the workbook's FCellFormatList }
FormatIndex: Integer;
{ Cell content }
- UTF8StringValue: String; // Strings cannot be part of a variant record
+ UTF8StringValue: String; // Strings cannot be part of a variant record
+ RichTextParams: TsRichTextParams; // Formatting of individual text ranges
FormulaValue: String;
case ContentType: TCellContentType of // variant part must be at the end
cctEmpty : (); // has no data at all
diff --git a/components/fpspreadsheet/fpsvisualutils.pas b/components/fpspreadsheet/fpsvisualutils.pas
index 18a82cc11..8233749df 100644
--- a/components/fpspreadsheet/fpsvisualutils.pas
+++ b/components/fpspreadsheet/fpsvisualutils.pas
@@ -16,11 +16,23 @@ procedure Convert_Font_to_sFont(AWorkbook: TsWorkbook; AFont: TFont; sFont: TsFo
function WrapText(ACanvas: TCanvas; const AText: string; AMaxWidth: integer): string;
+procedure DrawRichText(ACanvas: TCanvas; AWorkbook: TsWorkbook; const ARect: TRect;
+ const AText: String; AFontIndex: Integer; ARichTextParams: TsRichTextParams;
+ AWordwrap: Boolean; AHorAlignment: TsHorAlignment; AVertAlignment: TsVertAlignment;
+ ARotation: TsTextRotation);
+
+function RichTextWidth(ACanvas: TCanvas; AWorkbook: TsWorkbook; const AText: String;
+ AFontIndex: Integer; ARichTextParams: TsRichTextParams): Integer;
+
implementation
uses
- Types, LCLType, LCLIntf, fpsUtils;
+ Types, Math, LCLType, LCLIntf, LazUTF8, fpsUtils;
+
+const
+{@@ Font size factor for sub-/superscript characters }
+ SUBSCRIPT_SUPERSCRIPT_FACTOR = 0.6;
{@@ ----------------------------------------------------------------------------
Converts a spreadsheet font to a font used for painting (TCanvas.Font).
@@ -151,4 +163,444 @@ begin
end;
end;
+procedure DrawRichText(ACanvas: TCanvas; AWorkbook: TsWorkbook; const ARect: TRect;
+ const AText: String; AFontIndex: Integer; ARichTextParams: TsRichTextParams;
+ AWordwrap: Boolean; AHorAlignment: TsHorAlignment; AVertAlignment: TsVertAlignment;
+ ARotation: TsTextRotation);
+type
+ TLineInfo = record
+ pStart, pEnd: PChar;
+ NumSpaces: Integer;
+ FirstRtpIndex: Integer;
+ NextRtpIndex: Integer;
+ Width: Integer;
+ Height: Integer;
+ end;
+ TRtState = (rtEnter, rtExit);
+var
+ xpos, ypos: Integer;
+ p, pStartText: PChar;
+ iRtp: Integer;
+ lineInfo: TLineInfo;
+ lineInfos: Array of TLineInfo = nil;
+ totalHeight, stackPeriod: Integer;
+
+ procedure InitFont(P: PChar; out rtState: TRtState;
+ PendingRtpIndex: Integer; out AHeight: Integer);
+ var
+ fnt: TsFont;
+ hasRtp: Boolean;
+ rtp: TsRichTextParam;
+ begin
+ fnt := AWorkbook.GetFont(AFontIndex);
+ hasRtp := PendingRtpIndex >= 0;
+ if hasRTP and (PendingRtpIndex < Length(ARichTextParams)) then begin
+ rtp := ARichTextParams[PendingRtpIndex];
+ if p - pStartText >= rtp.StartIndex then
+ begin
+ fnt := AWorkbook.GetFont(rtp.FontIndex);
+ rtState := rtEnter;
+ end else
+ rtState := rtExit;
+ end;
+ Convert_sFont_to_Font(fnt, ACanvas.Font);
+ AHeight := ACanvas.TextHeight('Tg');
+ if (fnt <> nil) and (fnt.Position <> fpNormal) then
+ ACanvas.Font.Size := round(ACanvas.Font.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+ end;
+
+ procedure UpdateFont(P:PChar; var rtState: TRtState;
+ var PendingRtpIndex: Integer; var AHeight: Integer;
+ out AFontPos: TsFontPosition);
+ var
+ hasRtp: Boolean;
+ rtp: TsRichTextParam;
+ fnt: TsFont;
+ begin
+ fnt := AWorkbook.GetFont(AFontIndex);
+ hasRtp := PendingRtpIndex >= 0;
+ if hasRtp and (PendingRtpIndex < Length(ARichTextParams)) then
+ begin
+ rtp := ARichTextParams[PendingRtpIndex];
+ if (p - pStartText >= rtp.StartIndex) and (rtState = rtExit) then
+ begin
+ fnt := AWorkbook.GetFont(rtp.FontIndex);
+ Convert_sFont_to_Font(fnt, ACanvas.Font);
+ AHeight := ACanvas.TextHeight('Tg');
+ if fnt.Position <> fpNormal then
+ ACanvas.Font.Size := round(ACanvas.Font.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+ rtState := rtEnter;
+ end else
+ if (p - pStartText >= rtp.EndIndex) and (rtState = rtEnter) then
+ begin
+ inc(PendingRtpIndex);
+ if PendingRtpIndex = Length(ARichTextparams) then
+ begin
+ fnt := AWorkbook.GetFont(AFontIndex);
+ rtState := rtExit;
+ end else
+ begin
+ rtp := ARichTextParams[PendingRtpIndex];
+ if (p - pStartText < rtp.StartIndex) then
+ begin
+ fnt := AWorkbook.GetFont(AFontIndex);
+ rtState := rtExit;
+ end else
+ begin
+ fnt := AWorkbook.GetFont(rtp.FontIndex);
+ rtState := rtEnter;
+ end;
+ end;
+ Convert_sFont_to_Font(fnt, ACanvas.Font);
+ AHeight := ACanvas.TextHeight('Tg');
+ if fnt.Position <> fpNormal then
+ ACanvas.Font.Size := round(ACanvas.Font.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+ end;
+ end;
+ AFontPos := fnt.Position;
+ end;
+
+ procedure ScanLine(var P: PChar; var NumSpaces: Integer;
+ var PendingRtpIndex: Integer; var width, height: Integer);
+ var
+ ch: Char;
+ pEOL: PChar;
+ savedSpaces: Integer;
+ savedWidth: Integer;
+ savedRtpIndex: Integer;
+ maxWidth: Integer;
+ rtState: TRtState;
+ dw, h: Integer;
+ fntpos: TsFontPosition;
+ spaceFound: Boolean;
+ begin
+ NumSpaces := 0;
+
+ InitFont(p, rtState, PendingRtpIndex, h);
+ height := h;
+
+ pEOL := p;
+ width := 0;
+ savedWidth := 0;
+ savedSpaces := 0;
+ savedRtpIndex := PendingRtpIndex;
+ spaceFound := false;
+ if AWordwrap then
+ begin
+ if ARotation = trHorizontal then
+ maxWidth := ARect.Right - ARect.Left
+ else
+ maxWidth := ARect.Bottom - ARect.Top;
+ end
+ else
+ maxWidth := MaxInt;
+
+ while p^ <> #0 do begin
+ UpdateFont(p, rtState, PendingRtpIndex, h, fntpos);
+ if h > height then height := h;
+
+ ch := p^;
+ case ch of
+ ' ': begin
+ spaceFound := true;
+ pEOL := p;
+ savedWidth := width;
+ savedSpaces := NumSpaces;
+ savedRtpIndex := PendingRtpIndex;
+ dw := Math.IfThen(ARotation = rtStacked, h, ACanvas.TextWidth(ch));
+ if width + dw < MaxWidth then
+ begin
+ inc(NumSpaces);
+ width := width + dw;
+ end else
+ break;
+ end;
+ #13,
+ #10: begin
+ dec(p);
+ width := savedWidth;
+ numSpaces := savedspaces;
+ PendingRtpIndex := savedRtpIndex;
+ exit;
+ end;
+ else begin
+ dw := Math.IfThen(ARotation = rtStacked, h, ACanvas.TextWidth(ch));
+ width := width + dw;
+ if width > maxWidth then
+ begin
+ if spaceFound then
+ begin
+ p := pEOL;
+ width := savedWidth;
+ NumSpaces := savedSpaces;
+ PendingRtpIndex := savedRtpIndex;
+ end else
+ begin
+ width := width - dw;
+ if width = 0 then
+ inc(p);
+ end;
+ break;
+ end;
+ end;
+ end;
+
+ inc(P, UTF8CharacterLength(p));
+ end;
+ end;
+
+ procedure DrawLine(pStart, pEnd: PChar; x,y, hLine: Integer; PendingRtpIndex: Integer);
+ var
+ ch: Char;
+ p: PChar;
+ rtState: TRtState;
+ h, w: Integer;
+ fntpos: TsFontPosition;
+ begin
+ p := pStart;
+ InitFont(p, rtState, PendingRtpIndex, h);
+ while p^ <> #0 do begin
+ UpdateFont(p, rtState, PendingRtpIndex, h, fntpos);
+ ch := p^;
+ case ARotation of
+ trHorizontal:
+ begin
+ ACanvas.Font.Orientation := 0;
+ case fntpos of
+ fpNormal : ACanvas.TextOut(x, y, ch);
+ fpSubscript : ACanvas.TextOut(x, y + hLine div 2, ch);
+ fpSuperscript: ACanvas.TextOut(x, y - hLine div 6, ch);
+ end;
+ inc(x, ACanvas.TextWidth(ch));
+ end;
+ rt90DegreeClockwiseRotation:
+ begin
+ ACanvas.Font.Orientation := -900;
+ case fntpos of
+ fpNormal : ACanvas.TextOut(x, y, ch);
+ fpSubscript : ACanvas.TextOut(x - hLine div 2, y, ch);
+ fpSuperscript: ACanvas.TextOut(x + hLine div 6, y, ch);
+ end;
+ inc(y, ACanvas.TextWidth(ch));
+ end;
+ rt90DegreeCounterClockwiseRotation:
+ begin
+ ACanvas.Font.Orientation := +900;
+ case fntpos of
+ fpNormal : ACanvas.TextOut(x, y, ch);
+ fpSubscript : ACanvas.TextOut(x + hLine div 2, y, ch);
+ fpSuperscript: ACanvas.TextOut(x - hLine div 6, y, ch);
+ end;
+ dec(y, ACanvas.TextWidth(ch));
+ end;
+ rtStacked:
+ begin
+ ACanvas.Font.Orientation := 0;
+ w := ACanvas.TextWidth(ch);
+ // chars centered around x
+ case fntpos of
+ fpNormal : ACanvas.TextOut(x - w div 2, y, ch);
+ fpSubscript : ACanvas.TextOut(x - w div 2, y + hLine div 2, ch);
+ fpSuperscript: ACanvas.TextOut(x - w div 2, y - hLine div 6, ch);
+ end;
+ inc(y, h);
+ end;
+ end;
+
+ inc(P, UTF8CharacterLength(p));
+ if P >= PEnd then break;
+ end;
+ end;
+
+begin
+ if AText = '' then
+ exit;
+
+ p := PChar(AText);
+ pStartText := p; // first char of text
+
+ if (Length(ARichTextParams) > 0) then
+ iRTP := 0
+ else
+ iRtp := -1;
+ totalHeight := 0;
+
+ if ARotation = rtStacked then
+ begin
+ Convert_sFont_to_Font(AWorkbook.GetFont(AFontIndex), ACanvas.Font);
+ stackPeriod := ACanvas.TextWidth('M') * 2;
+ end;
+
+ // Get layout of lines:
+ // "lineinfos" collect data on where lines start and end, their width and
+ // height, the rich-text parameter index range, and the number of spaces
+ // (for text justification)
+ repeat
+ SetLength(lineInfos, Length(lineInfos)+1);
+ with lineInfos[High(lineInfos)] do begin
+ pStart := p;
+ pEnd := p;
+ FirstRtpIndex := iRtp;
+ NextRtpIndex := iRtp;
+ ScanLine(pEnd, NumSpaces, NextRtpIndex, Width, Height);
+ if ARotation = rtStacked then
+ totalHeight := totalHeight + stackPeriod
+ else
+ totalHeight := totalHeight + Height;
+ iRtp := NextRtpIndex;
+ p := pEnd;
+ case p^ of
+ ' ': while (p^ <> #0) and (p^ = ' ') do inc(p);
+ #13: begin
+ inc(p);
+ if p^ = #10 then inc(p);
+ end;
+ #10: inc(p);
+ end;
+ end;
+ until p^ = #0;
+
+ // Draw lines
+ case ARotation of
+ trHorizontal:
+ case AVertAlignment of
+ vaTop : ypos := ARect.Top;
+ vaBottom: ypos := ARect.Bottom - totalHeight;
+ vaCenter: ypos := (ARect.Top + ARect.Bottom - totalHeight) div 2;
+ end;
+ rt90DegreeClockwiseRotation:
+ case AHorAlignment of
+ haLeft : xpos := ARect.Left + totalHeight;
+ haRight : xpos := ARect.Right;
+ haCenter: xpos := (ARect.Left + ARect.Right + totalHeight) div 2;
+ end;
+ rt90DegreeCounterClockwiseRotation:
+ case AHorAlignment of
+ haLeft : xpos := ARect.Left;
+ haRight : xpos := ARect.Right - totalHeight;
+ haCenter: xpos := (ARect.Left + ARect.Right - totalHeight) div 2;
+ end;
+ rtStacked:
+ begin
+ case AHorAlignment of
+ haLeft : xpos := ARect.Left + stackPeriod div 2;
+ haRight : xpos := ARect.Right - totalHeight + stackPeriod div 2;
+ haCenter: xpos := (ARect.Left + ARect.Right - totalHeight) div 2;
+ end;
+ end;
+ end;
+
+ for lineInfo in lineInfos do begin
+ with lineInfo do
+ begin
+ p := pStart;
+ case ARotation of
+ trHorizontal:
+ begin
+ case AHorAlignment of
+ haLeft : xpos := ARect.Left;
+ haRight : xpos := ARect.Right - Width;
+ haCenter : xpos := (ARect.Left + ARect.Right - Width) div 2;
+ end;
+ DrawLine(pStart, pEnd, xpos, ypos, Height, FirstRtpIndex);
+ inc(ypos, Height);
+ end;
+ rt90DegreeClockwiseRotation:
+ begin
+ case AVertAlignment of
+ vaTop : ypos := ARect.Top;
+ vaBottom : ypos := ARect.Bottom - Width;
+ vaCenter : ypos := (ARect.Top + ARect.Bottom - Width) div 2;
+ end;
+ DrawLine(pStart, pEnd, xpos, ypos, Height, FirstRtpIndex);
+ dec(xpos, Height);
+ end;
+ rt90DegreeCounterClockwiseRotation:
+ begin
+ case AVertAlignment of
+ vaTop : ypos := ARect.Top + Width;
+ vaBottom : ypos := ARect.Bottom;
+ vaCenter : ypos := (ARect.Top + ARect.Bottom + Width) div 2;
+ end;
+ DrawLine(pStart, pEnd, xpos, ypos, Height, FirstRtpIndex);
+ inc(xpos, Height);
+ end;
+ rtStacked:
+ begin
+ case AVertAlignment of
+ vaTop : ypos := ARect.Top;
+ vaBottom : ypos := ARect.Bottom - Width;
+ vaCenter : ypos := (ARect.Top + ARect.Bottom - Width) div 2;
+ end;
+ DrawLine(pStart, pEnd, xpos, ypos, Height, FirstRtpIndex);
+ inc(xpos, stackPeriod);
+ end;
+ end;
+ end;
+ end;
+end;
+
+function RichTextWidth(ACanvas: TCanvas; AWorkbook: TsWorkbook; const AText: String;
+ AFontIndex: Integer; ARichTextParams: TsRichTextParams): Integer;
+var
+ s: String;
+ p: Integer;
+ w, n: Integer;
+ rtp, next_rtp: TsRichTextParam;
+ fnt, fnt0: TsFont;
+begin
+ Result := 0;
+ if (ACanvas=nil) or (AWorkbook=nil) or (AText = '') then exit;
+
+ fnt0 := AWorkbook.GetFont(AFontIndex);
+ Convert_sFont_to_Font(fnt0, ACanvas.Font);
+
+ if Length(ARichTextParams) = 0 then
+ begin
+ Result := ACanvas.TextWidth(AText);
+ if fnt0.Position <> fpNormal then
+ Result := Round(Result * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+ exit;
+ end;
+
+ // Part with normal font before first rich-text parameter element
+ rtp := ARichTextParams[0];
+ if rtp.StartIndex > 0 then begin
+ s := copy(AText, 1, rtp.StartIndex+1); // StartIndex is 0-based
+ Result := ACanvas.TextWidth(s);
+ if fnt0.Position <> fpNormal then
+ Result := Round(Result * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+ end;
+
+ p := 0;
+ while p < Length(ARichTextParams) do
+ begin
+ // Part with rich-text font
+ rtp := ARichTextParams[p];
+ fnt := AWorkbook.GetFont(rtp.FontIndex);
+ Convert_sFont_to_Font(fnt, ACanvas.Font);
+ s := copy(AText, rtp.StartIndex+1, rtp.EndIndex-rtp.StartIndex);
+ w := ACanvas.TextWidth(s);
+ if fnt.Position <> fpNormal then
+ w := Round(w * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+ Result := Result + w;
+ // Part with normal font
+ if (p < High(ARichTextParams)-1) then
+ begin
+ next_rtp := ARichTextParams[p+1];
+ n := next_rtp.StartIndex - rtp.EndIndex;
+ if n > 0 then
+ begin
+ Convert_sFont_to_Font(fnt0, ACanvas.Font);
+ s := Copy(AText, rtp.EndIndex, n);
+ w := ACanvas.TextWidth(s);
+ if fnt0.Position <> fpNormal then
+ w := Round(w * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+ Result := Result + w;
+ end;
+ end;
+ inc(p);
+ end;
+end;
+
end.
diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk
index 6dd461652..ae6dfc717 100644
--- a/components/fpspreadsheet/laz_fpspreadsheet.lpk
+++ b/components/fpspreadsheet/laz_fpspreadsheet.lpk
@@ -20,7 +20,8 @@
-
+
', [AFont.Size], FPointSeparatorSettings);
+ s := s + Format('', [AFont.FontName]);
+ if (fssBold in AFont.Style) then
+ s := s + '';
+ if (fssItalic in AFont.Style) then
+ s := s + '';
+ if (fssUnderline in AFont.Style) then
+ s := s + '';
+ if (fssStrikeout in AFont.Style) then
+ s := s + '