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 @@
-
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(
'' +
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(
''+
'%s'+
- '', [link, txt]);
+ '', [target, txt]);
end else
textp := '' + txt + '';
@@ -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(
'' +
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 + ' ';
- hkCell: s := s + ' (internal cell reference)';
- hkURI : s := s + ' (external URI)';
- end;
- end else
- s := '';
- 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 type of content 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],
'');
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