fpspreadsheet: Improved handling of empty cells containing hyperlinks.

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

components/fpspreadsheet/fpsactions.pas

@@ -1342,7 +1342,7 @@ var
   cellStr: String;
   hyperlink: TsHyperlink;
   displayText: String;
-  noCellText: Boolean;
+//  noCellText: Boolean;
   cell: PCell;
 begin
   Unused(Target);
@@ -1367,7 +1367,7 @@ begin
       begin
         displayText := Worksheet.ReadAsUTF8Text(ActiveCell);
         hyperlink := Worksheet.ReadHyperlink(ActiveCell);
-        noCellText := displayText = hyperlink.Target;
+//        noCellText := displayText = hyperlink.Target;
         txt := Format('Edit hyperlink for cell %s', [cellStr]);
         if EditHyperlink(txt, hyperlink) then
         begin
@@ -1375,8 +1375,10 @@ begin
             Worksheet.ActiveCellRow, Worksheet.ActiveCellCol,
             hyperlink.Target, hyperlink.ToolTip
           );
+          {
           if noCellText then
             Worksheet.WriteBlank(Worksheet.ActiveCellRow, Worksheet.ActiveCellCol);
+            }
         end;
       end;
     chmDelete:

components/fpspreadsheet/fpspreadsheet.pas

@@ -1600,36 +1600,59 @@ end;
 -------------------------------------------------------------------------------}
 procedure TsWorksheet.WriteHyperlink(ACell: PCell; ATarget: String;
   ATooltip: String = '');
-var
-  fmt: TsCellFormat;
-  target, bm, displayTxt: String;
-begin
-  if ACell = nil then
-    exit;
 
-  if ATarget = '' then begin
+  function GetDisplayText(ATarget: String): String;
-    RemoveHyperlink(ACell);
+  var
-    exit;
+    target, bm: String;
-  end;
-
-  FHyperlinks.AddHyperlink(ACell^.Row, ACell^.Col, ATarget, ATooltip);
-  Include(ACell^.Flags, cfHyperlink);
-
-  if ACell^.ContentType = cctEmpty then
   begin
     SplitHyperlink(ATarget, target, bm);
     if pos('file:', lowercase(ATarget))=1 then
     begin
-      URIToFilename(target, displayTxt);
+      URIToFilename(target, Result);
-      ForcePathDelims(displayTxt);
+      ForcePathDelims(Result);
-      if bm <> '' then displayTxt := displayTxt + '#' + bm;
+      if bm <> '' then Result := Result + '#' + bm;
     end else
-      displayTxt := ATarget;
+    if target = '' then
-    ACell^.ContentType := cctUTF8String;
+      Result := bm
-    ACell^.UTF8StringValue := displayTxt;
+    else
+      Result := ATarget;
   end;
 
+var
+  fmt: TsCellFormat;
+  noCellText: Boolean = false;
+begin
+  if ACell = nil then
+    exit;
+
   fmt := ReadCellFormat(ACell);
+
+  // Empty target string removes the hyperlink. Resets the font from hyperlink
+  // to default font.
+  if ATarget = '' then begin
+    RemoveHyperlink(ACell);
+    if fmt.FontIndex = HYPERLINK_FONTINDEX then
+      WriteFont(ACell, DEFAULT_FONTINDEX);
+    exit;
+  end;
+
+  // Detect whether the cell already has a hyperlink, but has no other content.
+  if HasHyperlink(ACell) then
+    noCellText := (ACell^.ContentType = cctUTF8String) and
+      (GetDisplayText(ReadHyperlink(ACell).Target) = ReadAsUTF8Text(ACell));
+
+  // Attach the hyperlink to the cell
+  FHyperlinks.AddHyperlink(ACell^.Row, ACell^.Col, ATarget, ATooltip);
+  Include(ACell^.Flags, cfHyperlink);
+
+  // If there is no other cell content use the target as cell label string.
+  if (ACell^.ContentType = cctEmpty) or noCellText then
+  begin
+    ACell^.ContentType := cctUTF8String;
+    ACell^.UTF8StringValue := GetDisplayText(ATarget);
+  end;
+
+  // Select the hyperlink font.
   if fmt.FontIndex = DEFAULT_FONTINDEX then
   begin
     fmt.FontIndex := HYPERLINK_FONTINDEX;

components/fpspreadsheet/tests/hyperlinktests.pas

@@ -217,6 +217,8 @@ begin
         expected := hyperlink.Target;
         if pos('file:', SollLinks[ATestMode])=1 then
           Delete(expected, 1, Length('file:///'))
+        else if expected[1] = '#' then   // ... and internal links are displayed without #
+          Delete(expected, 1, 1);
       end else
         expected := SollCellContent[row];
       FixHyperlinkPathDelims(expected);