fpspreadsheet: Modify hyperlink infrastructure to support non-label cells as well. Add hyperlinks to biff8 reader. Show hyperlink tooltip in TsWorksheetGrid.

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

components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi

@@ -9,7 +9,6 @@
       <Title Value="demo_ctrls"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
-      <Icon Value="-1"/>
     </General>
     <i18n>
       <EnableI18N LFM="False"/>

components/fpspreadsheet/examples/fpsctrls/main.lfm

@@ -559,7 +559,7 @@ object MainForm: TMainForm
       TabOrder = 0
       object CellIndicator: TsCellIndicator
         Left = 0
-        Height = 27
+        Height = 23
         Top = 0
         Width = 138
         Align = alTop

components/fpspreadsheet/examples/fpsctrls/main.pas

@@ -405,7 +405,7 @@ end;
 
 procedure TMainForm.ToolButton4Click(Sender: TObject);
 begin
-  WorkbookSource.Worksheet.WriteHyperlink(0, 0, hkCell, 'B5', 'Go to B5');
+  WorkbookSource.Worksheet.WriteHyperlink(0, 0, '#Sheet2!B5', 'Go to B5');
 end;
 
 procedure TMainForm.WorksheetGridClickHyperlink(Sender: TObject;

components/fpspreadsheet/fpscell.pas

@@ -219,8 +219,7 @@ end;
 
 procedure TCellHelper.SetHyperlink(const AValue: TsHyperlink);
 begin
-  Worksheet.WriteHyperlink(@self, AValue.Kind, AValue.Target,
+  Worksheet.WriteHyperlink(@self, AValue.Target, AValue.Tooltip);
-    Worksheet.ReadAsUTF8Text(@self), AValue.Tooltip);
 end;
 
 procedure TCellHelper.SetNumberFormat(const AValue: TsNumberFormat);

components/fpspreadsheet/fpsopendocument.pas

@@ -156,7 +156,8 @@ type
     FPointSeparatorSettings: TFormatSettings;
     // Streams with the contents of files
     FSMeta, FSSettings, FSStyles, FSContent, FSMimeType, FSMetaInfManifest: TStream;
-    // Helpers
+
+    { Helpers }
     procedure CreateNumFormatList; override;
     procedure CreateStreams;
     procedure DestroyStreams;
@@ -164,7 +165,8 @@ type
     procedure ListAllNumFormats; override;
     procedure ListAllRowStyles;
     procedure ResetStreams;
-    // Routines to write those files
+
+    { Routines to write those files }
     procedure WriteContent;
     procedure WriteMimetype;
     procedure WriteMetaInfManifest;
@@ -172,23 +174,22 @@ type
     procedure WriteSettings;
     procedure WriteStyles;
     procedure WriteWorksheet(AStream: TStream; CurSheet: TsWorksheet);
+
     { Record writing methods }
     procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
       ACell: PCell); override;
     procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
       const AValue: Boolean; ACell: PCell); override;
+    procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
+      const AValue: TDateTime; ACell: PCell); override;
     procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
       const AValue: TsErrorValue; ACell: PCell); override;
     procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
       ACell: PCell); override;
-    procedure WriteHyperlink(AStream: TStream; const ARow, ACol: Cardinal;
-      ACell: PCell); override;
     procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
       const AValue: string; ACell: PCell); override;
     procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
       const AValue: double; ACell: PCell); override;
-    procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
-      const AValue: TDateTime; ACell: PCell); override;
 
   public
     constructor Create(AWorkbook: TsWorkbook); override;
@@ -768,7 +769,7 @@ var
 begin
   Result := false;
 
-  if ACell^.ContentType = cctHyperlink then
+  if FWorksheet.IsHyperlink(ACell) then
     FWorksheet.WriteFont(ACell, HYPERLINK_FONTINDEX)
   else
   begin
@@ -1466,7 +1467,7 @@ var
   nodeName: String;
   s: String;
   cell: PCell;
