paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-06 14:18:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Fix grid pasting of selection into Excel doesn't preserve text line endings and may generate merged cells. Patch from K155LA3, issue #34789

Browse Source 
(cherry picked from commit d19cd29754)
This commit is contained in:
Jesus Reyes A 2021-08-02 16:04:27 -05:00
parent ef20dfd61f
commit 6a1d59a9af
1 changed files with 36 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
lcl/grids.pas
View File

@ -11250,7 +11250,7 @@ var
function QuoteText(s: string): string; function QuoteText(s: string): string;
begin begin
DoCellProcess(aCol, aRow, cpCopy, s); DoCellProcess(aCol, aRow, cpCopy, s);
if (pos(#9, s)>0) or //Excel and Calc convert tab symbol # 9 in cell to whitespace. if (pos(#9, s)>0) or
(pos(#10, s)>0) or (pos(#10, s)>0) or
(pos(#13, s)>0) (pos(#13, s)>0)
then then
@ -11282,10 +11282,15 @@ var
begin begin
SelStr := ''; SelStr := '';
SelHTMLStr := '<table>';
SelHTMLStr := '<head><style><!--table br {mso-data-placement:same-cell;} --></style></head>' + #13#10 +
'<table>' + #13#10;
//<head>...</head> MS Excel crutch, otherwise Excel split merged cell if it found <br> tag
for aRow := R.Top to R.Bottom do begin for aRow := R.Top to R.Bottom do begin
SelHTMLStr := SelHTMLStr + '<tr>'; SelHTMLStr := SelHTMLStr + '<tr>' + #13#10;
for aCol := R.Left to R.Right do begin for aCol := R.Left to R.Right do begin
@ -11298,18 +11303,18 @@ begin
if (aRow = 0) and (FixedRows > 0) then if (aRow = 0) and (FixedRows > 0) then
begin begin
SelStr := SelStr + QuoteText(Columns[k].Title.Caption); SelStr := SelStr + QuoteText(Columns[k].Title.Caption);
SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Columns[k].Title.Caption) + '</td>'; SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Columns[k].Title.Caption) + '</td>' + #13#10;
end end
else else
begin begin
SelStr := SelStr + QuoteText(Cells[aCol,aRow]); SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>'; SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>' + #13#10;
end; end;
end else end else
begin begin
SelStr := SelStr + QuoteText(Cells[aCol,aRow]); SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>'; SelHTMLStr := SelHTMLStr + '<td>' + PrepareToHTML(Cells[aCol,aRow]) + '</td>' + #13#10;
end; end;
if aCol <> R.Right then if aCol <> R.Right then
@ -11317,9 +11322,9 @@ begin
end; end;
SelStr := SelStr + sLineBreak; SelStr := SelStr + sLineBreak;
SelHTMLStr := SelHTMLStr + '</tr>'; SelHTMLStr := SelHTMLStr + '</tr>' + #13#10;
end; end;
SelHTMLStr := SelHTMLStr + '</table>'; SelHTMLStr := SelHTMLStr + #13#10 + '</table>';
Clipboard.SetAsHtml(SelHTMLStr, SelStr); Clipboard.SetAsHtml(SelHTMLStr, SelStr);
end; end;
@ -11645,42 +11650,28 @@ var
bCellData, bTagEnd: Boolean; bCellData, bTagEnd: Boolean;
bStr, bEndStr: PChar; bStr, bEndStr: PChar;
function ReplaceEntities(const cSt: string): string; function ReplaceEntities(cSt: string): string;
var var
o,a,b: pchar;
dName: widestring; dName: widestring;
dEntity: WideChar; dEntity: WideChar;
pAmp, pSemi, pStart: Integer;
begin begin
//debugln(['ReplaceEntities: cSt=',cSt]);
Result := '';
if (cSt = '') then
Exit;
pStart := 1;
while true do begin while true do begin
//debugln([' pStart=',pStart]); result := cSt;
pAmp := PosEx('&', cSt, pStart); if cSt = '' then
if (pAmp > 0) then break;
pSemi := PosEx(';', cSt, pAmp); o := @cSt[1];
if ((pAmp and pSemi) = 0) then begin a := strscan(o, '&');
//debugln(' pAmp or pSemi = 0'); if a = nil then
Result := Result + Copy(cSt, pStart, MaxInt); break;
Exit; b := strscan(a + 1, ';');
end; if b = nil then
//debugln([' pAmp=',pAmp,', pSemi=',pSemi]); break;
dName := Utf8Decode(Copy(cSt, pAmp + 1, pSemi - pAmp - 1)); dName := UTF8Decode(copy(cSt, a - o + 2, b - a - 1));
//debugln([' dName=',Utf8Encode(dName)]);
Result := Result + Copy(cSt, pStart, pAmp - pStart);
pStart := pSemi + 1;
dEntity := ' '; dEntity := ' ';
if ResolveHTMLEntityReference(dName, dEntity) then begin if ResolveHTMLEntityReference(dName, dEntity) then begin
//debugln(['dEntity=',Utf8Encode(dEntity)]); system.delete(cSt, a - o + 1, b - a + 1);
result := result + Utf8Encode(dEntity); system.insert(UTF8Encode(dEntity), cSt, a - o + 1);
end
else begin
//illegal html entity
//debugln(' illegal html entity: replace with "?"');
Result := Result + '?';
end; end;
end; end;
end; end;
@ -11700,6 +11691,14 @@ begin
while bStr < bEndStr do while bStr < bEndStr do
begin begin
if bStr^ = #13 then // delete #13#10#20...#20 Excel place this after <br> tag.
begin
while bStr < (bEndStr - 1) do
begin
Inc(bStr);
if (bStr^ <> #10) and (bStr^ <> ' ') then Break;
end;
end;
if bStr^ = '<' then // tag start sign '<' if bStr^ = '<' then // tag start sign '<'
begin begin
bTagEnd := False; bTagEnd := False;