From 34ec8774147a573768a6f58b9b11aad84603d703 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 20 Mar 2015 20:51:07 +0000 Subject: [PATCH] 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 | 6 +- components/fpspreadsheet/fpspreadsheet.pas | 65 +++++++++++++------ .../fpspreadsheet/tests/hyperlinktests.pas | 2 + 3 files changed, 50 insertions(+), 23 deletions(-) diff --git a/components/fpspreadsheet/fpsactions.pas b/components/fpspreadsheet/fpsactions.pas index 42388a3e7..ef2677b81 100644 --- a/components/fpspreadsheet/fpsactions.pas +++ b/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: diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index c143ea80f..5c554645a 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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 - RemoveHyperlink(ACell); - exit; - end; - - FHyperlinks.AddHyperlink(ACell^.Row, ACell^.Col, ATarget, ATooltip); - Include(ACell^.Flags, cfHyperlink); - - if ACell^.ContentType = cctEmpty then + function GetDisplayText(ATarget: String): String; + var + target, bm: String; begin SplitHyperlink(ATarget, target, bm); if pos('file:', lowercase(ATarget))=1 then begin - URIToFilename(target, displayTxt); - ForcePathDelims(displayTxt); - if bm <> '' then displayTxt := displayTxt + '#' + bm; + URIToFilename(target, Result); + ForcePathDelims(Result); + if bm <> '' then Result := Result + '#' + bm; end else - displayTxt := ATarget; - ACell^.ContentType := cctUTF8String; - ACell^.UTF8StringValue := displayTxt; + if target = '' then + Result := bm + 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; diff --git a/components/fpspreadsheet/tests/hyperlinktests.pas b/components/fpspreadsheet/tests/hyperlinktests.pas index 71e22a350..75f6095b3 100644 --- a/components/fpspreadsheet/tests/hyperlinktests.pas +++ b/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);