-  hyperlink: TsHyperlink;
+  hyperlink: string;
 begin
   { We were forced to activate PreserveWhiteSpace in the DOMParser in order to
     catch the spaces inserted in formatting texts. However, this adds lots of
@@ -1477,7 +1478,7 @@ begin
   while Assigned(childnode) do
   begin
     nodeName := childNode.NodeName;
-    hyperlink.Kind := hkNone;
+    hyperlink := '';
     if nodeName = 'text:p' then begin
       subnode := childnode.FirstChild;
       while Assigned(subnode) do
@@ -1486,28 +1487,7 @@ begin
         if nodename = 'text:a' then begin
           s := GetAttrValue(subnode, 'xlink:type');
           if s = 'simple' then
-          begin
+            hyperlink := GetAttrValue(subnode, 'xlink:href');
-            s := GetAttrValue(subnode, 'xlink:href');
-            if s <> '' then
-            begin
-              if s[1]='#' then
-              begin
-                hyperlink.Kind := hkCell;
-                hyperlink.Target := Copy(s, 2, Length(s));
-              end else
-              begin
-                hyperlink.Kind := hkURI;
-                hyperlink.Target := s;
-                {
-                if IsAbsoluteUri(s) then
-                  hyperlink.Target := s
-                else
-                  hyperlink.Target := FileNameToUri(s);
-                  }
-              end;
-              hyperlink.Tooltip := '';
-            end;
-          end;
         end;
         subnode := subnode.NextSibling;
       end;
@@ -1528,13 +1508,7 @@ begin
         spanNode := spanNode.NextSibling;
       end;
     end;
-    {
+
-    case childnode.NodeType of
-      TEXT_NODE, COMMENT_NODE, PROCESSING_INSTRUCTION_NODE: ; // ignored
-    else
-      cellText := cellText + childnode.TextContent;
-    end;
-    }
     childnode := childnode.NextSibling;
   end;
 
@@ -1544,10 +1518,10 @@ begin
     cell := @FVirtualCell;
   end else
     cell := FWorksheet.GetCell(ARow, ACol);
-  if hyperlink.Kind = hkNone then
+
-    FWorkSheet.WriteUTF8Text(cell, cellText)
+  FWorkSheet.WriteUTF8Text(cell, cellText);
-  else
+  if hyperlink <> '' then
-    FWorksheet.WriteHyperlink(cell, hyperlink.Kind, hyperlink.Target, cellText, hyperlink.Tooltip);
+    FWorksheet.WriteHyperlink(cell, hyperlink);
 
   styleName := GetAttrValue(ACellNode, 'table:style-name');
   ApplyStyleToCell(cell, stylename);
@@ -3495,6 +3469,10 @@ var
 begin
   Unused(ARow, ACol);
 
+  // Hyperlink
+  if FWorksheet.IsHyperlink(ACell) then
+    FWorkbook.AddErrorMsg(rsODSHyperlinksOfTextCellsOnly, [GetCellString(ARow, ACol)]);
+
   // Comment
   comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
 
@@ -3571,6 +3549,10 @@ begin
     DisplayStr := rsFALSE;
   end;
 
+  // Hyperlink
+  if FWorksheet.IsHyperlink(ACell) then
+    FWorkbook.AddErrorMsg(rsODSHyperlinksOfTextCellsOnly, [GetCellString(ARow, ACol)]);
+
   AppendToStream(AStream, Format(
     '<table:table-cell office:value-type="%s" office:boolean-value="%s" %s %s >' +
       comment +
@@ -4068,6 +4050,10 @@ begin
   end else
     spannedStr := '';
 
+  // Hyperlink
+  if FWorksheet.IsHyperlink(ACell) then
+    FWorkbook.AddErrorMsg(rsODSHyperlinksOfTextCellsOnly, [GetCellString(ARow, ACol)]);
+
   // Convert string formula to the format needed by ods: semicolon list separators!
   parser := TsSpreadsheetParser.Create(FWorksheet);
   try
@@ -4150,15 +4136,6 @@ begin
 end;
 
 
-{@@ ----------------------------------------------------------------------------
-  Writes a hyperlink
--------------------------------------------------------------------------------}
-procedure TsSpreadOpenDocWriter.WriteHyperlink(AStream: TStream;
-  const ARow, ACol: Cardinal; ACell: PCell);
-begin
-  WriteLabel(AStream, ARow, ACol, ACell^.UTF8StringValue, ACell);
-end;
-
 {@@ ----------------------------------------------------------------------------
   Writes a cell with text content
 
@@ -4174,9 +4151,10 @@ var
   spannedStr: String;
   r1,c1,r2,c2: Cardinal;
   txt: ansistring;
-  textp, link, comment: String;
+  textp, target, comment: String;
   fmt: TsCellFormat;
-  hyperlink: TsHyperlink;
+  hyperlink: PsHyperlink;
+  u: TUri;
 begin
   Unused(ARow, ACol);
 
@@ -4208,17 +4186,24 @@ begin
       GetCellString(ARow, ACol)
     ]);
 
-  if ACell^.ContentType = cctHyperlink then
+  if FWorksheet.IsHyperlink(ACell) then
   begin
-    hyperlink := FWorksheet.ReadHyperlink(ACell);
+    hyperlink := FWorksheet.FindHyperlink(ACell);
-    case hyperlink.Kind of
+    target := hyperlink^.Target;
-      hkCell: link := '#' + hyperlink.Target;
+    if target[1] <> '#' then
-      hkURI : link := hyperlink.Target;
+    begin
+      u := ParseURI(target);
+      if u.Protocol = '' then begin
+        //UriToFileName(hyperlink^.Target, target);
+        target := 'file:///' + ExpandFileName(target);
+        ValidXMLText(target);
+//        if not IsAbsoluteURI(target) then target := '..\' + target;
+      end;
     end;
     textp := Format(
       '<text:p>'+
         '<text:a xlink:href="%s" xlink:type="simple">%s</text:a>'+
-      '</text:p>', [link, txt]);
+      '</text:p>', [target, txt]);
   end else
     textp := '<text:p>' + txt + '</text:p>';
 
@@ -4283,6 +4268,10 @@ begin
     DisplayStr := FloatToStr(AValue); // Uses locale decimal separator
   end;
 
+  // Hyperlink
+  if FWorksheet.IsHyperlink(ACell) then
+    FWorkbook.AddErrorMsg(rsODSHyperlinksOfTextCellsOnly, [GetCellString(ARow, ACol)]);
+
   AppendToStream(AStream, Format(
     '<table:table-cell office:value-type="%s" office:value="%s" %s %s >' +
       comment +
@@ -4335,6 +4324,10 @@ begin
   // Comment
   comment := WriteCommentXMLAsString(FWorksheet.ReadComment(ACell));
 
+  // Hyperlink
+  if FWorksheet.IsHyperlink(ACell) then
+    FWorkbook.AddErrorMsg(rsODSHyperlinksOfTextCellsOnly, [GetCellString(ARow, ACol)]);
+
   // nfTimeInterval is a special case - let's handle it first:
 
   if (fmt.NumberFormat = nfTimeInterval) then

components/fpspreadsheet/fpspreadsheet.pas

@@ -487,11 +487,13 @@ type
     function IsHyperlink(ACell: PCell): Boolean;
     function ReadHyperlink(ARow, ACol: Cardinal): TsHyperlink; overload;
     function ReadHyperlink(ACell: PCell): TsHyperlink;
-    procedure RemoveHyperlink(ACell: PCell; AKeepText: Boolean);
+    procedure RemoveHyperlink(ACell: PCell);
-    function WriteHyperlink(ARow, ACol: Cardinal; AKind: TsHyperlinkKind;
+    procedure SplitHyperlink(AValue: String; out ATarget, ABookmark: String);
-      ATarget: String; ADisplayText: String = ''; ATooltip: String = ''): PCell; overload;
+    function ValidHyperlink(AValue: String; out AErrMsg: String): Boolean;
-    procedure WriteHyperlink(ACell: PCell; AKind: TsHyperlinkKind;
+    function WriteHyperlink(ARow, ACol: Cardinal; ATarget: String;
-      ATarget: String; ADisplayText: String = ''; ATooltip: String = ''); overload;
+      ATooltip: String = ''): PCell; overload;
+    procedure WriteHyperlink(ACell: PCell; ATarget: String;
+      ATooltip: String = ''); overload;
 
     { Merged cells }
     procedure MergeCells(ARow1, ACol1, ARow2, ACol2: Cardinal); overload;
@@ -859,7 +861,7 @@ procedure DumpFontsToFile(AWorkbook: TsWorkbook; AFileName: String);
 implementation
 
 uses
-  Math, StrUtils, TypInfo, lazutf8,
+  Math, StrUtils, TypInfo, lazutf8, URIParser,
   fpsPatches, fpsStrings, fpsStreams, uvirtuallayer_ole,
   fpsUtils, fpsreaderwriter, fpsCurrency, fpsExprParser,
   fpsNumFormat, fpsNumFormatParser;
@@ -1626,7 +1628,7 @@ end;
 -------------------------------------------------------------------------------}
 function TsWorksheet.IsHyperlink(ACell: PCell): Boolean;
 begin
-  Result := (ACell <> nil) and (ACell^.ContentType = cctHyperlink);
+  Result := (ACell <> nil) and (cfHyperlink in ACell^.Flags);
 end;
 
 {@@ ----------------------------------------------------------------------------
@@ -1658,7 +1660,8 @@ begin
     Result := hyperlink^
   else
   begin
-    Result.Kind := hkNone;
+    Result.Row := ACell^.Row;
+    Result.Col := ACell^.Col;
     Result.Target := '';
     Result.Tooltip := '';
   end;
@@ -1669,7 +1672,7 @@ end;
   the associated TsHyperlink record. Cell content type is converted to
   cctUTF8String.
 -------------------------------------------------------------------------------}
-procedure TsWorksheet.RemoveHyperlink(ACell: PCell; AKeepText: Boolean);
+procedure TsWorksheet.RemoveHyperlink(ACell: PCell);
 var
   hyperlink: TsHyperlink;
   AVLNode: TAvlTreeNode;
@@ -1683,49 +1686,114 @@ begin
   if AVLNode <> nil then begin
     Dispose(PsHyperlink(AVLNode.Data));
     FHyperlinks.Delete(AVLNode);
-    if AKeepText then
+    Exclude(ACell^.Flags, cfHyperlink);
-      ACell^.ContentType := cctUTF8String
-    else
-      ACell^.ContentType := cctEmpty;
   end;
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Separates the target and bookmark parts of a hyperlink (separated by '#').
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.SplitHyperlink(AValue: String; out ATarget, ABookmark: String);
+var
+  p: Integer;
+begin
+  p := pos('#', AValue);
+  if p = 0 then
+  begin
+    ATarget := AValue;
+    ABookmark := '';
+  end else
+  begin
+    ATarget := Copy(AValue, 1, p-1);
+    ABookmark := Copy(AValue, p+1, Length(AValue));
+  end;
+end;
+
+{@@ ----------------------------------------------------------------------------
+  Checks whether the passed string represents a valid hyperlink target
+
+  @param   AValue  String to be checked. Must be either a fully qualified URI,
+                   or a # followed by a cell address in the current workbook
+  @param   AErrMsg Error message in case that the string is not correct.
+  @returns TRUE if the string is correct, FALSE otherwise
+-------------------------------------------------------------------------------}
+function TsWorksheet.ValidHyperlink(AValue: String; out AErrMsg: String): Boolean;
+var
+  uri: TUri;
+  mark: String;
+  sheet: TsWorksheet;
+  r, c: Cardinal;
+begin
+  Result := false;
+  AErrMsg := '';
+  if AValue = '' then
+  begin
+    AErrMsg := rsEmptyHyperlink;
+    exit;
+  end else
+  if (AValue[1] = '#') then
+  begin
+    Delete(AValue, 1, 1);
+    if not FWorkbook.TryStrToCell(AValue, sheet, r, c) then
+    begin
+      AErrMsg := Format(rsNoValidHyperlinkInternal, ['#'+AValue]);
+      exit;
+    end;
+  end else
+  begin
+    uri := ParseURI(AValue);
+    if SameText(uri.Protocol, 'mailto') then
+    begin
+      Result := true;   // To do: Check email address here...
+      exit;
+    end else
+    begin
+      Result := true;
+      exit;
+    end;
+  end;
+end;
+
+
 {@@ ----------------------------------------------------------------------------
   Assigns a hyperlink to the cell at the specified row and column
+  Cell content is not affected by the presence of a hyperlink.
 
   @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  ATarget       Hyperlink address given as a fully qualitifed URI for
-  @param  ATarget       Depending on AKind: cell address, filename, or URL
+                        external links, or as a # followed by a cell address
-                        if empty the hyperlink is removed from the cell.
+                        for internal links.
-  @param  ADisplayText  Text shown in cell. If empty the destination is shown
   @param  ATooltip      Text for popup tooltip hint used by Excel
-  @return Pointer to the cell with the hyperlink
+  @returns Pointer to the cell with the hyperlink
 -------------------------------------------------------------------------------}
-function TsWorksheet.WriteHyperlink(ARow, ACol: Cardinal; AKind: TsHyperlinkKind;
+function TsWorksheet.WriteHyperlink(ARow, ACol: Cardinal; ATarget: String;
-  ATarget: String; ADisplayText: String = ''; ATooltip: String = ''): PCell;
+  ATooltip: String = ''): PCell;
 begin
   Result := GetCell(ARow, ACol);
-  WriteHyperlink(Result, AKind, ATarget, ADisplayText, ATooltip);
+  WriteHyperlink(Result, ATarget, ATooltip);
 end;
 
 {@@ ----------------------------------------------------------------------------
   Assigns a hyperlink to the specified cell.
 
   @param  ACell         Pointer to the cell considered
-  @param  AKind         Hyperlink type (to cell, external file, URL)
+  @param  ATarget       Hyperlink address given as a fully qualitifed URI for
-  @param  ATarget       Depending on AKind: cell address, filename, or URL
+                        external links, or as a # followed by a cell address
-                        if empty the hyperlink is removed from the cell.
+                        for internal links. An existing hyperlink is removed if
-  @param  ADisplayText  Text shown in cell. If empty the destination is shown
+                        ATarget is empty.
   @param  ATooltip      Text for popup tooltip hint used by Excel
 -------------------------------------------------------------------------------}
-procedure TsWorksheet.WriteHyperlink(ACell: PCell; AKind: TsHyperlinkKind;
+procedure TsWorksheet.WriteHyperlink(ACell: PCell; ATarget: String;
-  ATarget: String; ADisplayText: String = ''; ATooltip: String = '');
+  ATooltip: String = '');
 var
   hyperlink: PsHyperlink;
   addNew: Boolean;
   row, col: Cardinal;
+  r, c: Cardinal;
   fmt: TsCellFormat;
+  fn: String;
+  err: String;
 begin
   if ACell = nil then
     exit;
@@ -1734,25 +1802,32 @@ begin
   col := ACell^.Col;
 
   // Remove the hyperlink if an empty destination is passed
-  if ATarget = '' then
+  if (ATarget = '') then
-    RemoveHyperlink(ACell, false)
+    RemoveHyperlink(ACell)
   else
   begin
+    {
+    if not ValidHyperlink(ATarget, err) then
+      raise Exception.Create(err);
+      }
     hyperlink := FindHyperlink(ACell);
     addNew := (hyperlink = nil);
     if addNew then New(hyperlink);
     hyperlink^.Row := row;
     hyperlink^.Col := col;
-    hyperlink^.Kind := AKind;
     hyperlink^.Target := ATarget;
     hyperlink^.Tooltip := ATooltip;
     if addNew then FHyperlinks.Add(hyperlink);
+    Include(ACell^.Flags, cfHyperlink);
 
-    ACell^.ContentType := cctHyperlink;
+    if ACell^.ContentType = cctEmpty then
-    if ADisplayText <> '' then
+    begin
-      ACell^.UTF8StringValue := ADisplayText
+      ACell^.ContentType := cctUTF8String;
-    else
+      if UriToFileName(hyperlink^.Target, fn) then
-      ACell^.UTF8StringValue := ATarget;
+        ACell^.UTF8StringValue := fn
+      else
+        ACell^.UTF8StringValue := hyperlink^.Target;
+    end;
 
     fmt := ReadCellFormat(ACell);
     if fmt.FontIndex = DEFAULT_FONTINDEX then
@@ -2744,6 +2819,7 @@ function TsWorksheet.ReadAsUTF8Text(ACell: PCell;
 
 var
   fmt: PsCellFormat;
+  hyperlink: PsHyperlink;
 
 begin
   Result := '';
@@ -2755,8 +2831,7 @@ begin
     case ContentType of
       cctNumber:
         Result := FloatToStrNoNaN(NumberValue, fmt^.NumberFormat, fmt^.NumberFormatStr);
-      cctUTF8String,
+      cctUTF8String:
-      cctHyperlink:
         Result := UTF8StringValue;
       cctDateTime:
         Result := DateTimeToStrNoNaN(DateTimeValue, fmt^.NumberFormat, fmt^.NumberFormatStr);
@@ -2775,6 +2850,11 @@ begin
         end;
       else
         Result := '';
+        if IsHyperlink(ACell) then
+        begin
+          hyperlink := FindHyperlink(ACell);
+          if hyperlink <> nil then Result := hyperlink^.Target;
+        end;
     end;
 end;
 
@@ -4602,44 +4682,9 @@ begin
     exit;
   end;
 
-  if IsHyperlink(ACell) then
+  WriteUTF8Text(ACell, AValue);
-  begin
-    // Preserve hyperlinks. Modify only the display test.
-    WriteUTF8Text(ACell, AValue);
-    ACell^.ContentType := cctHyperlink;
-  end else
-    WriteUTF8Text(ACell, AValue);
-end;
-                                 (*
-{@@ ----------------------------------------------------------------------------
-  Assigns a comment to a cell
-
-  @param ARow            Cell row index
-  @param ACol            Cell column index
-  @param AComment        Text to be used as comment. Can contain line-breaks.
-  @return  Pointer to the cell
--------------------------------------------------------------------------------}
-function TsWorksheet.WriteComment(ARow, ACol: Cardinal;
-  const AComment: String): PCell;
-begin
-  Result := GetCell(ARow, ACol);
-  WriteComment(Result, AComment);
 end;
 
-{@@ ----------------------------------------------------------------------------
-  Assigns a comment to a cell
-
-  @param ACell           Pointer to the cell
-  @param AComment        Text to be used as comment. Can contain line-breaks.
--------------------------------------------------------------------------------}
-procedure TsWorksheet.WriteComment(ACell: PCell; const AComment: String);
-begin
-  if ACell <> nil then begin
-    ACell^.Comment := AComment;
-    ChangedCell(ACell^.Row, ACell^.Col);
-  end;
-end;
-                                   *)
 {@@ ----------------------------------------------------------------------------
   Writes a currency value to a given cell. Its number format can be provided
   optionally by specifying various parameters.

components/fpspreadsheet/fpspreadsheetctrls.pas

@@ -2648,6 +2648,7 @@ end;
 procedure TsSpreadsheetInspector.UpdateCellValue(ACell: PCell; AStrings: TStrings);
 var
   hyperlink: PsHyperlink;
+  comment: String;
   s: String;
 begin
   if ACell = nil then
@@ -2680,22 +2681,6 @@ begin
       AStrings.Add(Format('UTF8StringValue=%s', [ACell^.UTF8StringValue]));
     if ACell^.ContentType = cctBool then
       AStrings.Add(Format('BoolValue=%s', [BoolToStr(ACell^.BoolValue)]));
-    if ACell^.ContentType = cctHyperlink then
-    begin
-      AStrings.Add(Format('UTF8StringValue=%s', [ACell^.UTF8StringValue]));
-      hyperlink := Worksheet.FindHyperlink(ACell);
-      if hyperlink <> nil then
-      begin
-        s := hyperlink^.Target;
-        case hyperlink^.Kind of
-          hkNone: s := s + ' <error>';
-          hkCell: s := s + ' (internal cell reference)';
-          hkURI : s := s + ' (external URI)';
-        end;
-      end else
-        s := '<error>';
-      AStrings.Add(Format('Hyperlink=%s', [s]));
-    end;
     if ACell^.ContentType = cctError then
       AStrings.Add(Format('ErrorValue=%s', [GetEnumName(TypeInfo(TsErrorValue), ord(ACell^.ErrorValue))]));
     AStrings.Add(Format('FormulaValue=%s', [Worksheet.ReadFormulaAsString(ACell, true)]));
@@ -2705,6 +2690,23 @@ begin
       AStrings.Add(Format('SharedFormulaBase=%s', [GetCellString(
         ACell^.SharedFormulaBase^.Row, ACell^.SharedFormulaBase^.Col)
       ]));
+    if (cfHyperlink in ACell^.Flags) then
+    begin
+      hyperlink := Worksheet.FindHyperlink(ACell);
+      if hyperlink <> nil then
+      begin
+        if hyperlink^.Tooltip <> '' then
+          s := hyperlink^.Target + ' (tooltip: ' + hyperlink^.Tooltip + ')'
+        else
+          s := hyperlink^.Target;
+        AStrings.Add(Format('Hyperlink=%s', [s]));
+      end;
+    end;
+    if (cfHasComment in ACell^.Flags) then
+    begin
+      comment := Worksheet.ReadComment(ACell);
+      AStrings.Add(Format('Comment=%s', [comment]));
+    end;
   end;
 end;
 

components/fpspreadsheet/fpspreadsheetgrid.pas

@@ -1024,7 +1024,7 @@ begin
   cell := FDrawingCell;
 
   // Nothing to do in these cases (like in Excel):
-  if (cell = nil) or not (cell^.ContentType in [cctUTF8String, cctHyperlink]) then  // ... non-label cells
+  if (cell = nil) or not (cell^.ContentType in [cctUTF8String]) then  // ... non-label cells
     exit;
 
   fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex);
@@ -1840,13 +1840,13 @@ begin
         cell := Worksheet.FindCell(sr, GetWorksheetCol(gc));
         // Empty cell --> proceed with next cell to the left
         if (cell = nil) or (cell^.ContentType = cctEmpty) or
-           ((cell^.ContentType in [cctUTF8String, cctHyperLink]) and (cell^.UTF8StringValue = ''))
+           ((cell^.ContentType = cctUTF8String) and (cell^.UTF8StringValue = ''))
         then
           Continue;
         // Overflow possible from non-merged, non-right-aligned, horizontal label cells
         fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex);
         if (not Worksheet.IsMerged(cell)) and
-           (cell^.ContentType in [cctUTF8String, cctHyperlink]) and
+           (cell^.ContentType = cctUTF8String) and
            not (uffTextRotation in fmt^.UsedFormattingFields) and
            (uffHorAlign in fmt^.UsedFormattingFields) and (fmt^.HorAlignment <> haRight)
         then
@@ -1867,13 +1867,13 @@ begin
         cell := Worksheet.FindCell(sr, GetWorksheetCol(gcLast));
         // Empty cell --> proceed with next cell to the right
         if (cell = nil) or (cell^.ContentType = cctEmpty) or
-           ((cell^.ContentType in [cctUTF8String, cctHyperlink]) and (cell^.UTF8StringValue = ''))
+           ((cell^.ContentType = cctUTF8String) and (cell^.UTF8StringValue = ''))
         then
           continue;
         // Overflow possible from non-merged, horizontal, non-left-aligned label cells
         fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex);
         if (not Worksheet.IsMerged(cell)) and
-           (cell^.ContentType in [cctUTF8String, cctHyperlink]) and
+           (cell^.ContentType = cctUTF8String) and
            not (uffTextRotation in fmt^.UsedFormattingFields) and
            (uffHorAlign in fmt^.UsedFormattingFields) and (fmt^.HorAlignment <> haLeft)
         then
@@ -2161,6 +2161,7 @@ end;
 procedure TsCustomWorksheetGrid.ExecuteHyperlink;
 var
   hyperlink: TsHyperlink;
+  target, bookmark: String;
   sheetname: String;
   sheet: TsWorksheet;
   r, c: Cardinal;
@@ -2169,27 +2170,24 @@ begin
     exit;
 
   hyperlink := Worksheet.ReadHyperlink(FHyperlinkCell);
-  case hyperlink.Kind of
+  Worksheet.SplitHyperlink(hyperlink.Target, target, bookmark);
-    hkNone:
+  if target = '' then begin
-      ;  // nothing to do
+    // Goes to a cell within the current workbook
-    hkCell:
+    if ParseSheetCellString(bookmark, sheetname, r, c) then
-      // Goes to a cell (unlike Excel, we don't support range here)
+    begin
-      if ParseSheetCellString(hyperlink.Target, sheetname, r, c) then
+      if sheetname <> '' then
       begin
-        if sheetname <> '' then
+        sheet := Workbook.GetWorksheetByName(sheetname);
-        begin
+        if sheet = nil then
-          sheet := Workbook.GetWorksheetByName(sheetname);
+          raise Exception.CreateFmt(rsWorksheetNotFound, [sheetname]);
-          if sheet = nil then
+        Workbook.SelectWorksheet(sheet);
-            raise Exception.CreateFmt(rsWorksheetNotFound, [sheetname]);
+      end;
-          Workbook.SelectWorksheet(sheet);
+      Worksheet.SelectCell(r, c);
-        end;
+    end else
-        Worksheet.SelectCell(r, c);
+      raise Exception.CreateFmt(rsNoValidHyperlinkInternal, [hyperlink.Target]);
-      end else
+  end else
-        raise Exception.CreateFmt(rsHyperlinkNotAValidCell, [hyperlink.Target]);
+    // Fires the OnClickHyperlink event which should open a file or a URL
-    else
+    if Assigned(FOnClickHyperlink) then FOnClickHyperlink(self, hyperlink);
-      // Fires the OnClickHyperlink event which should open a file or a URL
-      if Assigned(FOnClickHyperlink) then FOnClickHyperlink(self, hyperlink);
-  end;
 end;
 
 
@@ -2637,16 +2635,44 @@ end;
 
 {@@ ----------------------------------------------------------------------------
   This function defines the text to be displayed as a cell hint. By default, it
-  is the comment attached to a cell; it can further be modified by using the
+  is the comment and/or the hyperlink attached to a cell; it can further be
-  OnGetCellHint event.
+  modified by using the OnGetCellHint event.
   Option goCellHints must be active for the cell hint feature to work.
 -------------------------------------------------------------------------------}
 function TsCustomWorksheetGrid.GetCellHintText(ACol, ARow: Integer): String;
 var
   cell: PCell;
+  hyperlink: PsHyperlink;
+  comment: String;
 begin
   cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
-  Result := Worksheet.ReadComment(cell);
+  if cell = nil then
+    Result := ''
+  else
+  begin
+    // Read comment
+    comment := Worksheet.ReadComment(cell);
+    // Read hyperlink info
+    if Worksheet.IsHyperlink(cell) then begin
+      hyperlink := Worksheet.FindHyperlink(cell);
+      if hyperlink <> nil then
+      begin
+        if hyperlink^.ToolTip <> '' then
+          Result := hyperlink^.ToolTip
+        else
+          Result := Format('Hyperlink: %s' + LineEnding + rsStdHyperlinkTooltip,
+            [hyperlink^.Target]
+          );
+      end;
+    end;
+    // Combine comment and hyperlink
+    if (Result <> '') and (comment <> '') then
+      Result := comment + LineEnding + LineEnding + Result
+    else
+    if (Result = '') and (comment <> '') then
+      Result := comment;
+  end;
+
   if Assigned(OnGetCellHint) then
     OnGetCellHint(self, ACol, ARow, Result);
 end;
@@ -3772,7 +3798,7 @@ var
   fmt: PsCellFormat;
 begin
   Result := Worksheet.ReadAsUTF8Text(ACell);
-  if (Result = '') or ((ACell <> nil) and (ACell^.ContentType in [cctUTF8String, cctHyperlink]))
+  if (Result = '') or ((ACell <> nil) and (ACell^.ContentType = cctUTF8String))
   then
     exit;
 

components/fpspreadsheet/fpsreaderwriter.pas

@@ -115,8 +115,6 @@ type
       const AValue: TsErrorValue; ACell: PCell); virtual; abstract;
     procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
       ACell: PCell); virtual;
