fpspreadsheet: Fix RTL text alignment bug in TWorksheetGrid for Arabian text

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4459 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-01-23 13:43:03 +00:00
parent 61db2acff8
commit 845e9d8626

View File

@@ -1309,6 +1309,7 @@ end;
procedure TsTextPainter.ScanLine(var ANumSpaces, ALineWidth, ALineHeight: Integer; procedure TsTextPainter.ScanLine(var ANumSpaces, ALineWidth, ALineHeight: Integer;
AWordList: TStringList); AWordList: TStringList);
var var
tmpWidth: Integer;
savedWidth: Integer; savedWidth: Integer;
savedSpaces: Integer; savedSpaces: Integer;
savedCharIndex: Integer; savedCharIndex: Integer;
@@ -1321,13 +1322,19 @@ var
dw: Integer; dw: Integer;
EOL: Boolean; EOL: Boolean;
pWordStart: PChar; pWordStart: PChar;
part: String;
savedpart: String;
PStart: PChar;
begin begin
ANumSpaces := 0; ANumSpaces := 0;
ALineHeight := FFontHeight; ALineHeight := FFontHeight;
ALineWidth := 0; ALineWidth := 0;
savedWidth := 0; savedWidth := 0;
savedSpaces := 0; savedSpaces := 0;
s := ''; s := ''; // current word
part := ''; // current part of the string where all characters have the same font
savedpart := '';
tmpWidth := 0;
maxWidth := MaxInt; maxWidth := MaxInt;
if FWordWrap then if FWordWrap then
@@ -1338,16 +1345,23 @@ begin
maxWidth := FRect.Bottom - FRect.Top; maxWidth := FRect.Bottom - FRect.Top;
end; end;
PStart := FPtr;
while (FPtr^ <> #0) do while (FPtr^ <> #0) do
begin begin
case FPtr^ of case FPtr^ of
#13: begin #13: begin
if (part <> '') and (FTextRotation <> rtStacked) then
ALineWidth := ALineWidth + FCanvas.TextWidth(part);
part := '';
NextChar(1); NextChar(1);
if FPtr^ = #10 then if FPtr^ = #10 then
NextChar(1); NextChar(1);
break; break;
end; end;
#10: begin #10: begin
if (part <> '') and (FTextRotation <> rtStacked) then
ALineWidth := ALineWidth + FCanvas.TextWidth(part);
part := '';
NextChar(1); NextChar(1);
break; break;
end; end;
@@ -1358,10 +1372,17 @@ begin
// Find next word // Find next word
while FPtr^ = ' ' do while FPtr^ = ' ' do
begin begin
if (FCharIndex = FCharIndexOfNextFont) then
begin
if (FTextRotation <> rtStacked) then
ALineWidth := ALineWidth + FCanvas.TextWidth(part);
part := '';
end;
UpdateFont(FCharIndex, FRtpIndex, FCharIndexOfNextFont, FFontHeight, FFontPos); UpdateFont(FCharIndex, FRtpIndex, FCharIndexOfNextFont, FFontHeight, FFontPos);
if FTextRotation = rtStacked then
ALineWidth := ALineWidth + FFontHeight else
part := part + ' ';
ALineHeight := Max(FFontHeight, ALineHeight); ALineHeight := Max(FFontHeight, ALineHeight);
dw := Math.IfThen(FTextRotation = rtStacked, FFontHeight, FCanvas.TextWidth(' '));
ALineWidth := ALineWidth + dw;
inc(ANumSpaces); inc(ANumSpaces);
NextChar(1); NextChar(1);
end; end;
@@ -1369,6 +1390,7 @@ begin
begin begin
ALineWidth := savedWidth; ALineWidth := savedWidth;
ANumSpaces := savedSpaces; ANumSpaces := savedSpaces;
part := '';
break; break;
end; end;
end; end;
@@ -1381,17 +1403,26 @@ begin
savedCharIndex := FCharIndex; savedCharIndex := FCharIndex;
savedCurrRtpIndex := FRtpIndex; savedCurrRtpIndex := FRtpIndex;
savedCharIndexOfNextFont := FCharIndexOfNextFont; savedCharIndexOfNextFont := FCharIndexOfNextFont;
savedpart := part;
tmpWidth := 0;
EOL := false; EOL := false;
while (FPtr^ <> #0) and (FPtr^ <> #13) and (FPtr^ <> #10) and (FPtr^ <> ' ') do while (FPtr^ <> #0) and (FPtr^ <> #13) and (FPtr^ <> #10) and (FPtr^ <> ' ') do
begin begin
if FCharIndex = FCharIndexOfNextFont then
begin
if (FTextRotation <> rtStacked) then
ALineWidth := ALineWidth + FCanvas.TextWidth(part);
part := '';
end;
UpdateFont(FCharIndex, FRtpIndex, FCharIndexOfNextFont, FFontHeight, FFontPos); UpdateFont(FCharIndex, FRtpIndex, FCharIndexOfNextFont, FFontHeight, FFontPos);
ALineHeight := Max(FFontHeight, ALineHeight);
ch := UnicodeToUTF8(UTF8CharacterToUnicode(FPtr, charLen)); ch := UnicodeToUTF8(UTF8CharacterToUnicode(FPtr, charLen));
dw := Math.IfThen(FTextRotation = rtStacked, FFontHeight, FCanvas.TextWidth(ch)); part := part + ch;
ALineWidth := ALineWidth + dw; tmpWidth := IfThen(FTextRotation = rtStacked, tmpWidth + FFontHeight, FCanvas.TextWidth(part));
if ALineWidth <= maxWidth then if ALineWidth + tmpWidth <= maxWidth then
s := s + ch begin
else s := s + ch;
ALineHeight := Max(FFontHeight, ALineHeight);
end else
begin begin
// The line exeeds the max line width. // The line exeeds the max line width.
// There are two cases: // There are two cases:
@@ -1402,13 +1433,13 @@ begin
FPtr := pWordStart; FPtr := pWordStart;
FCharIndex := savedCharIndex; FCharIndex := savedCharIndex;
FCharIndexOfNextFont := savedCharIndexOfNextFont; FCharIndexOfNextFont := savedCharIndexOfNextFont;
ALineWidth := savedWidth;
FRtpIndex := savedCurrRtpIndex; FRtpIndex := savedCurrRtpIndex;
end else begin part := '';
end else
begin
// (b) This is the only word in the line --> we break at the // (b) This is the only word in the line --> we break at the
// current cursor position. // current cursor position.
AWordList.Add(s); UTF8Delete(part, UTF8Length(part), 1);
s := '';
end; end;
EOL := true; EOL := true;
break; break;
@@ -1418,9 +1449,15 @@ begin
if EOL then break; if EOL then break;
end; end;
end; end;
if s <> '' then
AWordList.Add(s);
if (part <> '') and (FTextRotation <> rtStacked) then
ALineWidth := ALineWidth + FCanvas.TextWidth(part);
UpdateFont(FCharIndex, FRtpIndex, FCharIndexOfNextFont, FFontHeight, FFontPos); UpdateFont(FCharIndex, FRtpIndex, FCharIndexOfNextFont, FFontHeight, FFontPos);
ALineHeight := Max(FFontHeight, ALineHeight); ALineHeight := Max(FFontHeight, ALineHeight);
if s <> '' then AWordList.Add(s);
end; end;
{ The scanner has reached the text character at the specified position. { The scanner has reached the text character at the specified position.