You've already forked lazarus-ccr
fpspreadsheet: Add demo hyperlinkdemo which collects the sheets of linked workbooks to a new workbook
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4035 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -0,0 +1,70 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="collectlinks"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="laz_fpspreadsheet"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="collectlinks.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="collectlinks"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
@ -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.
|
||||
|
||||
@ -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.
|
||||
@ -118,13 +118,6 @@
|
||||
<CodeGeneration>
|
||||
<SmartLinkUnit Value="True"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
|
||||
@ -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]);
|
||||
|
||||
@ -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));
|
||||
|
||||
@ -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;
|
||||
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
|
||||
Reference in New Issue
Block a user