You've already forked lazarus-ccr
fpspreadsheet: read hyperlinks from xlsx files
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3957 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@ -407,7 +407,7 @@ end;
|
||||
procedure TMainForm.WorksheetGridClickHyperlink(Sender: TObject;
|
||||
const AHyperlink: TsHyperlink);
|
||||
begin
|
||||
ShowMessage('Hyperlink ' + AHyperlink.Destination + ' clicked');
|
||||
ShowMessage('Hyperlink ' + AHyperlink.Target + ' clicked');
|
||||
end;
|
||||
|
||||
procedure TMainForm.UpdateCaption;
|
||||
|
||||
@ -489,9 +489,9 @@ type
|
||||
function ReadHyperlink(ACell: PCell): TsHyperlink;
|
||||
procedure RemoveHyperlink(ACell: PCell; AKeepText: Boolean);
|
||||
function WriteHyperlink(ARow, ACol: Cardinal; AKind: TsHyperlinkKind;
|
||||
ADestination: String; ADisplayText: String = ''; ANote: String = ''): PCell; overload;
|
||||
ATarget: String; ADisplayText: String = ''; ATooltip: String = ''): PCell; overload;
|
||||
procedure WriteHyperlink(ACell: PCell; AKind: TsHyperlinkKind;
|
||||
ADestination: String; ADisplayText: String = ''; ANote: String = ''); overload;
|
||||
ATarget: String; ADisplayText: String = ''; ATooltip: String = ''); overload;
|
||||
|
||||
{ Merged cells }
|
||||
procedure MergeCells(ARow1, ACol1, ARow2, ACol2: Cardinal); overload;
|
||||
@ -1875,8 +1875,8 @@ begin
|
||||
else
|
||||
begin
|
||||
Result.Kind := hkNone;
|
||||
Result.Destination := '';
|
||||
Result.Note := '';
|
||||
Result.Target := '';
|
||||
Result.Tooltip := '';
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1912,17 +1912,17 @@ end;
|
||||
@param ARow Row index of the cell considered
|
||||
@param ACol Column index of the cell considered
|
||||
@param AKind Hyperlink type (to cell, external file, URL)
|
||||
@param ADestination Depending on AKind: cell address, filename, or URL
|
||||
@param ATarget Depending on AKind: cell address, filename, or URL
|
||||
if empty the hyperlink is removed from the cell.
|
||||
@param ADisplayText Text shown in cell. If empty the destination is shown
|
||||
@param ANote Text for popup hint used by Excel
|
||||
@param ATooltip Text for popup tooltip hint used by Excel
|
||||
@return Pointer to the cell with the hyperlink
|
||||
-------------------------------------------------------------------------------}
|
||||
function TsWorksheet.WriteHyperlink(ARow, ACol: Cardinal; AKind: TsHyperlinkKind;
|
||||
ADestination: String; ADisplayText: String = ''; ANote: String = ''): PCell;
|
||||
ATarget: String; ADisplayText: String = ''; ATooltip: String = ''): PCell;
|
||||
begin
|
||||
Result := GetCell(ARow, ACol);
|
||||
WriteHyperlink(Result, AKind, ADestination, ADisplayText, ANote);
|
||||
WriteHyperlink(Result, AKind, ATarget, ADisplayText, ATooltip);
|
||||
end;
|
||||
|
||||
{@@ ----------------------------------------------------------------------------
|
||||
@ -1930,13 +1930,13 @@ end;
|
||||
|
||||
@param ACell Pointer to the cell considered
|
||||
@param AKind Hyperlink type (to cell, external file, URL)
|
||||
@param ADestination Depending on AKind: cell address, filename, or URL
|
||||
@param ATarget Depending on AKind: cell address, filename, or URL
|
||||
if empty the hyperlink is removed from the cell.
|
||||
@param ADisplayText Text shown in cell. If empty the destination is shown
|
||||
@param ANote Text for popup hint used by Excel
|
||||
@param ATooltip Text for popup tooltip hint used by Excel
|
||||
-------------------------------------------------------------------------------}
|
||||
procedure TsWorksheet.WriteHyperlink(ACell: PCell; AKind: TsHyperlinkKind;
|
||||
ADestination: String; ADisplayText: String = ''; ANote: String = '');
|
||||
ATarget: String; ADisplayText: String = ''; ATooltip: String = '');
|
||||
var
|
||||
hyperlink: PsHyperlink;
|
||||
addNew: Boolean;
|
||||
@ -1949,7 +1949,7 @@ begin
|
||||
col := ACell^.Col;
|
||||
|
||||
// Remove the hyperlink if an empty destination is passed
|
||||
if ADestination = '' then
|
||||
if ATarget = '' then
|
||||
RemoveHyperlink(ACell, false)
|
||||
else
|
||||
begin
|
||||
@ -1959,15 +1959,15 @@ begin
|
||||
hyperlink^.Row := row;
|
||||
hyperlink^.Col := col;
|
||||
hyperlink^.Kind := AKind;
|
||||
hyperlink^.Destination := ADestination;
|
||||
hyperlink^.Note := ANote;
|
||||
hyperlink^.Target := ATarget;
|
||||
hyperlink^.Tooltip := ATooltip;
|
||||
if addNew then FHyperlinks.Add(hyperlink);
|
||||
|
||||
ACell^.ContentType := cctHyperlink;
|
||||
if ADisplayText <> '' then
|
||||
ACell^.UTF8StringValue := ADisplayText
|
||||
else
|
||||
ACell^.UTF8StringValue := ADestination;
|
||||
ACell^.UTF8StringValue := ATarget;
|
||||
end;
|
||||
|
||||
ChangedCell(row, col);
|
||||
|
||||
@ -2687,8 +2687,9 @@ begin
|
||||
begin
|
||||
AStrings.Add(Format('UTF8StringValue=%s', [ACell^.UTF8StringValue]));
|
||||
hyperlink := Worksheet.FindHyperlink(ACell);
|
||||
if hyperlink <> nil then begin
|
||||
s := hyperlink^.Destination;
|
||||
if hyperlink <> nil then
|
||||
begin
|
||||
s := hyperlink^.Target;
|
||||
case hyperlink^.Kind of
|
||||
hkNone: s := s + ' <error>';
|
||||
hkCell: s := s + ' (internal cell reference)';
|
||||
|
||||
@ -2173,8 +2173,8 @@ begin
|
||||
hkNone:
|
||||
; // nothing to do
|
||||
hkCell:
|
||||
// Goes to a cell
|
||||
if ParseSheetCellString(hyperlink.Destination, sheetname, r, c) then
|
||||
// Goes to a cell (unlike Excel, we don't support range here)
|
||||
if ParseSheetCellString(hyperlink.Target, sheetname, r, c) then
|
||||
begin
|
||||
if sheetname <> '' then
|
||||
begin
|
||||
@ -2185,7 +2185,7 @@ begin
|
||||
end;
|
||||
Worksheet.SelectCell(r, c);
|
||||
end else
|
||||
raise Exception.CreateFmt('"%s" is not a valid cell string.', [hyperlink.Destination]);
|
||||
raise Exception.CreateFmt(rsHyperlinkNotAValidCell, [hyperlink.Target]);
|
||||
else
|
||||
// Fires the OnClickHyperlink event which should open a file or a URL
|
||||
if Assigned(FOnClickHyperlink) then FOnClickHyperlink(self, hyperlink);
|
||||
|
||||
@ -54,6 +54,7 @@ resourcestring
|
||||
rsIndexInSSTOutOfRange = 'Index %d in SST out of range (0-%d).';
|
||||
rsAmbiguousDecThouSeparator = 'Assuming usage of decimal separator in "%s".';
|
||||
rsCodePageNotSupported = 'Code page "%s" is not supported. Using "cp1252" (Latin 1) instead.';
|
||||
rsHyperlinkNotAValidCell = 'Hyperlink target "%s" is not a valid cell address.';
|
||||
|
||||
|
||||
rsTRUE = 'TRUE'; // wp: Do we really want to translate these strings?
|
||||
|
||||
@ -154,13 +154,13 @@ type
|
||||
@param Kind Specifies whether clicking on the hyperlink results in
|
||||
jumping the a cell address within the current workbook,
|
||||
opens a file, or opens a URL
|
||||
@param Destination Hyperlink (cell address, filename, URL)
|
||||
@param Target Target of hyperlink (cell address, filename, URL)
|
||||
@param Note Text displayed as a popup hint by Excel }
|
||||
TsHyperlink = record
|
||||
Row, Col: Cardinal;
|
||||
Kind: TsHyperlinkKind;
|
||||
Destination: String;
|
||||
Note: String;
|
||||
Target: String;
|
||||
Tooltip: String;
|
||||
end;
|
||||
|
||||
{@@ Pointer to a TsHyperlink record }
|
||||
|
||||
@ -64,9 +64,12 @@ type
|
||||
FSharedStrings: TStringList;
|
||||
FFillList: TFPList;
|
||||
FBorderList: TFPList;
|
||||
FHyperlinkList: TFPList;
|
||||
FThemeColors: array of TsColorValue;
|
||||
FSharedFormulas: TStringList;
|
||||
FWrittenByFPS: Boolean;
|
||||
procedure ApplyCellFormatting(ACell: PCell; XfIndex: Integer);
|
||||
procedure ApplyHyperlinks(AWorksheet: TsWorksheet);
|
||||
function FindCommentsFileName(ANode: TDOMNode): String;
|
||||
procedure ReadBorders(ANode: TDOMNode);
|
||||
procedure ReadCell(ANode: TDOMNode; AWorksheet: TsWorksheet);
|
||||
@ -79,6 +82,7 @@ type
|
||||
procedure ReadFills(ANode: TDOMNode);
|
||||
procedure ReadFont(ANode: TDOMNode);
|
||||
procedure ReadFonts(ANode: TDOMNode);
|
||||
procedure ReadHyperlinks(ANode: TDOMNode; AWorksheet: TsWorksheet);
|
||||
procedure ReadMergedCells(ANode: TDOMNode; AWorksheet: TsWorksheet);
|
||||
procedure ReadNumFormats(ANode: TDOMNode);
|
||||
procedure ReadPalette(ANode: TDOMNode);
|
||||
@ -91,7 +95,6 @@ type
|
||||
procedure ReadThemeColors(ANode: TDOMNode);
|
||||
procedure ReadWorksheet(ANode: TDOMNode; AWorksheet: TsWorksheet);
|
||||
protected
|
||||
procedure ApplyCellFormatting(ACell: PCell; XfIndex: Integer);
|
||||
procedure CreateNumFormatList; override;
|
||||
public
|
||||
constructor Create(AWorkbook: TsWorkbook); override;
|
||||
@ -226,6 +229,7 @@ const
|
||||
SCHEMAS_STRINGS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/sharedStrings';
|
||||
SCHEMAS_COMMENTS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments';
|
||||
SCHEMAS_DRAWINGS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/vmlDrawing';
|
||||
SCHEMAS_HYPERLINKS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink';
|
||||
SCHEMAS_SPREADML = 'http://schemas.openxmlformats.org/spreadsheetml/2006/main';
|
||||
|
||||
{ OOXML mime types constants }
|
||||
@ -328,6 +332,15 @@ type
|
||||
BorderStyles: TsCellBorderStyles;
|
||||
end;
|
||||
|
||||
THyperlinkListData = class
|
||||
ID: String;
|
||||
CellRef: String;
|
||||
Kind: TsHyperlinkKind;
|
||||
Location: String;
|
||||
Display: String;
|
||||
Tooltip: String;
|
||||
end;
|
||||
|
||||
const
|
||||
PATTERN_TYPES: array [TsFillStyle] of string = (
|
||||
'none', // fsNoFill
|
||||
@ -439,10 +452,10 @@ begin
|
||||
Workbook.UseDefaultPalette;
|
||||
|
||||
FSharedFormulas := TStringList.Create;
|
||||
|
||||
FSharedStrings := TStringList.Create;
|
||||
FFillList := TFPList.Create;
|
||||
FBorderList := TFPList.Create;
|
||||
FHyperlinkList := TFPList.Create;
|
||||
FCellFormatList := TsCellFormatList.Create(true);
|
||||
// Allow duplicates because xf indexes used in cell records cannot be found any more.
|
||||
|
||||
@ -460,8 +473,12 @@ begin
|
||||
for j := FBorderList.Count-1 downto 0 do TObject(FBorderList[j]).Free;
|
||||
FBorderList.Free;
|
||||
|
||||
for j := FHyperlinkList.Count-1 downto 0 do TObject(FHyperlinkList[j]).Free;
|
||||
FHyperlinkList.Free;
|
||||
|
||||
FSharedStrings.Free;
|
||||
FSharedFormulas.Free;
|
||||
// FCellFormatList is destroyed by ancestor
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
@ -478,6 +495,30 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TsSpreadOOXMLReader.ApplyHyperlinks(AWorksheet: TsWorksheet);
|
||||
var
|
||||
i: Integer;
|
||||
hyperlinkData: THyperlinkListData;
|
||||
r1, c1, r2, c2, r, c: Cardinal;
|
||||
begin
|
||||
for i:=0 to FHyperlinkList.Count-1 do
|
||||
begin
|
||||
hyperlinkData := THyperlinkListData(FHyperlinkList.Items[i]);
|
||||
if pos(':', hyperlinkdata.CellRef) = 0 then
|
||||
begin
|
||||
ParseCellString(hyperlinkData.CellRef, r1, c1);
|
||||
r2 := r1;
|
||||
c2 := c1;
|
||||
end else
|
||||
ParseCellRangeString(hyperlinkData.CellRef, r1, c1, r2, c2);
|
||||
|
||||
for r := r1 to r2 do
|
||||
for c := c1 to c2 do
|
||||
with hyperlinkData do
|
||||
AWorksheet.WriteHyperlink(r, c, Kind, Location, Display, ToolTip);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TsSpreadOOXMLReader.FindCommentsFileName(ANode: TDOMNode): String;
|
||||
var
|
||||
s: String;
|
||||
@ -1187,6 +1228,88 @@ begin
|
||||
FWorkbook.DeleteFont(4);
|
||||
end;
|
||||
|
||||
procedure TsSpreadOOXMLReader.ReadHyperlinks(ANode: TDOMNode;
|
||||
AWorksheet: TsWorksheet);
|
||||
var
|
||||
node: TDOMNode;
|
||||
nodeName: String;
|
||||
hyperlinkData: THyperlinkListData;
|
||||
s: String;
|
||||
|
||||
function FindHyperlinkID(ID: String): THyperlinkListData;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to FHyperlinkList.Count-1 do
|
||||
if THyperlinkListData(FHyperlinkList.Items[i]).ID = ID then
|
||||
begin
|
||||
Result := THyperlinkListData(FHyperlinkList.Items[i]);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
if Assigned(ANode) then begin
|
||||
nodename := ANode.NodeName;
|
||||
if nodename = 'hyperlinks' then
|
||||
begin
|
||||
node := ANode.FirstChild;
|
||||
while Assigned(node) do
|
||||
begin
|
||||
nodename := node.NodeName;
|
||||
if nodename = 'hyperlink' then begin
|
||||
hyperlinkData := THyperlinkListData.Create;
|
||||
hyperlinkData.CellRef := GetAttrValue(node, 'ref');
|
||||
hyperlinkData.ID := GetAttrValue(node, 'r:id');
|
||||
hyperlinkData.Location := GetAttrValue(node, 'location');
|
||||
hyperlinkData.Display := GetAttrValue(node, 'display');
|
||||
hyperlinkData.Tooltip := GetAttrValue(node, 'tooltip');
|
||||
hyperlinkData.Kind := hkCell;
|
||||
end;
|
||||
FHyperlinkList.Add(hyperlinkData);
|
||||
node := node.NextSibling;
|
||||
end;
|
||||
end else
|
||||
if nodename = 'Relationship' then
|
||||
begin
|
||||
node := ANode;
|
||||
while Assigned(node) do
|
||||
begin
|
||||
nodename := node.NodeName;
|
||||
if nodename = 'Relationship' then
|
||||
begin
|
||||
s := GetAttrValue(node, 'Type');
|
||||
if s = SCHEMAS_HYPERLINKS then
|
||||
begin
|
||||
s := GetAttrValue(node, 'Id');
|
||||
if s <> '' then
|
||||
begin
|
||||
hyperlinkData := FindHyperlinkID(s);
|
||||
if hyperlinkData <> nil then begin
|
||||
s := GetAttrValue(node, 'Target');
|
||||
if s <> '' then hyperlinkData.Location := s;
|
||||
s := GetAttrValue(node, 'TargetMode');
|
||||
if s = 'External' then
|
||||
begin
|
||||
if (pos('http:', hyperlinkdata.Location) = 1) or
|
||||
(pos('mailto:', hyperlinkData.Location) = 1) or
|
||||
(pos('file:', hyperlinkData.Location) = 1) or
|
||||
(pos('ftp:', hyperlinkdata.Location) = 1)
|
||||
then
|
||||
hyperlinkData.Kind := hkURL
|
||||
else
|
||||
hyperlinkData.Kind := hkFile;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
node := node.NextSibling;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TsSpreadOOXMLReader.ReadMergedCells(ANode: TDOMNode;
|
||||
AWorksheet: TsWorksheet);
|
||||
var
|
||||
@ -1494,6 +1617,7 @@ procedure TsSpreadOOXMLReader.ReadWorksheet(ANode: TDOMNode; AWorksheet: TsWorks
|
||||
var
|
||||
rownode: TDOMNode;
|
||||
cellnode: TDOMNode;
|
||||
nodename: String;
|
||||
begin
|
||||
rownode := ANode.FirstChild;
|
||||
while Assigned(rownode) do begin
|
||||
@ -1521,6 +1645,7 @@ var
|
||||
SheetList: TStringList;
|
||||
i: Integer;
|
||||
fn: String;
|
||||
fn_sheetxmlrels: String;
|
||||
begin
|
||||
//unzip "content.xml" of "AFileName" to folder "FilePath"
|
||||
FilePath := GetTempDir(false);
|
||||
@ -1597,13 +1722,15 @@ begin
|
||||
ReadCols(Doc.DocumentElement.FindNode('cols'), FWorksheet);
|
||||
ReadWorksheet(Doc.DocumentElement.FindNode('sheetData'), FWorksheet);
|
||||
ReadMergedCells(Doc.DocumentElement.FindNode('mergeCells'), FWorksheet);
|
||||
ReadHyperlinks(Doc.DocumentElement.FindNode('hyperlinks'), FWorksheet);
|
||||
|
||||
FreeAndNil(Doc);
|
||||
|
||||
// Comments:
|
||||
// The comments are stored in separate "comments<n>.xml" files (n = 1, 2, ...)
|
||||
// The relationship which comment belongs to which sheet file must be
|
||||
// retrieved from the "sheet<n>.xls.rels" file (n = 1, 2, ...).
|
||||
// retrieved from the "sheet<n>.xml.rels" file (n = 1, 2, ...).
|
||||
// The rels file contains also the second part of the hyperlink data.
|
||||
fn := OOXML_PATH_XL_WORKSHEETS_RELS + Format('sheet%d.xml.rels', [i+1]);
|
||||
UnzipFile(AFilename, fn, FilePath);
|
||||
if FileExists(FilePath + fn) then begin
|
||||
@ -1611,6 +1738,7 @@ begin
|
||||
ReadXMLFile(Doc, FilePath + fn);
|
||||
DeleteFile(FilePath + fn);
|
||||
fn := FindCommentsFileName(Doc.DocumentElement.FindNode('Relationship'));
|
||||
ReadHyperlinks(Doc.DocumentElement.FindNode('Relationship'), FWorksheet);
|
||||
FreeAndNil(Doc);
|
||||
end else
|
||||
if (SheetList.Count = 1) then
|
||||
@ -1628,7 +1756,9 @@ begin
|
||||
ReadComments(Doc.DocumentElement.FindNode('commentList'), FWorksheet);
|
||||
FreeAndNil(Doc);
|
||||
end;
|
||||
end;
|
||||
|
||||
ApplyHyperlinks(FWorksheet);
|
||||
end; // for
|
||||
|
||||
finally
|
||||
SheetList.Free;
|
||||
|
||||
Reference in New Issue
Block a user