diff --git a/components/fpspreadsheet/examples/fpsctrls/main.pas b/components/fpspreadsheet/examples/fpsctrls/main.pas index 3a2d6befa..a23d097f2 100644 --- a/components/fpspreadsheet/examples/fpsctrls/main.pas +++ b/components/fpspreadsheet/examples/fpsctrls/main.pas @@ -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; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index b63cd95cb..04b76c77e 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -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); diff --git a/components/fpspreadsheet/fpspreadsheetctrls.pas b/components/fpspreadsheet/fpspreadsheetctrls.pas index a75046305..551d27cd9 100644 --- a/components/fpspreadsheet/fpspreadsheetctrls.pas +++ b/components/fpspreadsheet/fpspreadsheetctrls.pas @@ -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 + ' '; hkCell: s := s + ' (internal cell reference)'; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 140894eea..d239d2e01 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -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); diff --git a/components/fpspreadsheet/fpsstrings.pas b/components/fpspreadsheet/fpsstrings.pas index c8aa1accb..0d9fa8b48 100644 --- a/components/fpspreadsheet/fpsstrings.pas +++ b/components/fpspreadsheet/fpsstrings.pas @@ -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? diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index d3e3497a1..f11774baf 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -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 } diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 7fb9f8931..327cff0c7 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -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.xml" files (n = 1, 2, ...) // The relationship which comment belongs to which sheet file must be - // retrieved from the "sheet.xls.rels" file (n = 1, 2, ...). + // retrieved from the "sheet.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;