diff --git a/lcl/grids.pas b/lcl/grids.pas
index 349de0d9de..311ae55ba5 100644
--- a/lcl/grids.pas
+++ b/lcl/grids.pas
@@ -34,7 +34,7 @@ interface
uses
// RTL + FCL
- Classes, SysUtils, Types, TypInfo, Math, FPCanvas,
+ Classes, SysUtils, Types, TypInfo, Math, FPCanvas, HtmlDefs,
// LCL
LCLStrConsts, LCLType, LCLIntf, Controls, Graphics, Forms,
LMessages, StdCtrls, LResources, MaskEdit, Buttons, Clipbrd, Themes, imglist,
@@ -1702,6 +1702,7 @@ type
//procedure DrawInteriorCells; override;
//procedure SelectEditor; override;
procedure SelectionSetText(TheText: String);
+ procedure SelectionSetHTML(TheHTML, TheText: String);
procedure SetCells(ACol, ARow: Integer; const AValue: string); virtual;
procedure SetCheckboxState(const aCol, aRow:Integer; const aState: TCheckboxState); override;
procedure SetEditText(aCol, aRow: Longint; const aValue: string); override;
@@ -11024,12 +11025,13 @@ end;
procedure TCustomStringGrid.CopyCellRectToClipboard(const R: TRect);
var
- SelStr: String;
+ SelStr, SelHTMLStr: String;
aRow,aCol,k: LongInt;
+
function QuoteText(s: string): string;
begin
DoCellProcess(aCol, aRow, cpCopy, s);
- if (pos(#9, s)>0) or
+ if (pos(#9, s)>0) or //Excel and Calc convert tab symbol # 9 in cell to whitespace.
(pos(#10, s)>0) or
(pos(#13, s)>0)
then
@@ -11037,33 +11039,69 @@ var
else
result := s;
end;
+
+ function PrepareToHTML(s: string): string;
+ var
+ i1: Integer;
+ s1: string;
+ begin
+ Result := '';
+ for i1 := 1 to Length(s) do
+ begin
+ case s[i1] of
+ #13: s1 := '
';
+ #10: if i1 > 1 then if s[i1 - 1] = #13 then s1 := '' else s1 := '
';
+ '<': s1 := '<';
+ '>': s1 := '>';
+ '"': s1 := '"';
+ '&': s1 := '&';
+ else s1 := s[i1];
+ end;
+ Result := Result + s1;
+ end;
+ end;
+
begin
SelStr := '';
- for aRow:=R.Top to R.Bottom do begin
+ SelHTMLStr := '
';
+ for aRow := R.Top to R.Bottom do begin
- for aCol:=R.Left to R.Right do begin
+ SelHTMLStr := SelHTMLStr + '';
- if Columns.Enabled and (aCol>=FirstGridColumn) then begin
+ for aCol := R.Left to R.Right do begin
+
+ if Columns.Enabled and (aCol >= FirstGridColumn) then begin
k := ColumnIndexFromGridColumn(aCol);
if not Columns[k].Visible then
continue;
- if (aRow=0) and (FixedRows>0) then
- SelStr := SelStr + QuoteText(Columns[k].Title.Caption)
+ if (aRow = 0) and (FixedRows > 0) then
+ begin
+ SelStr := SelStr + QuoteText(Columns[k].Title.Caption);
+ SelHTMLStr := SelHTMLStr + '' + PrepareToHTML(Columns[k].Title.Caption) + ' | ';
+ end
else
+ begin
SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
+ SelHTMLStr := SelHTMLStr + '' + PrepareToHTML(Cells[aCol,aRow]) + ' | ';
+ end;
end else
- SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
+ begin
+ SelStr := SelStr + QuoteText(Cells[aCol,aRow]);
+ SelHTMLStr := SelHTMLStr + '' + PrepareToHTML(Cells[aCol,aRow]) + ' | ';
+ end;
- if aCol<>R.Right then
+ if aCol <> R.Right then
SelStr := SelStr + #9;
end;
SelStr := SelStr + sLineBreak;
+ SelHTMLStr := SelHTMLStr + '
';
end;
- Clipboard.AsText := SelStr;
+ SelHTMLStr := SelHTMLStr + '
';
+ Clipboard.SetAsHtml(SelHTMLStr, SelStr);
end;
procedure TCustomStringGrid.AssignTo(Dest: TPersistent);
@@ -11253,8 +11291,10 @@ begin
if HasMultiSelection then
exit;
- if EditingAllowed(Col) and Clipboard.HasFormat(CF_TEXT) then begin
- SelectionSetText(Clipboard.AsText);
+ if EditingAllowed(Col) then
+ begin
+ if Clipboard.HasFormat(CF_TEXT) and not Clipboard.HasFormat(CF_HTML) then SelectionSetText(Clipboard.AsText);
+ if Clipboard.HasFormat(CF_TEXT) and Clipboard.HasFormat(CF_HTML) then SelectionSetHTML(Clipboard.GetAsHtml(True), Clipboard.AsText);
end;
end;
@@ -11377,6 +11417,123 @@ begin
end;
end;
+procedure TCustomStringGrid.SelectionSetHTML(TheHTML, TheText: String);
+var
+ bStartCol, bStartRow, bCol, bRow: Integer;
+ bCellStr: string;
+ bSelRect: TRect;
+
+ bCellData, bTagEnd: Boolean;
+ bStr, bEndStr: PChar;
+
+ function ReplaceEntities(cSt: string): string;
+ var
+ o,a,b: pchar;
+ dName: widestring;
+ dEntity: WideChar;
+ begin
+ while true do begin
+ result := cSt;
+ if cSt = '' then
+ break;
+ o := @cSt[1];
+ a := strscan(o, '&');
+ if a = nil then
+ break;
+ b := strscan(a + 1, ';');
+ if b = nil then
+ break;
+ dName := UTF8Decode(copy(cSt, a - o + 2, b - a - 1));
+ dEntity := ' ';
+ if ResolveHTMLEntityReference(dName, dEntity) then begin
+ system.delete(cSt, a - o + 1, b - a + 1);
+ system.insert(UTF8Encode(dEntity), cSt, a - o + 1);
+ end;
+ end;
+ end;
+
+begin
+ if theHTML <> '' then
+ begin
+ bSelRect := Selection;
+ bStartCol := Selection.Left;
+ bStartRow := Selection.Top;
+ bCol := bStartCol;
+ bRow := bStartRow;
+ bStr := PChar(theHTML);
+ bEndStr := bStr + StrLen(bStr) - 4;
+ bCellStr := '';
+ bCellData := False;
+
+ while bStr < bEndStr do
+ begin
+ if bStr^ = '<' then // tag start sign '<'
+ begin
+ bTagEnd := False;
+ Inc(bStr);
+
+ if UpCase(bStr^) = 'B' then
+ begin
+ Inc(bStr);
+ if (UpCase(bStr^) = 'R') and bCellData then bCellStr := bCellStr + #10; // tag
in table cell
+ end;
+
+ if bStr^ = '/' then // close tag sign '/'
+ begin
+ bTagEnd := True;
+ Inc(bStr);
+ end;
+
+ if UpCase(bStr^) = 'T' then
+ begin
+ Inc(bStr);
+
+ if UpCase(bStr^) = 'R' then // table start row tag
+ begin
+ bCellData := False;
+ if bTagEnd then // table end row tag
+ begin
+ bSelRect.Bottom := bRow;
+ Inc(bRow);
+ bCol := bStartCol;
+ end;
+ end;
+
+ if UpCase(bStr^) = 'D' then // table start cell tag
+ begin
+ bCellData := not bTagEnd;
+ if bTagEnd then // table end cell tag |
+ begin
+ if (bCol < ColCount) and (bRow < RowCount) then Cells[bCol, bRow] := ReplaceEntities(bCellStr);
+ bSelRect.Right := bCol;
+ Inc(bCol);
+ bCellStr := '';
+ end;
+ end;
+ end;
+
+ while bStr < bEndStr do
+ begin
+ Inc(bStr);
+ if bStr^ = '>' then // tag end sign '>'
+ begin
+ Inc(bStr);
+ Break;
+ end;
+ end;
+ end else
+ begin
+ if (bStr^ <> #13) and (bStr^ <> #10) and (bStr^ <> #9) and bCellData then bCellStr := bCellStr + bStr^;
+ Inc(bStr);
+ end;
+ end;
+
+ if (bCol = bStartCol) and (bRow = bStartRow) then Cells[bCol, bRow] := TheText; //set text in cell if clipboard has CF_HTML fomat, but havent HTML table
+ Selection := bSelRect; // set correct selection
+ end;
+end;
+
+
procedure TCustomStringGrid.SetCheckboxState(const aCol, aRow: Integer;
const aState: TCheckboxState);
begin
diff --git a/lcl/include/customnotebook.inc b/lcl/include/customnotebook.inc
index 43216c09a9..c2e6e76304 100644
--- a/lcl/include/customnotebook.inc
+++ b/lcl/include/customnotebook.inc
@@ -581,7 +581,7 @@ begin
if (AValue < -1) or (AValue >= PageCount) then Exit;
//debugln('TCustomTabControl.SetPageIndex A ',dbgsName(Self),' AValue=',dbgs(AValue),' fPageIndex=',dbgs(fPageIndex),' PageCount=',dbgs(PageCount),' HandleAllocated=',dbgs(HandleAllocated),' ',dbgs(ComponentState));
if FPageIndex = AValue then exit;
- if not CanChangePageIndex then exit;
+ if (nboDoChangeOnSetIndex in Options) and (not CanChangePageIndex) then exit; //Delphi does not call CanChange either
//debugln('TCustomTabControl.SetPageIndex B ',dbgsName(Self),' AValue=',dbgs(AValue),' fPageIndex=',dbgs(fPageIndex),' PageCount=',dbgs(PageCount),' HandleAllocated=',dbgs(HandleAllocated));
InternalSetPageIndex(AValue);