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) TsHTMLWriter = class(TsCustomSpreadWriter)
private private
FPointSeparatorSettings: TFormatSettings; FPointSeparatorSettings: TFormatSettings;
FClipboardMode: Boolean;
FStartHtmlPos: Int64;
FEndHtmlPos: Int64;
FStartFragmentPos: Int64;
FEndFragmentPos: Int64;
function CellFormatAsString(AFormat: PsCellFormat; ATagName: String): String; function CellFormatAsString(AFormat: PsCellFormat; ATagName: String): String;
function GetBackgroundAsStyle(AFill: TsFillPattern): String; function GetBackgroundAsStyle(AFill: TsFillPattern): String;
function GetBorderAsStyle(ABorder: TsCellBorders; const ABorderStyles: TsCellBorderStyles): String; function GetBorderAsStyle(ABorder: TsCellBorders; const ABorderStyles: TsCellBorderStyles): String;
@@ -100,6 +105,7 @@ type
public public
constructor Create(AWorkbook: TsWorkbook); override; constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override; destructor Destroy; override;
procedure WriteToClipboardStream(AStream: TStream); override;
procedure WriteToStream(AStream: TStream); override; procedure WriteToStream(AStream: TStream); override;
procedure WriteToStrings(AStrings: TStrings); override; procedure WriteToStrings(AStrings: TStrings); override;
end; end;
@@ -137,6 +143,16 @@ uses
const const
MIN_FONTSIZE = 6; 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 } { TsHTMLReader }
{==============================================================================} {==============================================================================}
@@ -1458,7 +1474,7 @@ var
begin begin
AppendToStream(AStream, AppendToStream(AStream,
'<body>'); '<body>');
if HTMLParams.SheetIndex < 0 then // active sheet if FClipboardMode or (HTMLParams.SheetIndex < 0) then // active sheet
begin begin
if FWorkbook.ActiveWorksheet = nil then if FWorkbook.ActiveWorksheet = nil then
FWorkbook.SelectWorksheet(FWorkbook.GetWorksheetByIndex(0)); FWorkbook.SelectWorksheet(FWorkbook.GetWorksheetByIndex(0));
@@ -1640,22 +1656,6 @@ begin
'<div>' + s + '</div>'); '<div>' + s + '</div>');
end; 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); procedure TsHTMLWriter.WriteStyles(AStream: TStream);
var var
i: Integer; i: Integer;
@@ -1675,6 +1675,41 @@ begin
'</style>' + LineEnding); '</style>' + LineEnding);
end; 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); procedure TsHTMLWriter.WriteToStrings(AStrings: TStrings);
var var
Stream: TStream; Stream: TStream;
@@ -1732,6 +1767,12 @@ begin
'<div>' + LineEnding + '<div>' + LineEnding +
'<table style="' + style + '">' + LineEnding); '<table style="' + style + '">' + LineEnding);
if FClipboardMode then
begin
AppendToStream(AStream, START_FRAGMENT);
FStartFragmentPos := AStream.Position;
end;
if HTMLParams.ShowRowColHeaders then if HTMLParams.ShowRowColHeaders then
begin begin
// width of row-header column // width of row-header column
@@ -1838,6 +1879,13 @@ begin
AppendToStream(AStream, AppendToStream(AStream,
'</tr>' + LineEnding); '</tr>' + LineEnding);
end; end;
if FClipboardMode then
begin
AppendToStream(AStream, END_FRAGMENT);
FEndFragmentPos := AStream.Position;
end;
AppendToStream(AStream, AppendToStream(AStream,
'</table>' + LineEnding + '</table>' + LineEnding +
'</div>'); '</div>');
@@ -1845,7 +1893,7 @@ end;
initialization initialization
InitFormatSettings(HTMLParams.FormatSettings); InitFormatSettings(HTMLParams.FormatSettings);
RegisterSpreadFormat(TsHTMLReader, TsHTMLWriter, sfHTML); RegisterSpreadFormat(TsHTMLReader, TsHTMLWriter, sfHTML, false, true);
end. end.

12
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

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