fpspreadsheet: read hyperlinks from xlsx files

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3957 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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;

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.Target := '';
-    Result.Note := '';
+    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^.Target := ATarget;
-    hyperlink^.Note := ANote;
+    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);

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
+      if hyperlink <> nil then
-        s := hyperlink^.Destination;
+      begin
+        s := hyperlink^.Target;
         case hyperlink^.Kind of
           hkNone: s := s + ' <error>';
           hkCell: s := s + ' (internal cell reference)';

components/fpspreadsheet/fpspreadsheetgrid.pas

@@ -2173,8 +2173,8 @@ begin
     hkNone:
       ;  // nothing to do
     hkCell:
-      // Goes to a cell
+      // Goes to a cell (unlike Excel, we don't support range here)
-      if ParseSheetCellString(hyperlink.Destination, sheetname, r, c) then
+      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);

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?

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;
+    Target: String;
-    Note: String;
+    Tooltip: String;
   end;
 
   {@@ Pointer to a TsHyperlink record }

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<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;