You've already forked lazarus-ccr
fpspreadsheet: Move hyperlinkdemo to "others" folder. Make sure that "other" demos write their output in the project directory.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7995 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@@ -0,0 +1,74 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
<CompatibilityMode Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="collectlinks"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="1">
|
||||
<Mode0 Name="default"/>
|
||||
</Modes>
|
||||
</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>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
</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,173 @@
|
||||
{ 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;
|
||||
dir: String;
|
||||
|
||||
begin
|
||||
// Just for the demo: create the file "source.xls". It contains hyperlinks to
|
||||
// some of the "test" files created in the XXXXdemo projects
|
||||
Write('Creating source workbook...');
|
||||
dir := ExtractFilePath(ParamStr(0));
|
||||
|
||||
srcWorkbook := TsWorkbook.Create;
|
||||
try
|
||||
sheet := srcWorkbook.AddWorksheet('Sheet');
|
||||
|
||||
sheet.WriteText(0, 0, 'Link to biff8 test file');
|
||||
sheet.WriteHyperlink(0, 0, '../../read_write/excel8demo/test.xls#''My Worksheet 2''!A1');
|
||||
//sheet.WriteHyperlink(0, 0, '../excel8demo/test.xls#''Meu Relatório''!A1');
|
||||
|
||||
sheet.WriteText(1, 0, 'Link to ods test file');
|
||||
sheet.WriteHyperlink(1, 0, '../../read_write/opendocdemo/test.ods');
|
||||
|
||||
sheet.WriteText(2, 0, 'E-Mail Link');
|
||||
sheet.WriteHyperlink(2, 0, 'mailto:someone@mail.com;someoneelse@mail.com?Subject=This is a test');
|
||||
|
||||
sheet.WriteText(3, 0, 'Web-Hyperlink');
|
||||
sheet.WriteHyperlink(3, 0, 'http://www.lazarus-ide.org/');
|
||||
|
||||
sheet.WriteText(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.WriteText(5, 0, 'Jump to A10');
|
||||
sheet.WriteHyperlink(5, 0, '#A10');
|
||||
|
||||
sheet.WriteColWidth(0, 40, suChars);
|
||||
|
||||
srcWorkbook.WriteToFile(dir + 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(dir + 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;
|
||||
// Copy linked worksheet to new sheet in destination workbook
|
||||
destSheet := destWorkbook.CopyWorksheetFrom(linkedSheet, true);
|
||||
// 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(dir + destFile+'.xls', true);
|
||||
destworkbook.WriteToFile(dir + destFile+'.xlsx', true);
|
||||
destworkbook.WriteToFile(dir + destFile+'.ods', true);
|
||||
WriteLn('All hyperlinks to spreadsheets are collected in files ' + destFile + '.*');
|
||||
end else
|
||||
WriteLn('No hyperlinks found.');
|
||||
|
||||
finally
|
||||
// Clean up
|
||||
srcWorkbook.Free;
|
||||
if destWorkbook <> nil then destWorkbook.Free;
|
||||
end;
|
||||
|
||||
if ParamCount = 0 then
|
||||
begin
|
||||
{$IFDEF MSWindows}
|
||||
WriteLn;
|
||||
WriteLn('Press ENTER to close...');
|
||||
ReadLn;
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
end.
|
||||
|
@@ -0,0 +1,5 @@
|
||||
This sample project demonstrates how 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 ../excel8demo/excel8write
|
||||
before running this project in order to generate required spreadsheet files.
|
Reference in New Issue
Block a user