diff --git a/components/fpspreadsheet/examples/read_write/hyperlinkdemo/collectlinks.lpi b/components/fpspreadsheet/examples/read_write/hyperlinkdemo/collectlinks.lpi
new file mode 100644
index 000000000..2c4753a61
--- /dev/null
+++ b/components/fpspreadsheet/examples/read_write/hyperlinkdemo/collectlinks.lpi
@@ -0,0 +1,70 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/fpspreadsheet/examples/read_write/hyperlinkdemo/collectlinks.lpr b/components/fpspreadsheet/examples/read_write/hyperlinkdemo/collectlinks.lpr
new file mode 100644
index 000000000..74282ee6a
--- /dev/null
+++ b/components/fpspreadsheet/examples/read_write/hyperlinkdemo/collectlinks.lpr
@@ -0,0 +1,165 @@
+{ This program seeks all spreadsheet hyperlinks in the file "source.xls" and
+ adds the linked worksheet to a new workbook. }
+
+program collectlinks;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, SysUtils, uriParser,
+ fpstypes, fpspreadsheet, fpsUtils, fpsAllFormats
+ { you can add units after this };
+
+const
+ srcFile = 'source.ods';
+ destFile = 'result';
+
+var
+ srcWorkbook, destWorkbook, linkedWorkbook: TsWorkbook;
+ sheet, linkedSheet, destSheet: TsWorksheet;
+ cell: PCell;
+ hyperlink: PsHyperlink;
+ u: TURI;
+ fn: String; // Name of linked file
+ bookmark: String; // Bookmark of hyperlink
+ sheetFormat: TsSpreadsheetFormat;
+ sheetName: String;
+ r, c: Cardinal;
+
+begin
+ // Just for the demo: create the file "source.xls". It contains hyperlinks to
+ // some the "test" files created in the XXXXdemo projects
+ Write('Creating source workbook...');
+ srcWorkbook := TsWorkbook.Create;
+ try
+ sheet := srcWorkbook.AddWorksheet('Sheet');
+
+ sheet.WriteUTF8Text(0, 0, 'Link to biff8 test file');
+ sheet.WriteHyperlink(0, 0, '../excel8demo/test.xls#''My Worksheet 2''!A1');
+ //sheet.WriteHyperlink(0, 0, '../excel8demo/test.xls#''Meu Relatório''!A1');
+
+ sheet.WriteUTF8Text(1, 0, 'Link to ods test file');
+ sheet.WriteHyperlink(1, 0, '..\opendocdemo\test.ods');
+
+ sheet.WriteUTF8Text(2, 0, 'E-Mail Link');
+ sheet.WriteHyperlink(2, 0, 'mailto:someone@mail.com;someoneelse@mail.com?Subject=This is a test');
+
+ sheet.WriteUTF8Text(3, 0, 'Web-Hyperlink');
+ sheet.WriteHyperlink(3, 0, 'http://www.lazarus-ide.org/');
+
+ sheet.WriteUTF8Text(4, 0, 'File-Link (absolute path)');
+ sheet.WriteHyperlink(4, 0, 'file:///'+ExpandFilename('..\..\..\tests\testooxml_1899.xlsx'));
+ // This creates the URI such as "file:///D:\Prog_Lazarus\svn\lazarus-ccr\components\fpspreadsheet\tests\testooxml_1899.xlsx"
+ // but makes sure that the file exists on your system.
+
+ sheet.WriteUTF8Text(5, 0, 'Jump to A10');
+ sheet.WriteHyperlink(5, 0, '#A10');
+
+ sheet.WriteColWidth(0, 40);
+
+ srcWorkbook.WriteToFile(srcFile, true);
+ finally
+ srcWorkbook.Free;
+ end;
+ WriteLn('Done.');
+
+ // Prepare destination workbook
+ destWorkbook := nil;
+
+ // Now open the source file and seek hyperlinks
+ Write('Reading source workbook, sheet ');
+ srcWorkbook := TsWorkbook.Create;
+ try
+ srcWorkbook.ReadFromFile(srcFile);
+ sheet := srcWorkbook.GetWorksheetByIndex(0);
+ WriteLn(sheet.Name, '...');
+
+ for cell in sheet.Cells do
+ begin
+ hyperlink := sheet.FindHyperlink(cell);
+ if (hyperlink <> nil) then // Ignore cells without hyperlink
+ begin
+ WriteLn;
+ WriteLn('Cell ', GetCellString(cell^.Row, cell^.Col), ':');
+ WriteLn(' Hyperlink "', hyperlink^.Target, '"');
+ if (hyperlink^.Target[1] = '#') then
+ WriteLn(' Ignoring internal hyperlink')
+ else
+ begin
+ u := ParseURI(hyperlink^.Target);
+ if u.Protocol = '' then begin
+ Write(' Local file (relative path)');
+ SplitHyperlink(hyperlink^.Target, fn, bookmark)
+ end else
+ if URIToFileName(hyperlink^.Target, fn) then
+ Write(' File (absolute path)')
+ else
+ begin
+ WriteLn(' Ignoring protocol "', u.Protocol, '"');
+ continue; // Ignore http, mailto etc.
+ end;
+
+ if not FileExists(fn) then
+ WriteLn(' does not exist.')
+ else
+ if GetFormatFromFileName(fn, sheetFormat) then
+ begin
+ Write(' supported. ');
+ // Create destination workbook if not yet done so far...
+ if destWorkbook = nil then
+ destWorkbook := TsWorkbook.Create;
+ // Open linked workbook
+ linkedworkbook := TsWorkbook.Create;
+ try
+ linkedworkbook.ReadFromFile(fn, sheetFormat);
+ // Get linked worksheet
+ if bookmark = '' then
+ linkedSheet := linkedWorkbook.GetWorksheetByIndex(0)
+ else
+ if not linkedWorkbook.TryStrToCell(bookmark, linkedsheet, r, c)
+ then begin
+ WriteLn('Failure finding linked worksheet.');
+ continue;
+ end;
+// linkedSheet := linkedWorkbook.GetWorksheetByName(bookmark);
+ // Copy linked worksheet to new sheet in destination workbook
+ destSheet := destWorkbook.CopyWorksheetFrom(linkedSheet);
+ // Create sheet name
+ sheetName := ExtractFileName(fn) + '#' +linkedSheet.Name;
+ destWorkbook.ValidWorksheetName(sheetName, true);
+ destSheet.Name := sheetName;
+ // Done
+ WriteLn(' Copied.');
+ finally
+ linkedworkbook.Free;
+ end;
+ end;
+ end;
+ end;
+ end;
+
+ // Save destination workbook
+ WriteLn;
+ if destWorkbook <> nil then
+ begin
+ destworkbook.WriteToFile(destFile+'.xls', true);
+ destworkbook.WriteToFile(destFile+'.xlsx', true);
+ destworkbook.WriteToFile(destFile+'.ods', true);
+ WriteLn('All hyperlinks to spreadsheets are collected in files ' + destFile + '.*');
+ end else
+ WriteLn('No hyperlinks found.');
+
+ WriteLn('Press ENTER to close...');
+ ReadLn;
+
+ finally
+ // Clean up
+ srcWorkbook.Free;
+ if destWorkbook <> nil then destWorkbook.Free;
+ end;
+
+end.
+
diff --git a/components/fpspreadsheet/examples/read_write/hyperlinkdemo/readme.txt b/components/fpspreadsheet/examples/read_write/hyperlinkdemo/readme.txt
new file mode 100644
index 000000000..dd661beee
--- /dev/null
+++ b/components/fpspreadsheet/examples/read_write/hyperlinkdemo/readme.txt
@@ -0,0 +1,5 @@
+This sample project demonstrates how to use fpspreadsheet can follow the hyperlinks
+to other spreadsheet files and copy the linked sheets to a new document.
+
+Please run the write demos ooxmldemo/ooxmlwrite and excel8demp/excel8write before
+running this project in order to generate required spreadsheet files.
diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/demo_ctrls.lpi b/components/fpspreadsheet/examples/visual/fpsctrls/demo_ctrls.lpi
index 53dfe47c9..5ecfcbcf8 100644
--- a/components/fpspreadsheet/examples/visual/fpsctrls/demo_ctrls.lpi
+++ b/components/fpspreadsheet/examples/visual/fpsctrls/demo_ctrls.lpi
@@ -118,13 +118,6 @@
-
-
-
-
-
-
-
diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas
index c83c8f038..99d4245f2 100755
--- a/components/fpspreadsheet/fpsopendocument.pas
+++ b/components/fpspreadsheet/fpsopendocument.pas
@@ -3751,6 +3751,8 @@ begin
fnt := Workbook.GetFont(AFormat.FontIndex);
defFnt := Workbook.GetDefaultfont;
+ if fnt = nil then
+ fnt := defFnt;
if fnt.FontName <> defFnt.FontName then
Result := Result + Format('style:font-name="%s" ', [fnt.FontName]);
diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas
index 1e311b764..da15a0c22 100755
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -911,6 +911,8 @@ var
sourceSheet, destSheet: TsWorksheet;
fmt: TsCellFormat;
font: TsFont;
+ clr: TsColorvalue;
+ cb: TsCellBorder;
begin
Assert(AFromCell <> nil);
Assert(AToCell <> nil);
@@ -921,8 +923,27 @@ begin
else
begin
fmt := sourceSheet.ReadCellFormat(AFromCell);
- font := sourceSheet.ReadCellFont(AFromCell);
- fmt.FontIndex := destSheet.WriteFont(AToCell, font.FontName, font.Size, font.Style, font.Color);
+ destSheet.WriteCellFormat(AToCell, fmt);
+ if (uffBackground in fmt.UsedFormattingFields) then
+ begin
+ clr := sourceSheet.Workbook.GetPaletteColor(fmt.Background.BgColor);
+ fmt.Background.BgColor := destSheet.Workbook.AddColorToPalette(clr);
+ clr := sourceSheet.Workbook.GetPaletteColor(fmt.Background.FgColor);
+ fmt.Background.FgColor := destSheet.Workbook.AddColorToPalette(clr);
+ end;
+ if (uffFont in fmt.UsedFormattingFields) then
+ begin
+ font := sourceSheet.ReadCellFont(AFromCell);
+ clr := sourceSheet.Workbook.GetPaletteColor(font.Color);
+ font.Color := destSheet.Workbook.AddColorToPalette(clr);
+ fmt.FontIndex := destSheet.WriteFont(AToCell, font.FontName, font.Size, font.Style, font.Color);
+ end;
+ if (uffBorder in fmt.UsedFormattingFields) then
+ for cb in fmt.Border do
+ begin
+ clr := sourceSheet.Workbook.GetPaletteColor(fmt.BorderStyles[cb].Color);
+ fmt.BorderStyles[cb].Color := destSheet.Workbook.AddColorToPalette(clr);
+ end;
destSheet.WriteCellFormat(AToCell, fmt);
end;
end;
@@ -7016,6 +7037,7 @@ function TsWorkbook.TryStrToCellRanges(AText: String; out AWorksheet: TsWorkshee
var
i: Integer;
L: TStrings;
+ sheetname: String;
begin
Result := false;
AWorksheet := nil;
@@ -7028,7 +7050,12 @@ begin
if i = 0 then
AWorksheet := FActiveWorksheet
else begin
- AWorksheet := GetWorksheetByName(Copy(AText, 1, i-1));
+ sheetname := Copy(AText, 1, i-1);
+ if (sheetname <> '') and (sheetname[1] = '''') then
+ Delete(sheetname, 1, 1);
+ if (sheetname <> '') and (sheetname[Length(sheetname)] = '''') then
+ Delete(sheetname, Length(sheetname), 1);
+ AWorksheet := GetWorksheetByName(sheetname);
if AWorksheet = nil then
exit;
AText := Copy(AText, i+1, Length(AText));
diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas
index 4110ba033..740db3d04 100644
--- a/components/fpspreadsheet/fpsutils.pas
+++ b/components/fpspreadsheet/fpsutils.pas
@@ -2112,9 +2112,8 @@ procedure FixHyperlinkPathDelims(var ATarget: String);
var
i: Integer;
begin
- if pos('file:', ATarget) = 1 then
- for i:=1 to Length(ATarget) do
- if ATarget[i] = '\' then ATarget[i] := '/';
+ for i:=1 to Length(ATarget) do
+ if ATarget[i] = '\' then ATarget[i] := '/';
end;
{@@ ----------------------------------------------------------------------------