-    procedure WriteHyperlink(AStream: TStream; const ARow, ACol: Cardinal;
-      ACell: PCell); virtual;
     procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
       const AValue: string; ACell: PCell); virtual; abstract;
     procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
@@ -582,8 +580,6 @@ begin
         WriteNumber(AStream, ACell^.Row, ACell^.Col, ACell^.NumberValue, ACell);
       cctUTF8String:
         WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell);
-      cctHyperlink:
-        WriteHyperlink(AStream, ACell^.Row, ACell^.Col, ACell);
     end;
 
   if FWorksheet.ReadComment(ACell) <> '' then
@@ -636,23 +632,6 @@ begin
   Unused(ARow, ACol, ACell);
 end;
 
-{@@ ----------------------------------------------------------------------------
-  Basic method which is called when writing a hyperlink to a stream.
-  Present implementation does nothing. Needs to be overridden by descendants.
-
-  @param   AStream   Stream to be written
-  @param   ARow      Row index of the cell containing the hyperlink
-  @param   ACol      Column index of the cell containing the formula
-  @param   ACell     Pointer to the cell containing the hyperlink and
-                     being written to the stream
--------------------------------------------------------------------------------}
-procedure TsCustomSpreadWriter.WriteHyperlink(AStream: TStream;
-  const ARow, ACol: Cardinal; ACell: PCell);
-begin
-  Unused(AStream);
-  Unused(ARow, ACol, ACell);
-end;
-
 {@@ ----------------------------------------------------------------------------
   Default file writing method.
 

components/fpspreadsheet/fpsstrings.pas

@@ -55,7 +55,11 @@ 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.';
+  rsNoValidHyperlinkInternal = 'The hyperlink "%s" is not a valid cell address.';
+  rsNoValidHyperlinkURI = 'The hyperlink "%s" is not a valid URI.';
+  rsEmptyHyperlink = 'The hyperlink is not specified.';
+  rsODSHyperlinksOfTextCellsOnly = 'Cell %s: OpenDocument supports hyperlinks for text cells only.';
+  rsStdHyperlinkTooltip = 'Press the left mouse button a bit longer to activate the hyperlink.';
 
 
   rsTRUE = 'TRUE';               // wp: Do we really want to translate these strings?

components/fpspreadsheet/fpstypes.pas

@@ -130,7 +130,7 @@ type
 
   {@@ Describes the <b>type of content</b> in a cell of a TsWorksheet }
   TCellContentType = (cctEmpty, cctFormula, cctNumber, cctUTF8String,
-    cctDateTime, cctBool, cctError, cctHyperlink);
+    cctDateTime, cctBool, cctError);
 
   {@@ The record TsComment describes a comment attached to a cell.
      @param   Row        (0-based) row index of the cell
@@ -143,22 +143,19 @@ type
 
   {@@ Pointer to a TsComment record }
   PsComment = ^TsComment;
-
+                    (*
-  {@@ Specifies whether a hyperlink refers to a cell address within the current
+  {@@ Specifies whether a hyperlink refers to an internal cell address
-      workbook, or a URI }
+      within the current workbook, or a URI (file://, http://, mailto, etc). }
-  TsHyperlinkKind = (hkNone, hkCell, hkURI);
+  TsHyperlinkKind = (hkNone, hkInternal, hkURI);
-
+                      *)
   {@@ The record TsHyperlink contains info on a hyperlink in a cell
     @param   Row          Row index of the cell containing the hyperlink
     @param   Col          Column index of the cell containing the hyperlink
-    @param   Kind         Specifies whether clicking on the hyperlink results in
+    @param   Target       Target of hyperlink: URI of file, web link, mail; or:
-                          jumping the a cell address within the current workbook,
+                          internal link (# followed by cell address)
-                          or opens a 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;
     Target: String;
     Tooltip: String;
   end;
@@ -450,7 +447,7 @@ type
   TsCalcState = (csNotCalculated, csCalculating, csCalculated);
 
   {@@ Cell flag }
-  TsCellFlag = (cfCalculating, cfCalculated, cfHasComment, cfMerged);
+  TsCellFlag = (cfCalculating, cfCalculated, cfHasComment, cfHyperlink, cfMerged);
 
   {@@ Set of cell flags }
   TsCellFlags = set of TsCellFlag;

components/fpspreadsheet/xlsbiff8.pas

@@ -87,6 +87,8 @@ type
     procedure ReadCONTINUE(const AStream: TStream);
     procedure ReadFONT(const AStream: TStream);
     procedure ReadFORMAT(AStream: TStream); override;
+    procedure ReadHyperLink(AStream: TStream);
+    procedure ReadHyperlinkToolTip(AStream: TStream);
     procedure ReadLABEL(AStream: TStream); override;
     procedure ReadLabelSST(const AStream: TStream);
     procedure ReadMergedCells(const AStream: TStream);
@@ -135,12 +137,10 @@ type
     procedure WriteFont(AStream: TStream; AFont: TsFont);
     procedure WriteFonts(AStream: TStream);
     procedure WriteIndex(AStream: TStream);
-    procedure WriteHyperlink(AStream: TStream; const ARow, ACol: Cardinal;
+    procedure WriteHyperlink(AStream: TStream; AHyperlink: PsHyperlink;
-      ACell: PCell); override;
-    procedure WriteHYPERLINKRecord(AStream: TStream; AHyperlink: PsHyperlink;
       AWorksheet: TsWorksheet);
     procedure WriteHyperlinks(AStream: TStream; AWorksheet: TsWorksheet);
-    procedure WriteHYPERLINKTOOLTIP(AStream: TStream; const ARow, ACol: Cardinal;
+    procedure WriteHyperlinkToolTip(AStream: TStream; const ARow, ACol: Cardinal;
       const ATooltip: String);
     procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
       const AValue: string; ACell: PCell); override;
@@ -259,7 +259,7 @@ var
 implementation
 
 uses
-  Math, lconvencoding, URIParser, DOS,
+  Math, lconvencoding, URIParser,
   fpsStrings, fpsStreams, fpsReaderWriter, fpsExprParser, xlsEscher;
 
 const
@@ -270,7 +270,7 @@ const
      INT_EXCEL_ID_LABELSST               = $00FD;  // BIFF8 only
      INT_EXCEL_ID_TXO                    = $01B6;  // BIFF8 only
      INT_EXCEL_ID_HYPERLINK              = $01B8;  // BIFF8 only
-     INT_EXCEL_ID_HYPERLINKTOOLTIP       = $0800;  // BIFF8 only
+     INT_EXCEL_ID_HLINKTOOLTIP           = $0800;  // BIFF8 only
 {%H-}INT_EXCEL_ID_FORCEFULLCALCULATION   = $08A3;
 
    { Excel OBJ subrecord IDs }
@@ -688,6 +688,8 @@ begin
     INT_EXCEL_ID_BOOLERROR   : ReadBool(AStream);
     INT_EXCEL_ID_CONTINUE    : ReadCONTINUE(AStream);
     INT_EXCEL_ID_FORMULA     : ReadFormula(AStream);
+    INT_EXCEL_ID_HYPERLINK   : ReadHyperlink(AStream);
+    INT_EXCEL_ID_HLINKTOOLTIP: ReadHyperlinkToolTip(AStream);
     INT_EXCEL_ID_LABEL       : ReadLabel(AStream);
     INT_EXCEL_ID_MULBLANK    : ReadMulBlank(AStream);
     INT_EXCEL_ID_NOTE        : ReadNOTE(AStream);
@@ -1418,11 +1420,182 @@ begin
   NumFormatList.AnalyzeAndAdd(fmtIndex, fmtString);
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Reads a HYPERLINK record
+-------------------------------------------------------------------------------}
+procedure TsSpreadBIFF8Reader.ReadHyperlink(AStream: TStream);
+var
+  row, col, row1, col1, row2, col2: word;
+  guid: TGUID;
+  flags: DWord;
+  widestr: widestring;
+  len: DWord;
+  isInternal: Boolean;
+  link: String;
+  linkDos: String;
+  mark: String;
+  dirUpCount: Word;
+  ansistr: ansistring;
+  size: DWord;
+  buf: array of byte;
+begin
+  { Row and column index range of cells using the hyperlink }
+  row1 := WordLEToN(AStream.ReadWord);
+  row2 := WordLEToN(AStream.ReadWord);
+  col1 := WordLEToN(AStream.ReadWord);
+  col2 := WordLEToN(AStream.ReadWord);
+
+  { GUID of standard link }
+  AStream.ReadBuffer(guid, SizeOf(guid));
+
+  { unknown DWord }
+  AStream.ReadDWord;
+
+  { Flags }
+  flags := DWordLEToN(AStream.ReadDWord);
+
+  { Description }
+  if flags and MASK_HLINK_DESCRIPTION = MASK_HLINK_DESCRIPTION then
+  begin
+    // not used because there is always a "normal" cell to which the hyperlink is associated.
+    // character count of description incl trailing zero
+    len := DWordLEToN(AStream.ReadDWord);
+    // Character array (16-bit characters, with trailing zero word)
+    SetLength(wideStr, len);
+    AStream.ReadBuffer(wideStr[1], len*SizeOf(wideChar));
+  end;
+
+  { Target frame: external link (URI or local file) }
+  link := '';
+  if flags and MASK_HLINK_LINK <> 0 then
+//  if flags and (MASK_HLINK_LINK or MASK_HLINK_ABSOLUTE) = (MASK_HLINK_LINK or MASK_HLINK_ABSOLUTE) then
+  begin
+    AStream.ReadBuffer(guid, SizeOf(guid));
+
+    // Check for URL
+    if GuidToString(guid) = '{79EAC9E0-BAF9-11CE-8C82-00AA004BA90B}' then
+    begin
+      // Character count incl trailing zero
+      len := DWordLEToN(AStream.ReadDWord);
+      // Character array of URL (16-bit-characters, with trailing zero word)
+      SetLength(wideStr, len);
+      AStream.ReadBuffer(wideStr[1], len*SizeOf(wideChar));
+      link := UTF8Encode(wideStr);
+    end else
+    // Check for local file
+    if GuidToString(guid) = '{00000303-0000-0000-C000-000000000046}' then
+    begin
+      dirUpCount := WordLEToN(AStream.ReadWord);
+      // Character count of the shortened file path and name, incl trailing zero byte
+      len := DWordLEToN(AStream.ReadDWord);
+      // Character array of the shortened file path and name in 8.3-DOS-format.
+      // This field can be filled with a long file name too.
+      // No Unicode string header, always 8-bit characters, zeroterminated.
+      SetLength(ansiStr, len);
+      AStream.ReadBuffer(ansiStr[1], len*SizeOf(ansiChar));
+      linkDos := AnsiToUTF8(ansiStr);
+      while dirUpCount > 0 do
+      begin
+        linkDos := '..\' + linkDos;
+        dec(dirUpCount);
+      end;
+      // 6 unknown DWord values
+      AStream.ReadDWord;
+      AStream.ReadDWord;
+      AStream.ReadDWord;
+      AStream.ReadDWord;
+      AStream.ReadDWord;
+      AStream.ReadDWord;
+      // Size of the following file link field including string length field
+      // and additional data field
+      size := DWordLEToN(AStream.ReadDWord);
+      if size > 0 then
+      begin
+        // Size of the extended file path and name.
+        size := DWordLEToN(AStream.ReadDWord);
+        len := size div 2;
+        // Unknown
+        AStream.ReadWord;
+        // Character array of the extended file path and name
+        // no Unicode string header, always 16-bit characters, not zero-terminated
+        SetLength(wideStr, len);
+        AStream.ReadBuffer(wideStr[1], len*SizeOf(wideChar));
+        link := UTF8Encode(widestr);
+      end else
+        link := linkDos;
+    end;
+  end;
+
+  { Text mark }
+  if flags and MASK_HLINK_TEXTMARK = MASK_HLINK_TEXTMARK then
+  begin
+    // Character count of the text mark, including trailing zero word
+    len := DWordLEToN(AStream.ReadDWord);
+    // Character array of the text mark without "#" sign
+    // no Unicode string header, always 16-bit characters, zero-terminated
+    SetLength(wideStr, len);
+    AStream.ReadBuffer(wideStr[1], len*SizeOf(wideChar));
+    mark := UTF8Encode(wideStr);
+  end;
+
+  // Add bookmark to hyperlink target
+  if (link <> '') and (mark <> '') then
+    link := link + '#' + mark
+  else
+  if (link = '') then
+    link := '#' + mark;
+
+  // Add hyperlink(s) to worksheet
+  for row := row1 to row2 do
+    for col := col1 to col2 do
+      FWorksheet.WriteHyperlink(row, col, link);
+end;
+
+
+{@@ ----------------------------------------------------------------------------
+  Reads a HYPERLINK TOOLTIP record
+-------------------------------------------------------------------------------}
+procedure TsSpreadBIFF8Reader.ReadHyperlinkToolTip(AStream: TStream);
+var
+  txt: String;
+  widestr: widestring;
+  row, col, row1, col1, row2, col2: Word;
+  hyperlink: PsHyperlink;
+  numbytes: Integer;
+begin
+  { Record type; this matches the BIFF record type }
+  AStream.ReadWord;
+
+  { Row and column index range of cells using the hyperlink tooltip }
+  row1 := WordLEToN(AStream.ReadWord);
+  row2 := WordLEToN(AStream.ReadWord);
+  col1 := WordLEToN(AStream.ReadWord);
+  col2 := WordLEToN(AStream.ReadWord);
+
+  { Hyperlink tooltip, a null-terminated unicode string }
+  numbytes := RecordSize - 5*SizeOf(word);
+  SetLength(wideStr, numbytes div 2);
+  AStream.ReadBuffer(wideStr[1], numbytes);
+  txt := UTF8Encode(wideStr);
+
+  { Add tooltip to hyperlinks }
+  for row := row1 to row2 do
+    for col := col1 to col2 do
+    begin
+      hyperlink := FWorksheet.FindHyperlink(row, col);
+      if hyperlink <> nil then
+        hyperlink^.ToolTip := txt;
+    end;
+end;
+
 
 {------------------------------------------------------------------------------}
 {                          TsSpreadBIFF8Writer                                 }
 {------------------------------------------------------------------------------}
 
+{@@ ----------------------------------------------------------------------------
+  Constructor of the Excel 8 writer
+-------------------------------------------------------------------------------}
 constructor TsSpreadBIFF8Writer.Create(AWorkbook: TsWorkbook);
 begin
   inherited Create(AWorkbook);
@@ -2171,22 +2344,10 @@ begin
   { OBS: It seems to be no problem just ignoring this part of the record }
 end;
 
-{@@ ----------------------------------------------------------------------------
-  Inherited method for writing a hyperlink
-  Just writes the cell text; the hyperlink is written together with the other
-  hyperlinks later.
--------------------------------------------------------------------------------}
-procedure TsSpreadBIFF8Writer.WriteHyperlink(AStream: TStream;
-  const ARow, ACol: Cardinal; ACell: PCell);
-begin
-  WriteLabel(AStream, ARow, ACol, FWorksheet.ReadAsUTF8Text(ACell), ACell);
-  ACell^.ContentType := cctHyperlink;
-end;
-
 {@@ ----------------------------------------------------------------------------
   Writes an Excel 8 HYPERLINK record
 -------------------------------------------------------------------------------}
-procedure TsSpreadBIFF8Writer.WriteHYPERLINKRecord(AStream: TStream;
+procedure TsSpreadBIFF8Writer.WriteHyperlink(AStream: TStream;
   AHyperlink: PsHyperlink; AWorksheet: TsWorksheet);
 var
   temp: TStream;
@@ -2196,16 +2357,18 @@ var
   descr: String;
   fn: String;
   flags: DWord;
-  markpos: Integer;
   size: Integer;
   cell: PCell;
+  isInternal: Boolean;
+  target, bookmark: String;
 begin
   cell := AWorksheet.FindCell(AHyperlink^.Row, AHyperlink^.Col);
-  if (cell = nil) or (AHyperlink^.Kind = hkNone) then
+  if (cell = nil) or (AHyperlink^.Target='') then
     exit;
 
   descr := AWorksheet.ReadAsUTF8Text(cell);      // Hyperlink description
-  markpos := UTF8Pos('#', AHyperlink^.Target);   // Position of # in hyperlink target
+  AWorksheet.SplitHyperlink(AHyperlink^.Target, target, bookmark);
+  isInternal := (target = '');
 
   // Since the length of the record is not known in the first place we write
   // the data to a temporary stream at first.
@@ -2226,16 +2389,14 @@ begin
 
     { option flags }
     flags := 0;
-    case AHyperlink^.Kind of
+    if isInternal then
-      hkCell:
+      flags := MASK_HLINK_TEXTMARK or MASK_HLINK_DESCRIPTION
-        flags := MASK_HLINK_TEXTMARK or MASK_HLINK_DESCRIPTION;
+    else
-      hkURI:
+      flags := MASK_HLINK_LINK or MASK_HLINK_ABSOLUTE;
-        flags := MASK_HLINK_LINK or MASK_HLINK_ABSOLUTE;
-    end;
     if descr <> AHyperlink^.Target then
       flags := flags or MASK_HLINK_DESCRIPTION;  // has description
-    if markpos > 0 then                          // has # in target
+    if bookmark <> '' then
-      flags := flags or MASK_HLINK_TEXTMARK;
+      flags := flags or MASK_HLINK_TEXTMARK;     // link contains a bookmark
     temp.WriteDWord(DWordToLE(flags));
 
     { description }
@@ -2248,9 +2409,9 @@ begin
       temp.WriteBuffer(wideStr[1], (Length(wideStr)+1)*SizeOf(widechar));
     end;
 
-    if AHyperlink^.Kind = hkURI then
+    if target <> '' then
     begin
-      if URIToFilename(AHyperlink^.Target, fn) then  // URI is a local file
+      if URIToFilename(target, fn) then  // URI is a local file
       begin
        { GUID of file moniker }
         guid := StringToGuid('{00000303-0000-0000-C000-000000000046}');
@@ -2286,7 +2447,7 @@ begin
         end;
       end
       else begin  { Hyperlink target is a URL }
-        widestr := UTF8Decode(AHyperlink^.Target);
+        widestr := UTF8Decode(target);
         { GUID of URL Moniker }
         guid := StringToGUID('{79EAC9E0-BAF9-11CE-8C82-00AA004BA90B}');
         temp.WriteBuffer(guid, SizeOf(guid));
@@ -2298,13 +2459,10 @@ begin
     end; // hkURI
 
     // Hyperlink contains a text mark (#)
-    if flags and MASK_HLINK_TEXTMARK <> 0 then
+    if bookmark <> '' then
     begin
-      // Extract text mark without "#" and convert to 16-bit characters
+      // Convert to 16-bit characters
-      if markpos > 0 then
+      widestr := UTF8Decode(bookmark);
-        widestr := UTF8Decode(UTF8Copy(AHyperlink^.Target, markpos+1, Length(AHyperlink^.Target)))
-      else if AHyperlink^.Kind = hkCell then
-        widestr := UTF8Decode(AHyperlink^.Target);
       { Character count of text mark, incl trailing zero }
       temp.WriteDWord(DWordToLE(Length(wideStr) + 1));
       { Character array (16-bit characters) plus trailing zeros }
@@ -2340,7 +2498,7 @@ procedure TsSpreadBIFF8Writer.WriteHyperlinksCallback(AHyperlink: PsHyperlink;
   AStream: TStream);
 begin
   { Write HYPERLINK record }
-  WriteHyperlinkRecord(AStream, AHyperlink, FWorksheet);
+  WriteHyperlink(AStream, AHyperlink, FWorksheet);
 
   { Write HYPERLINK TOOLTIP record }
   if AHyperlink^.Tooltip <> '' then
@@ -2358,11 +2516,11 @@ begin
   widestr := UTF8Decode(ATooltip);
 
   { BIFF record header }
-  WriteBiffHeader(AStream, INT_EXCEL_ID_HYPERLINKTOOLTIP,
+  WriteBiffHeader(AStream, INT_EXCEL_ID_HLINKTOOLTIP,
     10 + (Length(wideStr)+1) * SizeOf(widechar));
 
   { Repeated record ID }
-  AStream.WriteWord(WordToLe(INT_EXCEL_ID_HYPERLINKTOOLTIP));
+  AStream.WriteWord(WordToLe(INT_EXCEL_ID_HLINKTOOLTIP));
 
   { Cell range using the same hyperlink tooltip - we support only single cells }
   AStream.WriteWord(WordToLE(ARow));   // first row

components/fpspreadsheet/xlsxooxml.pas

@@ -180,8 +180,6 @@ type
       const AValue: TsErrorValue; ACell: PCell); override;
     procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
       ACell: PCell); override;
-    procedure WriteHyperlink(AStream: TStream; const ARow, ACol: Cardinal;
-      ACell: PCell); override;
     procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
       const AValue: string; ACell: PCell); override;
     procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
@@ -351,8 +349,8 @@ type
   THyperlinkListData = class
     ID: String;
     CellRef: String;
-    Kind: TsHyperlinkKind;
+    Target: String;
-    Location: String;
+    TextMark: String;
     Display: String;
     Tooltip: String;
   end;
@@ -531,7 +529,13 @@ begin
     for r := r1 to r2 do
       for c := c1 to c2 do
         with hyperlinkData do
-          AWorksheet.WriteHyperlink(r, c, Kind, Location, Display, ToolTip);
+          if Target = '' then
+            AWorksheet.WriteHyperlink(r, c, '#'+TextMark, ToolTip)
+          else
+          if TextMark = '' then
+            AWorksheet.WriteHyperlink(r, c, Target, ToolTip)
+          else
+            AWorksheet.WriteHyperlink(r, c, Target+'#'+TextMark, ToolTip);
   end;
 end;
 
@@ -1276,10 +1280,10 @@ begin
           hyperlinkData := THyperlinkListData.Create;
           hyperlinkData.CellRef := GetAttrValue(node, 'ref');
           hyperlinkData.ID := GetAttrValue(node, 'r:id');
-          hyperlinkData.Location := GetAttrValue(node, 'location');
+          hyperlinkData.Target := '';
+          hyperlinkData.TextMark := GetAttrValue(node, 'location');
           hyperlinkData.Display := GetAttrValue(node, 'display');
           hyperlinkData.Tooltip := GetAttrValue(node, 'tooltip');
-          hyperlinkData.Kind := hkCell;
         end;
         FHyperlinkList.Add(hyperlinkData);
         node := node.NextSibling;
@@ -1302,10 +1306,13 @@ begin
               hyperlinkData := FindHyperlinkID(s);
               if hyperlinkData <> nil then begin
                 s := GetAttrValue(node, 'Target');
-                if s <> '' then hyperlinkData.Location := s;
+                if s <> '' then hyperlinkData.Target := s;
                 s := GetAttrValue(node, 'TargetMode');
-                if s = 'External' then
+                if s <> 'External' then   // Only "External" accepted!
-                  hyperlinkData.Kind := hkURI
+                begin
+                  hyperlinkData.Target := '';
+                  hyperlinkData.TextMark := '';
+                end;
               end;
             end;
           end;
@@ -2182,6 +2189,7 @@ procedure TsSpreadOOXMLWriter.WriteHyperlinks(AStream: TStream;
   AWorksheet: TsWorksheet);
 var
   hyperlink: PsHyperlink;
+  target, bookmark: String;
   s: String;
   txt: String;
   AVLNode: TAVLTreeNode;
@@ -2198,14 +2206,15 @@ begin
   AVLNode := AWorksheet.Hyperlinks.FindLowest;
   while AVLNode <> nil do begin
     hyperlink := PsHyperlink(AVLNode.Data);
+    AWorksheet.SplitHyperlink(hyperlink^.Target, target, bookmark);
     s := Format('ref="%s"', [GetCellString(hyperlink^.Row, hyperlink^.Col)]);
-    if hyperlink^.Kind <> hkCell then
+    if target <> '' then
     begin
       s := Format('%s r:id="rId%d"', [s, FNext_rId]);
       inc(FNext_rId);
     end;
-    if hyperlink^.Kind = hkCell then
+    if target = '' then
-      s := Format('%s location="%s"', [s, hyperlink^.Target]);
+      s := Format('%s location="%s"', [s, bookmark]);
     txt := AWorksheet.ReadAsUTF8Text(hyperlink^.Row, hyperlink^.Col);
     if (txt <> '') and (txt <> hyperlink^.Target) then
       s := Format('%s display="%s"', [s, txt]);
@@ -2695,12 +2704,10 @@ begin
     while Assigned(AVLNode) do
     begin
       hyperlink := PsHyperlink(AVLNode.Data);
-      if hyperlink^.Kind <> hkCell then
+      if hyperlink^.Target <> '' then
       begin
-        s := Format('Id="rId%d" Type="%s" Target="%s"',
+        s := Format('Id="rId%d" Type="%s" Target="%s" TargetMode="External"',
           [FNext_rId, SCHEMAS_HYPERLINKS, hyperlink^.Target]);
-        if hyperlink^.Kind <> hkCell then
-          s := s + ' TargetMode="External"';
         AppendToStream(FSSheetRels[FCurSheetNum],
           '<Relationship ' + s + ' />');
         inc(FNext_rId);
@@ -3289,13 +3296,6 @@ begin
   end;
 end;
 
-procedure TsSpreadOOXMLWriter.WriteHyperlink(AStream: TStream;
-  const ARow, ACol: Cardinal; ACell: PCell);
-begin
-  if FWorksheet.IsHyperlink(ACell) then
-    WriteLabel(AStream, ARow, ACol, FWorksheet.ReadAsUTF8Text(ACell), ACell);
-end;
-
 {@@ ----------------------------------------------------------------------------
   Writes a string to the stream