diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index e57882ca5..bb0d76119 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -1001,21 +1001,11 @@ begin txt := GetCellText(ACol, gRow); if txt = '' then Continue; - w := RichTextWidth(Canvas, Workbook, Rect(0, 0, MaxInt, MaxInt), txt, - Worksheet.ReadCellFontIndex(cell), cell^.RichTextParams, - Worksheet.ReadTextRotation(cell), false); + w := RichTextWidth(Canvas, Workbook, Rect(0, 0, MaxInt, MaxInt), + txt, cell^.RichTextParams, Worksheet.ReadCellFontIndex(cell), + Worksheet.ReadTextRotation(cell), false, IsRightToLeft); if w > maxw then maxw := w; end; - { - for r := 0 to lastRow do - begin - gRow := GetGridRow(r); - txt := GetCellText(ACol, gRow); - PrepareCanvas(ACol, gRow, []); - w := Canvas.TextWidth(txt); - if (txt <> '') and (w > maxw) then maxw := w; - end; - } if maxw > -1 then maxw := maxw + 2*constCellPadding else @@ -2966,8 +2956,8 @@ begin cellR := Rect(0, 0, MaxInt, MaxInt); end; - Result := RichTextHeight(Canvas, Workbook, cellR, s, fntIndex, - lCell^.RichTextParams, txtRot, wrapped) + Result := RichTextHeight(Canvas, Workbook, cellR, s, lCell^.RichTextParams, + fntIndex, txtRot, wrapped, IsRightToLeft) + 2 * constCellPadding; (* @@ -3499,8 +3489,10 @@ begin 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, AOverrideTextColor); + DrawRichText(Canvas, Workbook, ARect, AText, ARichTextParams, AFontIndex, + ATextWrap, ACellHorAlign, ACellVertAlign, ATextRot, AOverrideTextColor, + IsRightToLeft + ); end; (* procedure TsCustomWorksheetGrid.InternalDrawTextInCell(AText, AMeasureText: String; diff --git a/components/fpspreadsheet/fpsvisualutils.pas b/components/fpspreadsheet/fpsvisualutils.pas index 5e65c63be..826e6e045 100644 --- a/components/fpspreadsheet/fpsvisualutils.pas +++ b/components/fpspreadsheet/fpsvisualutils.pas @@ -17,22 +17,81 @@ 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; + const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer; AWordwrap: Boolean; AHorAlignment: TsHorAlignment; AVertAlignment: TsVertAlignment; - ARotation: TsTextRotation; AOverrideTextColor: TColor); + ARotation: TsTextRotation; AOverrideTextColor: TColor; ARightToLeft: Boolean); -function RichTextWidth(ACanvas: TCanvas; AWorkbook: TsWorkbook; AMaxRect: TRect; - const AText: String; AFontIndex: Integer; ARichTextParams: TsRichTextParams; - ATextRotation: TsTextRotation; AWordWrap: Boolean): Integer; +function RichTextWidth(ACanvas: TCanvas; AWorkbook: TsWorkbook; ARect: TRect; + const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer; + ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean): Integer; -function RichTextHeight(ACanvas: TCanvas; AWorkbook: TsWorkbook; AMaxRect: TRect; - const AText: String; AFontIndex: Integer; ARichTextParams: TsRichTextParams; - ATextRotation: TsTextRotation; AWordWrap: Boolean): Integer; +function RichTextHeight(ACanvas: TCanvas; AWorkbook: TsWorkbook; ARect: TRect; + const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer; + ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean): Integer; -{ -function RichTextWidth(ACanvas: TCanvas; AWorkbook: TsWorkbook; const AText: String; - AFontIndex: Integer; ARichTextParams: TsRichTextParams): Integer; -} +type + TsLineInfo = class + pStart: PChar; + WordList: TStringList; + NumSpaces: Integer; + BeginsWithFontOfRtpIndex: Integer; + Width: Integer; + Height: Integer; + constructor Create; + destructor Destroy; override; + end; + + { TsTextPainter } + + TsTextPainter = class + private + FCanvas: TCanvas; + FWorkbook: TsWorkbook; + FRect: TRect; + FFontIndex: Integer; + FTextRotation: TsTextRotation; + FHorAlignment: TsHorAlignment; + FVertAlignment: TsVertAlignment; + FWordWrap: Boolean; + FRightToLeft: Boolean; + FText: String; + FRtParams: TsRichTextParams; + FMaxLineLen: Integer; + FTotalHeight: Integer; + FStackPeriod: Integer; + FLines: TFPList; + // Scanner + FRtpIndex: Integer; + FCharIndex: integer; + FCharIndexOfNextFont: Integer; + FFontHeight: Integer; + FFontPos: TsFontPosition; + FPtr: PChar; + private + function GetHeight: Integer; + function GetWidth: Integer; + protected + procedure DrawLine(pEnd: PChar; x, y, ALineHeight: Integer; AOverrideTextColor: TColor); + procedure DrawText(var x, y: Integer; s: String; ALineHeight: Integer); + function GetTextPt(x,y,ALineHeight: Integer): TPoint; + procedure InitFont(out ACurrRtpIndex, ACharIndexOfNextFont, ACurrFontHeight: Integer; + out ACurrFontPos: TsFontPosition); + procedure NextChar(ANumBytes: Integer); + procedure Prepare; + procedure ScanLine(var ANumSpaces, ALineWidth, ALineHeight: Integer; + AWordList: TStringList); + procedure UpdateFont(ACharIndex: Integer; var ACurrRtpIndex, + ACharIndexOfNextFont, ACurrFontHeight: Integer; var ACurrFontPos: TsFontPosition); + public + constructor Create(ACanvas: TCanvas; AWorkbook: TsWorkbook; ARect: TRect; + AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer; + ATextRotation: TsTextRotation; AHorAlignment: TsHorAlignment; + AVertAlignment: TsVertAlignment; AWordWrap, ARightToLeft: Boolean); + destructor Destroy; override; + procedure Draw(AOverrideTextColor: TColor); + property Height: Integer read GetHeight; + property Width: Integer read GetWidth; + end; implementation @@ -171,78 +230,41 @@ begin Result := Result + LineEnding + line; end; end; - -procedure InternalDrawRichText(ACanvas: TCanvas; AWorkbook: TsWorkbook; - const ARect: TRect; const AText: String; AFontIndex: Integer; - ARichTextParams: TsRichTextParams; AWordwrap: Boolean; - AHorAlignment: TsHorAlignment; AVertAlignment: TsVertAlignment; - ARotation: TsTextRotation; AOverrideTextColor: TColor; AMeasureOnly: Boolean; - var AWidth, AHeight: Integer); + (* +{------------------------------------------------------------------------------} +{ Processing of rich-text } +{------------------------------------------------------------------------------} type TLineInfo = record pStart, pEnd: PChar; + Words: Array of String; NumSpaces: Integer; BeginsWithFontOfRtpIndex: Integer; Width: Integer; Height: Integer; end; + + +procedure InternalDrawRichText(ACanvas: TCanvas; AWorkbook: TsWorkbook; + const ARect: TRect; const AText: String; AFontIndex: Integer; + ARichTextParams: TsRichTextParams; AWordwrap: Boolean; + AHorAlignment: TsHorAlignment; AVertAlignment: TsVertAlignment; + ARotation: TsTextRotation; AOverrideTextColor: TColor; + ARightToLeft, AMeasureOnly: Boolean; + var AWidth, AHeight: Integer); var xpos, ypos: Integer; - p, pStartText: PChar; - rtpIndex: Integer; - lineInfo: TLineInfo; - lineInfos: Array of TLineInfo = nil; - totalHeight, linelen, stackPeriod: Integer; - charPos: Integer; - fontpos: TsFontPosition; - fontHeight: Integer; - - procedure InitFont(out ARtpFontIndex: Integer; out AFontHeight: Integer; - out AFontPos: TsFontPosition); - var - fnt: TsFont; - begin - if (Length(ARichTextParams) > 0) and (charPos >= ARichTextParams[0].FirstIndex) then - begin - ARtpFontIndex := 0; - fnt := AWorkbook.GetFont(ARichTextParams[0].FontIndex); - end else - begin - ARtpFontIndex := -1; - fnt := AWorkbook.GetFont(AFontIndex); - end; - Convert_sFont_to_Font(fnt, ACanvas.Font); - AFontHeight := ACanvas.TextHeight('Tg'); - if (fnt <> nil) and (fnt.Position <> fpNormal) then - ACanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR); - AFontPos := fnt.Position; - end; - - procedure UpdateFont(ACharPos: Integer; var ARtpFontIndex: Integer; - var AFontHeight: Integer; var AFontPos: TsFontPosition); - var - rtParam: TsRichTextParam; - fnt: TsFont; - endPos: Integer; - begin - if ARtpFontIndex = High(ARichTextParams) then - endPos := MaxInt - else begin - rtParam := ARichTextParams[ARtpFontIndex + 1]; - endPos := rtParam.FirstIndex; - end; - - if ACharPos >= endPos then begin - inc(ARtpFontIndex); - rtParam := ARichTextParams[ARtpFontIndex]; - fnt := AWorkbook.GetFont(rtParam.FontIndex); - Convert_sFont_to_Font(fnt, ACanvas.Font); - AFontHeight := ACanvas.TextHeight('Tg'); - if fnt.Position <> fpNormal then - ACanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR); - AFontPos := fnt.Position; - end; - end; + p: PChar; + lRtpIndex: Integer; + lLineInfo: TLineInfo; + lLineInfos: array of TLineInfo = nil; + lTotalHeight, lLinelen: Integer; + lStackPeriod: Integer = 0; + lCharPos: Integer; + lFontPos: TsFontPosition; + lFontHeight: Integer; + lCharIndexFontChange: Integer; + ts: TTextStyle; { Scans the line for a possible line break. The max width is determined by the size of the rectangle ARect passed to the outer procedure: @@ -262,79 +284,99 @@ var ALineWidth the pixel width of the line seen along drawing direction, i.e. in case of stacked text it is the character height times character count in the line (!) - ALineHeight The height of the line as seen vertical to the drawing + ALineHeight The height of the line as seen vertically to the drawing direction. Normally this is the height of the largest font found in the line; in case of stacked text it is the standardized width of a character. } - procedure ScanLine(var P: PChar; var NumSpaces: Integer; - var ARtpFontIndex: Integer; var ALineWidth, ALineHeight: Integer); + procedure ScanLine(var P: PChar; var ALineInfo: TLineInfo; + var ANextLineRtParamIndex: Integer); var pWordStart: PChar; EOL: Boolean; savedSpaces: Integer; savedWidth: Integer; savedCharPos: Integer; - savedRtpFontIndex: Integer; +// savedRtpFontIndex: Integer; + savedNextLineRtParamIndex: Integer; maxWidth: Integer; dw: Integer; lineChar: utf8String; charLen: Integer; // Number of bytes of current utf8 character - begin - NumSpaces := 0; + s: String; - ALineHeight := fontHeight; - ALineWidth := 0; + { + TLineInfo = record + pStart, pEnd: PChar; + Words: Array of String; + NumSpaces: Integer; + BeginsWithFontOfRtpIndex: Integer; + Width: Integer; + Height: Integer; + end; + } + begin + ALineInfo.pStart := P; + ALineInfo.pEnd := P; + ALineInfo.NumSpaces := 0; + ALineInfo.BeginsWithFontOfRtpIndex := ANextLineRtParamIndex; + ALineInfo.Width := 0; + ALineInfo.Height := lFontHeight; + SetLength(ALineInfo.Words, 0); + + s := ''; savedWidth := 0; savedSpaces := 0; - + maxWidth := MaxInt; if AWordwrap then begin if ARotation = trHorizontal then maxWidth := ARect.Right - ARect.Left else maxWidth := ARect.Bottom - ARect.Top; - end - else - maxWidth := MaxInt; + end; - UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos); - ALineHeight := Max(fontHeight, ALineHeight); + UpdateFont(ACanvas, AWorkbook, AFontIndex, ARichTextParams, lCharPos, + ANextLineRtParamIndex, lFontHeight, lFontPos); + ALineInfo.Height := Max(fontHeight, ALineInfo.Height); - while p^ <> #0 do begin - case p^ of + while P^ <> #0 do begin + case P^ of #13: begin - inc(p); - inc(charpos); - if p^ = #10 then + inc(P); + inc(lCharPos); + if P^ = #10 then begin - inc(p); - inc(charpos); - break; + inc(P); + inc(lCharPos); end; + break; end; #10: begin - inc(p); - inc(charpos); + inc(P); + inc(lCharPos); break; end; ' ': begin - savedWidth := ALineWidth; - savedSpaces := NumSpaces; + SetLength(ALineInfo.Words, Length(ALineInfo.Words)+1); + ALineInfo.Words[High(ALineInfo.Words)] := s; + savedWidth := ALineInfo.Width; + savedSpaces := ALineInfo.NumSpaces; // Find next word - while p^ = ' ' do + while P^ = ' ' do begin - UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos); - ALineHeight := Max(fontHeight, ALineHeight); - dw := Math.IfThen(ARotation = rtStacked, fontHeight, ACanvas.TextWidth(' ')); - ALineWidth := ALineWidth + dw; - inc(NumSpaces); - inc(p); - inc(charPos); + UpdateFont(ACanvas. AWorkbook, AFontIndex, ARichTextParams, + lCharPos, ANextLineRtParamIndex, lFontHeight, lFontPos); + ALineInfo.Height := Max(lFontHeight, ALineInfo.Height); + dw := Math.IfThen(ARotation = rtStacked, lFontHeight, ACanvas.TextWidth(' ')); + AALineInfo.Width := ALineInfo.Width + dw; + inc(ALineInfo.NumSpaces); + inc(P); + inc(lCharPos); end; - if ALineWidth >= maxWidth then + if ALineInfo.Width >= maxWidth then begin - ALineWidth := savedWidth; - NumSpaces := savedSpaces; + ALineInfo.Width := savedWidth; + ALineInfo.NumSpaces := savedSpaces; break; end; end; @@ -342,46 +384,195 @@ var // Bere begins a new word. Find end of this word and check if // it fits into the line. // Store the data valid for the word start. - pWordStart := p; - savedCharPos := charpos; - savedRtpFontIndex := ARtpFontIndex; + pWordStart := P; + s := ''; + savedCharPos := lCharPos; + savedNextLineTrParamIndex := ANextLineParamIndex; EOL := false; - while (p^ <> #0) and (p^ <> #13) and (p^ <> #10) and (p^ <> ' ') do + while (P^ <> #0) and (P^ <> #13) and (P^ <> #10) and (P^ <> ' ') do begin - UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos); - ALineHeight := Max(fontHeight, ALineHeight); + UpdateFont(ACanvas, AWorkbook, AFontIndex, ARichTextParams, + lCharPos, ANextLineRtParamIndex, lFontHeight, lFontPos); + ALineInfo.Height := Max(lFontHeight, ALineInfo.Height); lineChar := UnicodeToUTF8(UTF8CharacterToUnicode(p, charLen)); - dw := Math.IfThen(ARotation = rtStacked, fontHeight, ACanvas.TextWidth(lineChar)); - ALineWidth := ALineWidth + dw; - if ALineWidth > maxWidth then + s := s + lineChar; + dw := Math.IfThen(ARotation = rtStacked, lFontHeight, ACanvas.TextWidth(lineChar)); + ALineInfo.Width := ALineInfo.Width + dw; + if ALineInfo.Width > maxWidth then begin // The line exeeds the max line width. // There are two cases: - if NumSpaces > 0 then + if ALineInfo.NumSpaces > 0 then begin // (a) This is not the only word: Go back to where this // word began. We had stored everything needed! - p := pWordStart; - charpos := savedCharPos; - ALineWidth := savedWidth; - ARtpFontIndex := savedRtpFontIndex; + P := pWordStart; + lCharPos := savedCharPos; + ALineInfo.Width := savedWidth; + ANextLineParamIndex := savedNextLineParamIndex; end; // (b) This is the only word in the line --> we break at the // current cursor position. EOL := true; break; end; - inc(p); - inc(charPos); + inc(P); + inc(lCharPos); end; if EOL then break; end; end; end; + UpdateFont(ACanvas, AWorkbook, AFontIndex UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos); ALineHeight := Max(fontHeight, ALineHeight); end; + procedure DrawText(var x, y: Integer; ALineHeight: Integer; s: String); + var + w: Integer; + begin + w := ACanvas.TextWidth(s); + + case ARotation of + trHorizontal: + begin + ACanvas.Font.Orientation := 0; + if ARightToLeft then + begin + case fontpos of + fpNormal : ACanvas.TextOut(x-w, y, s); + fpSubscript : ACanvas.TextOut(x-w, y+ALineHeight div 2, s); + fpSuperScript: ACanvas.TextOut(x-w, y-ALineHeight div 6, s); + end; + dec(x, w); + end else + begin + case fontpos of + fpNormal : ACanvas.TextOut(x, y, s); + fpSubscript : ACanvas.TextOut(x, y+ALineHeight div 2, s); + fpSuperscript: ACanvas.TextOut(x, y-ALineHeight div 6, s); + end; + inc(x, w); + end; + end; + + rt90DegreeClockwiseRotation: + begin + ACanvas.Font.Orientation := -900; + if ARightToLeft then + begin + case fontpos of + fpNormal : ACanvas.TextOut(x, y-w, s); + fpSubscript : ACanvas.TextOut(x-ALineHeight div 2, y-w, s); + fpSuperscript: ACanvas.TextOut(x+ALineHeight div 6, y-w, s); + end; + dec(y, w); + end else + begin + case fontpos of + fpNormal : ACanvas.TextOut(x, y, s); + fpSubscript : ACanvas.TextOut(x-ALineHeight div 2, y, s); + fpSuperscript: ACanvas.TextOut(x+ALineHeight div 6, y, s); + end; + inc(y, w); + end; + end; + + rt90DegreeCounterClockwiseRotation: + begin + ACanvas.Font.Orientation := +900; + if ARightToLeft then + begin + case fontpos of + fpNormal : ACanvas.TextOut(x, y+w, s); + fpSubscript : ACanvas.TextOut(x+ALineHeight div 2, y+w, s); + fpSuperscript: ACanvas.TextOut(x-ALineHeight div 6, y+w, s); + end; + inc(y, w); + end else + begin + case fontpos of + fpNormal : ACanvas.TextOut(x, y, s); + fpSubscript : ACanvas.TextOut(x+ALineHeight div 2, y, s); + fpSuperscript: ACanvas.TextOut(x-ALineHeight div 6, y, s); + end; + dec(y, w); + end; + end; + + rtStacked: + begin + ACanvas.Font.Orientation := 0; + w := ACanvas.TextWidth(s); + // chars centered around x + if ARightToLeft then // is this ok?? + begin + case fontpos of + fpNormal : ACanvas.TextOut(x - w div 2, y-fontheight, s); + fpSubscript : ACanvas.TextOut(x - w div 2, y-fontheight+ALineHeight div 2, s); + fpSuperscript: ACanvas.TextOut(x - w div 2, y-fontheight-ALineHeight div 6, s); + end; + dec(y, fontHeight); + end else + begin + case fontpos of + fpNormal : ACanvas.TextOut(x - w div 2, y, s); + fpSubscript : ACanvas.TextOut(x - w div 2, y+ALineHeight div 2, s); + fpSuperscript: ACanvas.TextOut(x - w div 2, y-ALineHeight div 6, s); + end; + inc(y, fontHeight); + end; + end; + end; + end; + + procedure DrawLine(pStart, pEnd: PChar; x, y, ALineHeight, ARtpFontIndex: Integer); + var + p: PChar; + charPosForNextFont, charLen: Integer; + s: String; + fntIdx: Integer; + begin + p := pStart; + s := ''; + charPosForNextFont := ARichTextParams[ARtpFontIndex].FirstIndex; + while (p^ <> #0) and (p < pEnd) do begin + case p^ of + #10: begin + DrawText(x, y, ALineHeight, s); + s := ''; + inc(p); + inc(charpos); + break; + end; + #13: begin + DrawText(x, y, ALineHeight, s); + s := ''; + inc(p); + inc(charpos); + if p^ = #10 then + begin + inc(p); + inc(charpos); + end; + break; + end; + else + s := s + UnicodeToUTF8(UTF8CharacterToUnicode(p, charLen)); + if CharPos = charPosForNextFont then begin + DrawText(x, y, ALineHeight, s); + s := ''; + end; + inc(charPos); + inc(p, charLen); + UpdateFont(charPos, ARtpFontIndex, fontheight, fontpos); + end; + end; + if s <> '' then + DrawText(x, y, ALineHeight, s); + end; + (* { Paints the text between the pointers pStart and pEnd. Starting point for the text location is given by the coordinates x/y, i.e. text alignment is already corrected. In case of sub/superscripts, the @@ -469,45 +660,41 @@ var if P >= PEnd then break; end; UpdateFont(charPos, ARtpFontIndex, fontHeight, fontPos); - end; + end; *) begin if AText = '' then exit; p := PChar(AText); - pStartText := p; // first char of text - charPos := 1; // Counter for utf8 character position - totalHeight := 0; - linelen := 0; + lCharPos := 1; // Counter for utf8 character position + lTotalHeight := 0; + lLinelen := 0; - Convert_sFont_to_Font(AWorkbook.GetFont(AFontIndex), ACanvas.Font); - if ARotation = rtStacked then - stackPeriod := ACanvas.TextWidth('M') * 2; + ts := ACanvas.TextStyle; + ts.RightToLeft := ARightToLeft; + ACanvas.TextStyle := ts; // (1) Get layout of lines // ====================== // "lineinfos" collect data for where lines start and end, their width and // height, the rich-text parameter index range, and the number of spaces // (for text justification) - InitFont(rtpIndex, fontheight, fontpos); + InitFont(ACanvas, AWorkbook, AFontIndex, ARichTextParams, lRtpIndex, + lCharIndexFontChange, lFontHeight, lFontPos); + if ARotation = rtStacked then + lStackPeriod := ACanvas.TextWidth('M') * 2; + SetLength(lLineInfos, 0); repeat - SetLength(lineInfos, Length(lineInfos)+1); - with lineInfos[High(lineInfos)] do begin + SetLength(lLineInfos, Length(lLineInfos)+1); + with lLineInfos[High(lLineInfos)] do begin pStart := p; pEnd := p; - BeginsWithFontOfRtpIndex := rtpIndex; - ScanLine(pEnd, NumSpaces, rtpIndex, Width, Height); + BeginsWithFontOfRtpIndex := lRtpIndex; + ScanLine(pStart, lLineInfos[High(lLineInfos)], pEnd, NumSpaces, rtpIndex, Width, Height); totalHeight := totalHeight + Height; linelen := Max(linelen, Width); p := pEnd; - { - if p^ = ' ' then - while (p^ <> #0) and (p^ = ' ') do begin - inc(p); - inc(charPos); - end; - } end; until p^ = #0; @@ -564,31 +751,52 @@ begin 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; + if ARightToLeft then + case AHorAlignment of + haLeft : xpos := ARect.Left + Width; + haRight : xpos := ARect.Right; + haCenter : xpos := (ARect.Left + ARect.Right + Width) div 2; + end + else + 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, BeginsWithFontOfRtpIndex); 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; + if ARightToLeft then + case AVertAlignment of + vaTop : ypos := ARect.Top + Width; + vaBottom : ypos := ARect.Bottom; + vaCenter : ypos := (ARect.Top + ARect.Bottom + Width) div 2; + end + else + 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, BeginsWithFontOfRtpIndex); 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; + if ARightToLeft then + case AVertAlignment of + vaTop : ypos := ARect.Top; + vaBottom : ypos := ARect.Bottom - Width; + vaCenter : ypos := (ARect.Top + ARect.Bottom - Width) div 2; + end + else + 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, BeginsWithFontOfRtpIndex); inc(xpos, Height); end; @@ -606,133 +814,641 @@ begin end; end; end; - + *) procedure DrawRichText(ACanvas: TCanvas; AWorkbook: TsWorkbook; const ARect: TRect; - const AText: String; AFontIndex: Integer; ARichTextParams: TsRichTextParams; + const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer; AWordwrap: Boolean; AHorAlignment: TsHorAlignment; AVertAlignment: TsVertAlignment; - ARotation: TsTextRotation; AOverrideTextColor: TColor); + ARotation: TsTextRotation; AOverrideTextColor: TColor; ARightToLeft: Boolean); var - w: Integer = 0; - h: Integer = 0; +// w: Integer = 0; +// h: Integer = 0; + painter: TsTextPainter; begin + painter := TsTextPainter.Create(ACanvas, AWorkbook, ARect, AText, ARichTextParams, + AFontIndex, ARotation, AHorAlignment, AVertAlignment, AWordWrap, ARightToLeft); + try + painter.Draw(AOverrideTextColor); + finally + painter.Free; + end; + { InternalDrawRichText(ACanvas, AWorkbook, ARect, AText, AFontIndex, ARichTextParams, AWordWrap, AHorAlignment, AVertAlignment, ARotation, - AOverrideTextColor, false, w, h); + AOverrideTextColor, ARightToLeft, false, w, h); + } end; -function RichTextWidth(ACanvas: TCanvas; AWorkbook: TsWorkbook; AMaxRect: TRect; - const AText: String; AFontIndex: Integer; ARichTextParams: TsRichTextParams; - ATextRotation: TsTextRotation; AWordWrap: Boolean): Integer; +function RichTextWidth(ACanvas: TCanvas; AWorkbook: TsWorkbook; ARect: TRect; + const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer; + ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean): Integer; var - h: Integer = 0; - w: Integer = 0; +// h: Integer = 0; +// w: Integer = 0; + painter: TsTextPainter; begin + painter := TsTextPainter.Create(ACanvas, AWorkbook, ARect, AText, ARichTextParams, + AFontIndex, ATextRotation, haLeft, vaTop, AWordWrap, ARightToLeft); + try + Result := painter.Height; + finally + painter.Free; + end; + { InternalDrawRichText(ACanvas, AWorkbook, AMaxRect, AText, AFontIndex, - ARichTextParams, AWordWrap, haLeft, vaTop, ATextRotation, clNone, true, - w, h); + ARichTextParams, AWordWrap, haLeft, vaTop, ATextRotation, clNone, + ARightToLeft, true, w, h + ); case ATextRotation of trHorizontal, rtStacked: Result := w; rt90DegreeClockwiseRotation, rt90DegreeCounterClockwiseRotation: Result := h; - end; + end; } end; -function RichTextHeight(ACanvas: TCanvas; AWorkbook: TsWorkbook; AMaxRect: TRect; - const AText: String; AFontIndex: Integer; ARichTextParams: TsRichTextParams; - ATextRotation: TsTextRotation; AWordWrap: Boolean): Integer; +function RichTextHeight(ACanvas: TCanvas; AWorkbook: TsWorkbook; ARect: TRect; + const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer; + ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean): Integer; var - h: Integer = 0; - w: Integer = 0; + painter: TsTextPainter; +// h: Integer = 0; +// w: Integer = 0; begin + painter := TsTextPainter.Create(ACanvas, AWorkbook, ARect, AText, ARichTextParams, + AFontIndex, ATextRotation, haLeft, vaTop, AWordWrap, ARightToLeft); + try + Result := painter.Height; + finally + painter.Free; + end; + + { InternalDrawRichText(ACanvas, AWorkbook, AMaxRect, AText, AFontIndex, - ARichTextParams, AWordWrap, haLeft, vaTop, ATextRotation, clNone, true, - w, h); + ARichTextParams, AWordWrap, haLeft, vaTop, ATextRotation, clNone, + ARightToLeft, true, w, h + ); case ATextRotation of trHorizontal: Result := h; rt90DegreeClockwiseRotation, rt90DegreeCounterClockwiseRotation, rtStacked: Result := w; end; + } end; - (* -function GetRichTextExtent(ACanvas: TCanvas; AWorkbook: TsWorkbook; - const AText: String; AFontIndex: Integer; ARichTextParams: TsRichTextParams; - ATextRotation: TsTextRotation): TSize; -var - s: String; - p: Integer; - len, height: Integer; - rtp, next_rtp: TsRichTextParam; - fnt, fnt0: TsFont; + + +{------------------------------------------------------------------------------} +{ Painting engine for rich-text } +{------------------------------------------------------------------------------} + +constructor TsLineInfo.Create; begin - Result := 0; - if (ACanvas=nil) or (AWorkbook=nil) or (AText = '') then exit; + inherited; + WordList := TStringList.Create; +end; - fnt0 := AWorkbook.GetFont(AFontIndex); - Convert_sFont_to_Font(fnt0, ACanvas.Font); +destructor TsLineInfo.Destroy; +begin + WordList.Free; + inherited; +end; - if Length(ARichTextParams) = 0 then - begin - Result := ACanvas.TextExtent(AText); - if ATextRotation = trHorizontal then - exit; - len := Result.cx; - height := Result.cy; - case ATextRotation of - rt90DegreeClockwiseRotation, - rt90DegreeCounterClockwiseRotation: - begin - Result.CX := height; - Result.CY := len; - end; - rtStacked: - begin - Result.CX := ACanvas.TextWidth('M'); - Restul.CY := UTF8Length(AText) * height; - end; - end; - 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; +{ TsTextPainter } - 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 + + +{ ARect ........ Defines the rectangle in which the text is to be drawn, + AFontIndex ... Base font of the text, to be used if not rich-text is defined. + ATextRoation . Text is rotated this way + AWordwrap .... Wrap text at word boundaries if text is wider than the MaxRect + (or higher, in case of vertical text). + ARightToLeft . if true, paint text from left to right } +constructor TsTextPainter.Create(ACanvas: TCanvas; AWorkbook: TsWorkbook; + ARect: TRect; AText: String; ARichTextParams: TsRichTextParams; + AFontIndex: Integer; ATextRotation: TsTextRotation; AHorAlignment: TsHorAlignment; + AVertAlignment: TsVertAlignment; AWordWrap, ARightToLeft: Boolean); +begin + FLines := TFPList.Create; + FCanvas := ACanvas; + FWorkbook := AWorkbook; + FRect := ARect; + FText := AText; + FRtParams := ARichTextParams; + FFontIndex := AFontIndex; + FTextRotation := ATextRotation; + FHorAlignment := AHorAlignment; + FVertAlignment := AVertAlignment; + FWordwrap := AWordwrap; + FRightToLeft := ARightToLeft; + Prepare; +end; + +destructor TsTextPainter.Destroy; +var + j: Integer; +begin + for j:=FLines.Count-1 downto 0 do TObject(FLines[j]).Free; + FLines.Free; + inherited Destroy; +end; + +{ Draw the lines } +procedure TsTextPainter.Draw(AOverrideTextColor: TColor); +var + xpos, ypos: Integer; + totalHeight: Integer; + lineinfo: TsLineInfo; + pEnd: PChar; + j: Integer; +begin + // (1) Get starting point of line + case FTextRotation of + trHorizontal: + case FVertAlignment of + vaTop : ypos := FRect.Top; + vaBottom: ypos := FRect.Bottom - FTotalHeight; + vaCenter: ypos := (FRect.Top + FRect.Bottom - FTotalHeight) div 2; + end; + rt90DegreeClockwiseRotation: + case FHorAlignment of + haLeft : xpos := FRect.Left + FTotalHeight; + haRight : xpos := FRect.Right; + haCenter: xpos := (FRect.Left + FRect.Right + FTotalHeight) div 2; + end; + rt90DegreeCounterClockwiseRotation: + case FHorAlignment of + haLeft : xpos := FRect.Left; + haRight : xpos := FRect.Right - FTotalHeight; + haCenter: xpos := (FRect.Left + FRect.Right - FTotalHeight) div 2; + end; + rtStacked: 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; + totalHeight := (FLines.Count - 1) * FStackperiod; + case FHorAlignment of + haLeft : xpos := FRect.Left + FStackPeriod div 2; + haRight : xpos := FRect.Right - totalHeight + FStackPeriod div 2; + haCenter: xpos := (FRect.Left + FRect.Right - totalHeight) div 2; + end; + end; + end; + + // (2) Draw text line by line and respect text rotation + FPtr := PChar(FText); + FCharIndex := 1; // Counter for utf8 character position + InitFont(FRtpIndex, FCharIndexOfNextFont, FFontHeight, FFontPos); + for j := 0 to FLines.Count-1 do + begin + if j < FLines.Count-1 then + pEnd := TsLineInfo(FLines[j+1]).pStart else + pEnd := PChar(FText) + Length(FText); + lineinfo := TsLineInfo(FLines[j]); + with lineInfo do + begin + case FTextRotation of + trHorizontal: + begin + if FRightToLeft then + case FHorAlignment of + haLeft : xpos := FRect.Left + Width; + haRight : xpos := FRect.Right; + haCenter : xpos := (FRect.Left + FRect.Right + Width) div 2; + end + else + case FHorAlignment of + haLeft : xpos := FRect.Left; + haRight : xpos := FRect.Right - Width; + haCenter : xpos := (FRect.Left + FRect.Right - Width) div 2; + end; + DrawLine(pEnd, xpos, ypos, Height, AOverrideTextColor); + inc(ypos, Height); + end; + rt90DegreeClockwiseRotation: + begin + if FRightToLeft then + case FVertAlignment of + vaTop : ypos := FRect.Top + Width; + vaBottom : ypos := FRect.Bottom; + vaCenter : ypos := (FRect.Top + FRect.Bottom + Width) div 2; + end + else + case FVertAlignment of + vaTop : ypos := FRect.Top; + vaBottom : ypos := FRect.Bottom - Width; + vaCenter : ypos := (FRect.Top + FRect.Bottom - Width) div 2; + end; + DrawLine(pEnd, xpos, ypos, Height, AOverrideTextColor); + dec(xpos, Height); + end; + rt90DegreeCounterClockwiseRotation: + begin + if FRightToLeft then + case FVertAlignment of + vaTop : ypos := FRect.Top; + vaBottom : ypos := FRect.Bottom - Width; + vaCenter : ypos := (FRect.Top + FRect.Bottom - Width) div 2; + end + else + case FVertAlignment of + vaTop : ypos := FRect.Top + Width; + vaBottom : ypos := FRect.Bottom; + vaCenter : ypos := (FRect.Top + FRect.Bottom + Width) div 2; + end; + DrawLine(pEnd, xpos, ypos, Height, AOverrideTextColor); + inc(xpos, Height); + end; + rtStacked: + begin + case FVertAlignment of + vaTop : ypos := FRect.Top; + vaBottom : ypos := FRect.Bottom - Width; + vaCenter : ypos := (FRect.Top + FRect.Bottom - Width) div 2; + end; + DrawLine(pEnd, xpos, ypos, Height, AOverrideTextColor); + inc(xpos, FStackPeriod); + end; end; end; - inc(p); + end; + +end; + +procedure TsTextPainter.DrawLine(pEnd: PChar; x, y, ALineHeight: Integer; + AOverrideTextColor: TColor); +var + charLen: Integer; + s: String; +begin + s := ''; + while (FPtr^ <> #0) and (FPtr < pEnd) do begin + if FCharIndex = FCharIndexOfNextFont then begin + DrawText(x, y, s, ALineHeight); + s := ''; + end; + UpdateFont(FCharIndex, FRtpIndex, FCharIndexOfNextFont, FFontHeight, FFontPos); + if AOverrideTextColor <> clNone then + FCanvas.Font.Color := AOverrideTextColor; + case FPtr^ of + #10: begin + DrawText(x, y, s, ALineHeight); + s := ''; + NextChar(1); + break; + end; + #13: begin + DrawText(x, y, s, ALineHeight); + s := ''; + NextChar(1); + if FPtr^ = #10 then + NextChar(1); + break; + end; + else + s := s + UnicodeToUTF8(UTF8CharacterToUnicode(FPtr, charLen)); + if FCharIndex = FCharIndexOfNextFont then begin + DrawText(x, y, s, ALineHeight); + s := ''; + end; + NextChar(charLen); + end; + end; + if s <> '' then + DrawText(x, y, s, ALineHeight); +end; + +procedure TsTextPainter.DrawText(var x, y: Integer; s: String; + ALineHeight: Integer); +const + MULTIPLIER: Array[TsTextRotation, boolean] of Integer = ( + (+1, -1), // horiz ^ + (+1, -1), // 90° CW FRightToLeft + (-1, +1), // 90° CCW + (+1, -1) // stacked + ); + TEXT_ANGLE: array[TsTextRotation] of Integer = ( 0, -900, 900, 0); +var + w: Integer; + P: TPoint; +begin + w := FCanvas.TextWidth(s); + P := GetTextPt(x, y, ALineHeight); + FCanvas.Font.Orientation := TEXT_ANGLE[FTextRotation]; + case FTextRotation of + trHorizontal: + begin + if FRightToLeft + then FCanvas.TextOut(P.x-w, P.y, s) + else FCanvas.TextOut(P.x, P.y, s); + inc(x, w*MULTIPLIER[FTextRotation, FRightToLeft]); + end; + rt90DegreeClockwiseRotation: + begin + if FRightToLeft + then FCanvas.TextOut(P.x, P.y-w, s) + else FCanvas.TextOut(P.x, p.y, s); + inc(y, w*MULTIPLIER[FTextRotation, FRightToLeft]); + end; + rt90DegreeCounterClockwiseRotation: + begin + if FRightToLeft + then FCanvas.TextOut(P.x, P.y+w, s) + else FCanvas.TextOut(P.x, P.y, s); + inc(y, w*MULTIPLIER[FTextRotation, FRightToLeft]); + end; + rtStacked: + begin // IS THIS OK? + w := FCanvas.TextWidth(s); + // chars centered around x + if FRightToLeft + then FCanvas.TextOut(P.x - w div 2, P.y - FFontHeight, s) + else FCanvas.TextOut(P.x - w div 2, P.y, s); + inc(y, FFontHeight * MULTIPLIER[FTextRotation, FRightToLeft]); + end; end; end; - *) + +function TsTextPainter.GetHeight: Integer; +begin + if FTextRotation = rtStacked then + Result := FLines.Count * FStackperiod // to be understood horizontally + else + Result := FTotalHeight; +end; + +function TsTextPainter.GetTextPt(x,y,ALineHeight: Integer): TPoint; +begin + case FTextRotation of + trHorizontal, rtStacked: + case FFontPos of + fpNormal : Result := Point(x, y); + fpSubscript : Result := Point(x, y + ALineHeight div 2); + fpSuperscript : Result := Point(x, y - ALineHeight div 6); + end; + rt90DegreeClockwiseRotation: + case FFontPos of + fpNormal : Result := Point(x, y); + fpSubscript : Result := Point(x - ALineHeight div 2, y); + fpSuperscript : Result := Point(x + ALineHeight div 6, y); + end; + rt90DegreeCounterClockWiseRotation: + case FFontPos of + fpNormal : Result := Point(x, y); + fpSubscript : Result := Point(x + ALineHeight div 2, y); + fpSuperscript : Result := Point(x - ALineHeight div 6, y); + end; + end; +end; + +function TsTextPainter.GetWidth: Integer; +begin + Result := FMaxLineLen; +end; + +{ Called before analyzing and rendering of the text. + ACurrRtpIndex ......... Index of CURRENT rich-text parameter + ACharIndexOfNextFont .. Character index when NEXT font change will occur + ACurrFontHeight ....... CURRENT font height + ACurrFontPos .......... CURRENT font position (normal/sub/superscript) } +procedure TsTextPainter.InitFont(out ACurrRtpIndex, ACharIndexOfNextFont, + ACurrFontHeight: Integer; out ACurrFontPos: TsFontPosition); +var + fnt: TsFont; +begin + FCharIndex := 1; + if (Length(FRtParams) = 0) then + begin + FRtpIndex := -1; + fnt := FWorkbook.GetFont(FFontIndex); + ACharIndexOfNextFont := MaxInt; + end + else if (FRtParams[0].FirstIndex = 1) then + begin + ACurrRtpIndex := 0; + fnt := FWorkbook.GetFont(FRtParams[0].FontIndex); + if Length(FRtParams) > 1 then + ACharIndexOfNextFont := FRtParams[1].FirstIndex + else + ACharIndexOfNextFont := MaxInt; + end else + begin + fnt := FWorkbook.GetFont(FFontIndex); + ACurrRtpIndex := -1; + ACharIndexOfNextFont := FRtParams[0].FirstIndex; + end; + Convert_sFont_to_Font(fnt, FCanvas.Font); + ACurrFontHeight := FCanvas.TextHeight('Tg'); + if (fnt <> nil) and (fnt.Position <> fpNormal) then + FCanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR); + ACurrFontPos := fnt.Position; +end; + +procedure TsTextPainter.NextChar(ANumBytes: Integer); +begin + inc(FPtr, ANumBytes); + inc(FCharIndex); +end; + +{ Get layout of lines + "lineinfos" collect data for where lines start and end, their width and + height, the rich-text parameter index range, and the number of spaces and + a word list (for text justification). } +procedure TsTextPainter.Prepare; +var + lineInfo: TsLineInfo; + ts: TTextStyle; +begin + FTotalHeight := 0; + FMaxLinelen := 0; + + if FText = '' then + exit; + + ts := FCanvas.TextStyle; + ts.RightToLeft := FRightToLeft; + FCanvas.TextStyle := ts; + + InitFont(FRtpIndex, FCharIndexOfNextFont, FFontHeight, FFontPos); + if FTextRotation = rtStacked then + FStackPeriod := FCanvas.TextWidth('M') * 2; + + FPtr := PChar(FText); + FCharIndex := 1; + while (FPtr^ <> #0) do begin + lineInfo := TsLineInfo.Create; + lineInfo.pStart := FPtr; + lineInfo.BeginsWithFontOfRtpIndex := FRtpIndex; + ScanLine(lineInfo.NumSpaces, lineInfo.Width, lineInfo.Height, lineInfo.WordList); + FLines.Add(lineinfo); + FTotalHeight := FTotalHeight + lineInfo.Height; + FMaxLineLen := Max(FMaxLineLen, lineInfo.Width); + end; +end; + +{ Scans the line for a possible line break. The max width is determined by + the size of the rectangle ARect passed to the outer procedure: + rectangle width in case of horizontal painting, rectangle height in case + of vertical painting. Line breaks can occure at spaces or cr/lf characters, + or, if not found, at any character reaching the max width. + + Parameters: + + P defines where the scan starts. At the end of the routine it + points to the first character of the next line. + ANumSpaces is how many spaces were found between the start and end value + of P. + ARtpFontIndex At input, this is the index of the rich-text formatting + parameter value used for the font at line start. At output, + it is the index which will be valid at next line start. + ALineWidth the pixel width of the line seen along drawing direction, i.e. + in case of stacked text it is the character height times + character count in the line (!) + ALineHeight The height of the line as seen vertical to the drawing + direction. Normally this is the height of the largest font + found in the line; in case of stacked text it is the + standardized width of a character. } +procedure TsTextPainter.ScanLine(var ANumSpaces, ALineWidth, ALineHeight: Integer; + AWordList: TStringList); +var + savedWidth: Integer; + savedSpaces: Integer; + savedCharIndex: Integer; + savedCurrRtpIndex: Integer; + savedCharIndexOfNextFont: Integer; + maxWidth: Integer; + s: String; + charLen: Integer; + ch: String; + dw: Integer; + EOL: Boolean; + pWordStart: PChar; +begin + ANumSpaces := 0; + ALineHeight := FFontHeight; + ALineWidth := 0; + savedWidth := 0; + savedSpaces := 0; + s := ''; + + maxWidth := MaxInt; + if FWordWrap then + begin + if FTextRotation = trHorizontal then + maxWidth := FRect.Right - FRect.Left + else + maxWidth := FRect.Bottom - FRect.Top; + end; + + while (FPtr^ <> #0) do + begin + case FPtr^ of + #13: begin + NextChar(1); + if FPtr^ = #10 then + NextChar(1); + break; + end; + #10: begin + NextChar(1); + break; + end; + ' ': begin + AWordList.Add(s); + savedWidth := ALineWidth; + savedSpaces := ANumSpaces; + // Find next word + while FPtr^ = ' ' do + begin + UpdateFont(FCharIndex, FRtpIndex, FCharIndexOfNextFont, FFontHeight, FFontPos); + ALineHeight := Max(FFontHeight, ALineHeight); + dw := Math.IfThen(FTextRotation = rtStacked, FFontHeight, FCanvas.TextWidth(' ')); + ALineWidth := ALineWidth + dw; + inc(ANumSpaces); + NextChar(1); + end; + if ALineWidth >= maxWidth then + begin + ALineWidth := savedWidth; + ANumSpaces := savedSpaces; + break; + end; + end; + else + // Here, a new word begins. Find the end of this word and check if + // it fits into the line. + // Store the data valid for the word start. + s := ''; + pWordStart := FPtr; + savedCharIndex := FCharIndex; + savedCurrRtpIndex := FRtpIndex; + savedCharIndexOfNextFont := FCharIndexOfNextFont; + EOL := false; + while (FPtr^ <> #0) and (FPtr^ <> #13) and (FPtr^ <> #10) and (FPtr^ <> ' ') do + begin + UpdateFont(FCharIndex, FRtpIndex, FCharIndexOfNextFont, FFontHeight, FFontPos); + ALineHeight := Max(FFontHeight, ALineHeight); + ch := UnicodeToUTF8(UTF8CharacterToUnicode(FPtr, charLen)); + dw := Math.IfThen(FTextRotation = rtStacked, FFontHeight, FCanvas.TextWidth(ch)); + ALineWidth := ALineWidth + dw; + if ALineWidth <= maxWidth then + s := s + ch + else + begin + // The line exeeds the max line width. + // There are two cases: + if ANumSpaces > 0 then + begin + // (a) This is not the only word: Go back to where this + // word began. We had stored everything needed! + FPtr := pWordStart; + FCharIndex := savedCharIndex; + FCharIndexOfNextFont := savedCharIndexOfNextFont; + ALineWidth := savedWidth; + FRtpIndex := savedCurrRtpIndex; + end else begin + // (b) This is the only word in the line --> we break at the + // current cursor position. + AWordList.Add(s); + s := ''; + end; + EOL := true; + break; + end; + NextChar(charLen); + end; + if EOL then break; + end; + end; + UpdateFont(FCharIndex, FRtpIndex, FCharIndexOfNextFont, FFontHeight, FFontPos); + ALineHeight := Max(FFontHeight, ALineHeight); + if s <> '' then AWordList.Add(s); +end; + +{ The scanner has reached the text character at the specified position. + Determines the + - index of the NEXT rich-text parameter (ANextRtParamIndex) + - character index where NEXT font change will occur (ACharIndexOfNextFont) + - CURRENT font height (ACurrFontHeight) + - CURRENT font position (normal/sub/super) (ACurrFontPos) } +procedure TsTextPainter.UpdateFont(ACharIndex: Integer; + var ACurrRtpIndex, ACharIndexOfNextFont, ACurrFontHeight: Integer; + var ACurrFontPos: TsFontPosition); +var + fnt: TsFont; +begin + if (ACurrRtpIndex < High(FRtParams)) and (ACharIndex = ACharIndexOfNextFont) then + begin + inc(ACurrRtpIndex); + if ACurrRtpIndex < High(FRtParams) then + ACharIndexOfNextFont := FRtParams[ACurrRtpIndex+1].FirstIndex else + ACharIndexOfNextFont := MaxInt; + fnt := FWorkbook.GetFont(FRtParams[ACurrRtpIndex].FontIndex); + Convert_sFont_to_Font(fnt, FCanvas.Font); + ACurrFontHeight := FCanvas.TextHeight('Tg'); + if fnt.Position <> fpNormal then + FCanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR); + ACurrFontPos := fnt.Position; + end; +end; + + end.