pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Copy to clipboard as HTML

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4358 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-09-24 19:31:54 +00:00
parent c84939b956
commit 28d84ab294
2 changed files with 77 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files

84
components/fpspreadsheet/fpshtml.pas
View File

@ -63,6 +63,11 @@ type
TsHTMLWriter = class(TsCustomSpreadWriter)
private
FPointSeparatorSettings: TFormatSettings;
FClipboardMode: Boolean;
FStartHtmlPos: Int64;
FEndHtmlPos: Int64;
FStartFragmentPos: Int64;
FEndFragmentPos: Int64;
function CellFormatAsString(AFormat: PsCellFormat; ATagName: String): String;
function GetBackgroundAsStyle(AFill: TsFillPattern): String;
function GetBorderAsStyle(ABorder: TsCellBorders; const ABorderStyles: TsCellBorderStyles): String;
@ -100,6 +105,7 @@ type
public
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
procedure WriteToClipboardStream(AStream: TStream); override;
procedure WriteToStream(AStream: TStream); override;
procedure WriteToStrings(AStrings: TStrings); override;
end;
@ -137,6 +143,16 @@ uses
const
MIN_FONTSIZE = 6;
NATIVE_HEADER = 'Version:0.9' + #13#10 +
'StartHTML:%.10d' + #13#10 + // Index of first char of <HTML> tag
'EndHTML:%.10d' + #13#10 + // End of end of file
'StartFragment:%.10d' + #13#10 + // Index of first char after <TABLE> tag
'EndFragment:%.10d' + #13#10; // Index of last char before </TABLE> tag
START_FRAGMENT = '<!--StartFragment-->';
END_FRAGMENT = '<!--EndFragment-->';
{==============================================================================}
{ TsHTMLReader }
{==============================================================================}
@ -1458,7 +1474,7 @@ var
begin
AppendToStream(AStream,
'<body>');
if HTMLParams.SheetIndex < 0 then // active sheet
if FClipboardMode or (HTMLParams.SheetIndex < 0) then // active sheet
begin
if FWorkbook.ActiveWorksheet = nil then
FWorkbook.SelectWorksheet(FWorkbook.GetWorksheetByIndex(0));
@ -1640,22 +1656,6 @@ begin
'<div>' + s + '</div>');
end;
procedure TsHTMLWriter.WriteToStream(AStream: TStream);
begin
FWorkbook.UpdateCaches;
AppendToStream(AStream,
'<!DOCTYPE html>' +
'<html>' +
'<head>'+
'<meta charset="utf-8">');
WriteStyles(AStream);
AppendToStream(AStream,
'</head>');
WriteBody(AStream);
AppendToStream(AStream,
'</html>');
end;
procedure TsHTMLWriter.WriteStyles(AStream: TStream);
var
i: Integer;
@ -1675,6 +1675,41 @@ begin
'</style>' + LineEnding);
end;
procedure TsHTMLWriter.WriteToClipboardStream(AStream: TStream);
begin
FClipboardMode := true;
AppendToStream(AStream, Format(
NATIVE_HEADER, [0, 0, 0, 0])); // value will be replaced at end
WriteToStream(AStream);
AStream.Position := 0;
AppendToStream(AStream, Format(
NATIVE_HEADER, [FStartHTMLPos, FEndHTMLPos, FStartFragmentPos, FEndFragmentPos]));
end;
procedure TsHTMLWriter.WriteToStream(AStream: TStream);
begin
FWorkbook.UpdateCaches;
AppendToStream(AStream,
'<!DOCTYPE html>');
FStartHTMLPos := AStream.Position;
AppendToStream(AStream,
'<html>' +
'<head>'+
'<meta charset="utf-8">');
WriteStyles(AStream);
AppendToStream(AStream,
'</head>');
WriteBody(AStream);
AppendToStream(AStream,
'</html>');
FEndHTMLPos := AStream.Position;
end;
procedure TsHTMLWriter.WriteToStrings(AStrings: TStrings);
var
Stream: TStream;
@ -1732,6 +1767,12 @@ begin
'<div>' + LineEnding +
'<table style="' + style + '">' + LineEnding);
if FClipboardMode then
begin
AppendToStream(AStream, START_FRAGMENT);
FStartFragmentPos := AStream.Position;
end;
if HTMLParams.ShowRowColHeaders then
begin
// width of row-header column
@ -1838,6 +1879,13 @@ begin
AppendToStream(AStream,
'</tr>' + LineEnding);
end;
if FClipboardMode then
begin
AppendToStream(AStream, END_FRAGMENT);
FEndFragmentPos := AStream.Position;
end;
AppendToStream(AStream,
'</table>' + LineEnding +
'</div>');
@ -1845,7 +1893,7 @@ end;
initialization
InitFormatSettings(HTMLParams.FormatSettings);
RegisterSpreadFormat(TsHTMLReader, TsHTMLWriter, sfHTML);
RegisterSpreadFormat(TsHTMLReader, TsHTMLWriter, sfHTML, false, true);
end.

12
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

@ -470,6 +470,7 @@ uses
var
cfBiff8Format: Integer = 0;
cfBiff5Format: Integer = 0;
cfHTMLFormat: Integer = 0;
cfCSVFormat: Integer = 0;
{@@ ----------------------------------------------------------------------------
@ -1168,6 +1169,11 @@ begin
if cfBiff5Format = 0 then
cfBiff5Format := RegisterClipboardFormat('Biff5');
// dto with HTML clipboard format
cfHTMLFormat := Clipboard.FindFormatID('HTML Format');
if cfHTMLFormat = 0 then
cfHTMLFormat := RegisterClipboardFormat('HTML Format');
// dto with CSV clipboard format
cfCSVFormat := Clipboard.FindFormatID('CSV');
if cfCSVFormat = 0 then
@ -1184,6 +1190,10 @@ begin
FWorkbook.CopyToClipboardStream(stream, sfExcel5);
Clipboard.AddFormat(cfBiff5Format, stream);
// Then write HTML format
FWorkbook.CopyToClipboardStream(stream, sfHTML);
Clipboard.AddFormat(cfHTMLFormat, stream);
// Then write CSV format
csv := CSVParams;
CsvParams.Delimiter := ';';
@ -1198,7 +1208,7 @@ begin
Clipboard.AddFormat(CF_TEXT, stream);
CSVParams := csv;
// To do: HTML format, XML format
// To do: XML format
// I don't know which format is written by xlsx and ods natively.
finally
stream.Free;