pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3971 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-02-28 23:46:08 +00:00
parent 48490fd3c5
commit 58031aba3a
13 changed files with 484 additions and 282 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/fpspreadsheet/examples/fpsctrls/demo_ctrls.lpi
View File

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

2
components/fpspreadsheet/examples/fpsctrls/main.lfm
View File

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

2
components/fpspreadsheet/examples/fpsctrls/main.pas
View File

@ -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;

3
components/fpspreadsheet/fpscell.pas
View File

@ -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);

111
components/fpspreadsheet/fpsopendocument.pas
View File

@ -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

191
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -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.

34
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

@ -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;

84
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -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;

21
components/fpspreadsheet/fpsreaderwriter.pas
View File

@ -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.

6
components/fpspreadsheet/fpsstrings.pas
View File

@ -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?

21
components/fpspreadsheet/fpstypes.pas
View File

@ -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;

242
components/fpspreadsheet/xlsbiff8.pas
View File

@ -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

48
components/fpspreadsheet/xlsxooxml.pas
View File

@ -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