diff --git a/components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi b/components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi index b20a99e4c..082126cb5 100644 --- a/components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi +++ b/components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi @@ -9,7 +9,6 @@ <ResourceType Value="res"/> <UseXPManifest Value="True"/> - <Icon Value="-1"/> </General> <i18n> <EnableI18N LFM="False"/> diff --git a/components/fpspreadsheet/examples/fpsctrls/main.lfm b/components/fpspreadsheet/examples/fpsctrls/main.lfm index 90a4c1c8b..17e106c3d 100644 --- a/components/fpspreadsheet/examples/fpsctrls/main.lfm +++ b/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 diff --git a/components/fpspreadsheet/examples/fpsctrls/main.pas b/components/fpspreadsheet/examples/fpsctrls/main.pas index fc0139818..67701c574 100644 --- a/components/fpspreadsheet/examples/fpsctrls/main.pas +++ b/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; diff --git a/components/fpspreadsheet/fpscell.pas b/components/fpspreadsheet/fpscell.pas index 642ef7f0e..d15cebe59 100644 --- a/components/fpspreadsheet/fpscell.pas +++ b/components/fpspreadsheet/fpscell.pas @@ -219,8 +219,7 @@ end; procedure TCellHelper.SetHyperlink(const AValue: TsHyperlink); begin - Worksheet.WriteHyperlink(@self, AValue.Kind, AValue.Target, - Worksheet.ReadAsUTF8Text(@self), AValue.Tooltip); + Worksheet.WriteHyperlink(@self, AValue.Target, AValue.Tooltip); end; procedure TCellHelper.SetNumberFormat(const AValue: TsNumberFormat); diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 0ba958152..f625c3943 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/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 - 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; + hyperlink := GetAttrValue(subnode, 'xlink:href'); 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) - else - FWorksheet.WriteHyperlink(cell, hyperlink.Kind, hyperlink.Target, cellText, hyperlink.Tooltip); + + FWorkSheet.WriteUTF8Text(cell, cellText); + if hyperlink <> '' then + 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); - case hyperlink.Kind of - hkCell: link := '#' + hyperlink.Target; - hkURI : link := hyperlink.Target; + hyperlink := FWorksheet.FindHyperlink(ACell); + target := hyperlink^.Target; + if target[1] <> '#' then + 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 diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index f84b24d86..5cd3137c5 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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); - function WriteHyperlink(ARow, ACol: Cardinal; AKind: TsHyperlinkKind; - ATarget: String; ADisplayText: String = ''; ATooltip: String = ''): PCell; overload; - procedure WriteHyperlink(ACell: PCell; AKind: TsHyperlinkKind; - ATarget: String; ADisplayText: String = ''; ATooltip: String = ''); overload; + procedure RemoveHyperlink(ACell: PCell); + procedure SplitHyperlink(AValue: String; out ATarget, ABookmark: String); + function ValidHyperlink(AValue: String; out AErrMsg: String): Boolean; + function WriteHyperlink(ARow, ACol: Cardinal; ATarget: String; + 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 - ACell^.ContentType := cctUTF8String - else - ACell^.ContentType := cctEmpty; + Exclude(ACell^.Flags, cfHyperlink); 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 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 ATarget Hyperlink address given as a fully qualitifed URI for + external links, or as a # followed by a cell address + for internal links. @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; - ATarget: String; ADisplayText: String = ''; ATooltip: String = ''): PCell; +function TsWorksheet.WriteHyperlink(ARow, ACol: Cardinal; ATarget: String; + 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 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 ATarget Hyperlink address given as a fully qualitifed URI for + external links, or as a # followed by a cell address + for internal links. An existing hyperlink is removed if + ATarget is empty. @param ATooltip Text for popup tooltip hint used by Excel -------------------------------------------------------------------------------} -procedure TsWorksheet.WriteHyperlink(ACell: PCell; AKind: TsHyperlinkKind; - ATarget: String; ADisplayText: String = ''; ATooltip: String = ''); +procedure TsWorksheet.WriteHyperlink(ACell: PCell; ATarget: 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 - RemoveHyperlink(ACell, false) + if (ATarget = '') then + 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 ADisplayText <> '' then - ACell^.UTF8StringValue := ADisplayText - else - ACell^.UTF8StringValue := ATarget; + if ACell^.ContentType = cctEmpty then + begin + ACell^.ContentType := cctUTF8String; + if UriToFileName(hyperlink^.Target, fn) then + 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, - cctHyperlink: + cctUTF8String: 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 - 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); + WriteUTF8Text(ACell, AValue); 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. diff --git a/components/fpspreadsheet/fpspreadsheetctrls.pas b/components/fpspreadsheet/fpspreadsheetctrls.pas index c87d3e491..04374e7c1 100644 --- a/components/fpspreadsheet/fpspreadsheetctrls.pas +++ b/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; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index d239d2e01..54bc35260 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/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 - hkNone: - ; // nothing to do - hkCell: - // Goes to a cell (unlike Excel, we don't support range here) - if ParseSheetCellString(hyperlink.Target, sheetname, r, c) then + Worksheet.SplitHyperlink(hyperlink.Target, target, bookmark); + if target = '' then begin + // Goes to a cell within the current workbook + if ParseSheetCellString(bookmark, sheetname, r, c) then + begin + if sheetname <> '' then begin - if sheetname <> '' then - begin - sheet := Workbook.GetWorksheetByName(sheetname); - if sheet = nil then - raise Exception.CreateFmt(rsWorksheetNotFound, [sheetname]); - Workbook.SelectWorksheet(sheet); - end; - Worksheet.SelectCell(r, c); - end else - 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); - end; + sheet := Workbook.GetWorksheetByName(sheetname); + if sheet = nil then + raise Exception.CreateFmt(rsWorksheetNotFound, [sheetname]); + Workbook.SelectWorksheet(sheet); + end; + Worksheet.SelectCell(r, c); + end else + raise Exception.CreateFmt(rsNoValidHyperlinkInternal, [hyperlink.Target]); + end else + // Fires the OnClickHyperlink event which should open a file or a URL + if Assigned(FOnClickHyperlink) then FOnClickHyperlink(self, hyperlink); 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 - OnGetCellHint event. + is the comment and/or the hyperlink attached to a cell; it can further be + 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; diff --git a/components/fpspreadsheet/fpsreaderwriter.pas b/components/fpspreadsheet/fpsreaderwriter.pas index c1342b98a..7c219a28f 100644 --- a/components/fpspreadsheet/fpsreaderwriter.pas +++ b/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. diff --git a/components/fpspreadsheet/fpsstrings.pas b/components/fpspreadsheet/fpsstrings.pas index 01988e16f..cf5f0b085 100644 --- a/components/fpspreadsheet/fpsstrings.pas +++ b/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? diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index 2ef8d7991..963ddd36e 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/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 - workbook, or a URI } - TsHyperlinkKind = (hkNone, hkCell, hkURI); - + (* + {@@ Specifies whether a hyperlink refers to an internal cell address + within the current workbook, or a URI (file://, http://, mailto, etc). } + 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 - jumping the a cell address within the current workbook, - or opens a URL - @param Target Target of hyperlink (cell address, filename, URL) + @param Target Target of hyperlink: URI of file, web link, mail; or: + internal link (# followed by cell address) @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; diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index c7f9ed795..bd8bc8bba 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/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; - ACell: PCell); override; - procedure WriteHYPERLINKRecord(AStream: TStream; AHyperlink: PsHyperlink; + procedure WriteHyperlink(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 - hkCell: - flags := MASK_HLINK_TEXTMARK or MASK_HLINK_DESCRIPTION; - hkURI: - flags := MASK_HLINK_LINK or MASK_HLINK_ABSOLUTE; - end; + if isInternal then + flags := MASK_HLINK_TEXTMARK or MASK_HLINK_DESCRIPTION + else + flags := MASK_HLINK_LINK or MASK_HLINK_ABSOLUTE; if descr <> AHyperlink^.Target then flags := flags or MASK_HLINK_DESCRIPTION; // has description - if markpos > 0 then // has # in target - flags := flags or MASK_HLINK_TEXTMARK; + if bookmark <> '' then + 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 - if markpos > 0 then - widestr := UTF8Decode(UTF8Copy(AHyperlink^.Target, markpos+1, Length(AHyperlink^.Target))) - else if AHyperlink^.Kind = hkCell then - widestr := UTF8Decode(AHyperlink^.Target); + // Convert to 16-bit characters + widestr := UTF8Decode(bookmark); { 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 diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index e80044f65..7ee15e9f6 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/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; - Location: String; + Target: 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 - hyperlinkData.Kind := hkURI + if s <> 'External' then // Only "External" accepted! + 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 - s := Format('%s location="%s"', [s, hyperlink^.Target]); + if target = '' then + 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