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

fpspreadsheet: Add spreadsheet function "=HYPERLINK(link, cell_text)"

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3995 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-03-05 20:07:15 +00:00
parent 016c43335d
commit 52515073d2
4 changed files with 131 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files

135
components/fpspreadsheet/fpsexprparser.pas
View File

@ -84,7 +84,7 @@ type
TsFormulaDialect = (fdExcel, fdOpenDocument);
TsResultType = (rtEmpty, rtBoolean, rtInteger, rtFloat, rtDateTime, rtString,
rtCell, rtCellRange, rtError, rtAny);
rtCell, rtCellRange, rtHyperlink, rtError, rtAny);
TsResultTypes = set of TsResultType;
TsExpressionResult = record
@ -99,6 +99,7 @@ type
rtDateTime : (ResDateTime : TDatetime);
rtCell : (ResRow, ResCol : Cardinal);
rtCellRange : (ResCellRange : TsCellRange);
rtHyperlink : ();
rtString : ();
end;
PsExpressionResult = ^TsExpressionResult;
@ -826,6 +827,9 @@ procedure RegisterFunction(const AName: ShortString; const AResultType: Char;
var
ExprFormatSettings: TFormatSettings;
const
HYPERLINK_SEPARATOR = '|#@#|'; // Separats link and caption parts of a hyperlink
const
AllBuiltIns = [bcMath, bcStatistics, bcStrings, bcLogical, bcDateTime, bcLookup,
bcInfo, bcUser];
@ -3994,25 +3998,27 @@ end;
function ArgToInt(Arg: TsExpressionResult): Integer;
var
cell: PCell;
s: String;
begin
Result := 0;
case Arg.ResultType of
rtInteger : result := Arg.ResInteger;
rtFloat : result := trunc(Arg.ResFloat);
rtDateTime : result := trunc(Arg.ResDateTime);
rtBoolean : if Arg.ResBoolean then Result := 1 else Result := 0;
rtString : if not TryStrToInt(Arg.ResString, Result) then Result := 0;
rtCell : begin
cell := ArgToCell(Arg);
if Assigned(cell) then
case cell^.ContentType of
cctNumber : result := trunc(cell^.NumberValue);
cctDateTime : result := trunc(cell^.DateTimeValue);
cctBool : if cell^.BoolValue then result := 1;
cctUTF8String: if not TryStrToInt(cell^.UTF8StringValue, result)
then Result := 0;
end;
end;
rtInteger : result := Arg.ResInteger;
rtFloat : result := trunc(Arg.ResFloat);
rtDateTime : result := trunc(Arg.ResDateTime);
rtBoolean : if Arg.ResBoolean then Result := 1 else Result := 0;
rtString,
rtHyperlink : TryStrToInt(ArgToString(Arg), Result);
rtCell : begin
cell := ArgToCell(Arg);
if Assigned(cell) then
case cell^.ContentType of
cctNumber : result := trunc(cell^.NumberValue);
cctDateTime : result := trunc(cell^.DateTimeValue);
cctBool : if cell^.BoolValue then result := 1;
cctUTF8String: if not TryStrToInt(cell^.UTF8StringValue, result)
then Result := 0;
end;
end;
end;
end;
@ -4027,26 +4033,26 @@ var
begin
Result := 0.0;
case Arg.ResultType of
rtInteger : result := Arg.ResInteger;
rtDateTime : result := Arg.ResDateTime;
rtFloat : result := Arg.ResFloat;
rtBoolean : if Arg.ResBoolean then Result := 1.0 else Result := 0.0;
rtString : if not TryStrToFloat(Arg.ResString, Result) then Result := 0.0;
rtCell : begin
cell := ArgToCell(Arg);
if Assigned(cell) then
case cell^.ContentType of
cctNumber : Result := cell^.NumberValue;
cctDateTime : Result := cell^.DateTimeValue;
cctBool : if cell^.BoolValue then result := 1.0;
cctUTF8String: begin
fs := Arg.Worksheet.Workbook.FormatSettings;
s := cell^.UTF8StringValue;
if not TryStrToFloat(s, result, fs) then
result := 0.0;
end;
end;
end;
rtInteger : result := Arg.ResInteger;
rtDateTime : result := Arg.ResDateTime;
rtFloat : result := Arg.ResFloat;
rtBoolean : if Arg.ResBoolean then Result := 1.0;
rtString,
rtHyperlink : TryStrToFloat(ArgToString(Arg), Result);
rtCell : begin
cell := ArgToCell(Arg);
if Assigned(cell) then
case cell^.ContentType of
cctNumber : Result := cell^.NumberValue;
cctDateTime : Result := cell^.DateTimeValue;
cctBool : if cell^.BoolValue then result := 1.0;
cctUTF8String: begin
fs := Arg.Worksheet.Workbook.FormatSettings;
s := cell^.UTF8StringValue;
TryStrToFloat(s, result, fs);
end;
end;
end;
end;
end;
@ -4061,10 +4067,10 @@ begin
rtInteger : Result := Arg.ResInteger;
rtFloat : Result := Arg.ResFloat;
rtBoolean : if Arg.ResBoolean then Result := 1.0;
rtString : begin
rtString,
rtHyperlink : begin
fs := Arg.Worksheet.Workbook.FormatSettings;
if not TryStrToDateTime(Arg.ResString, Result, fs) then
Result := 1.0;
TryStrToDateTime(ArgToString(Arg), Result, fs);
end;
rtCell : begin
cell := ArgToCell(Arg);
@ -4084,30 +4090,31 @@ var
begin
Result := '';
case Arg.ResultType of
rtString : result := Arg.ResString;
rtInteger : Result := IntToStr(Arg.ResInteger);
rtFloat : Result := FloatToStr(Arg.ResFloat);
rtBoolean : if Arg.ResBoolean then Result := '1' else Result := '0';
rtCell : begin
cell := ArgToCell(Arg);
if Assigned(cell) then
case cell^.ContentType of
cctUTF8String : Result := cell^.UTF8Stringvalue;
cctNumber : Result := Format('%g', [cell^.NumberValue]);
cctBool : if cell^.BoolValue then Result := '1' else Result := '0';
cctDateTime : begin
fs := Arg.Worksheet.Workbook.FormatSettings;
dt := cell^.DateTimeValue;
if frac(dt) = 0.0 then
Result := FormatDateTime(fs.LongTimeFormat, dt, fs)
else
if trunc(dt) = 0 then
Result := FormatDateTime(fs.ShortDateFormat, dt, fs)
else
Result := FormatDateTime('cc', dt, fs);
end;
end;
end;
rtString,
rtHyperlink : result := Arg.ResString;
rtInteger : Result := IntToStr(Arg.ResInteger);
rtFloat : Result := FloatToStr(Arg.ResFloat);
rtBoolean : if Arg.ResBoolean then Result := '1' else Result := '0';
rtCell : begin
cell := ArgToCell(Arg);
if Assigned(cell) then
case cell^.ContentType of
cctUTF8String : Result := cell^.UTF8Stringvalue;
cctNumber : Result := Format('%g', [cell^.NumberValue]);
cctBool : if cell^.BoolValue then Result := '1' else Result := '0';
cctDateTime : begin
fs := Arg.Worksheet.Workbook.FormatSettings;
dt := cell^.DateTimeValue;
if frac(dt) = 0.0 then
Result := FormatDateTime(fs.LongTimeFormat, dt, fs)
else
if trunc(dt) = 0 then
Result := FormatDateTime(fs.ShortDateFormat, dt, fs)
else
Result := FormatDateTime('cc', dt, fs);
end;
end;
end;
end;
end;

27
components/fpspreadsheet/fpsfunc.pas
View File

@ -1530,6 +1530,29 @@ begin
end;
{------------------------------------------------------------------------------}
{ Builtin lookup/reference functions }
{------------------------------------------------------------------------------}
procedure fpsHYPERLINK(var Result: TsExpressionResult;
const Args: TsExprParameterArray);
begin
if Args[0].ResultType = rtError then
begin
Result := ErrorResult(errWrongType);
exit;
end;
if (Length(Args) > 1) and (Args[1].ResultType = rtError) then
begin
Result := ErrorResult(errWrongType);
exit;
end;
Result.ResString := ArgToString(Args[0]);
if Length(Args) > 1 then Result.ResString := Result.ResString + HYPERLINK_SEPARATOR + ArgToString(Args[1]);
Result.ResultType := rtHyperlink;
end;
{------------------------------------------------------------------------------}
{ Registration }
{------------------------------------------------------------------------------}
@ -1651,9 +1674,11 @@ begin
AddFunction(cat, 'ISREF', 'B', '?', INT_EXCEL_SHEET_FUNC_ISREF, @fpsISREF);
AddFunction(cat, 'ISTEXT', 'B', '?', INT_EXCEL_SHEET_FUNC_ISTEXT, @fpsISTEXT);
(*
// Lookup / reference functions
cat := bcLookup;
AddFunction(cat, 'HYPERLINK', 'S', 'Ss', INT_EXCEL_SHEET_FUNC_HYPERLINK, @fpsHYPERLINK);
(*
AddFunction(cat, 'COLUMN', 'I', 'R', INT_EXCEL_SHEET_FUNC_COLUMN, @fpsCOLUMN);
*)

53
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -1147,6 +1147,8 @@ var
res: TsExpressionResult;
formula: String;
cell: PCell;
p: Integer;
link, txt: String;
begin
ACell^.Flags := ACell^.Flags + [cfCalculating] - [cfCalculated];
@ -1174,27 +1176,36 @@ begin
end;
case res.ResultType of
rtEmpty : WriteBlank(ACell);
rtError : WriteErrorValue(ACell, res.ResError);
rtInteger : WriteNumber(ACell, res.ResInteger);
rtFloat : WriteNumber(ACell, res.ResFloat);
rtDateTime : WriteDateTime(ACell, res.ResDateTime);
rtString : WriteUTF8Text(ACell, res.ResString);
rtBoolean : WriteBoolValue(ACell, res.ResBoolean);
rtCell : begin
cell := FindCell(res.ResRow, res.ResCol);
if cell = nil then
WriteBlank(ACell)
else
case cell^.ContentType of
cctNumber : WriteNumber(ACell, cell^.NumberValue);
cctDateTime : WriteDateTime(ACell, cell^.DateTimeValue);
cctUTF8String: WriteUTF8Text(ACell, cell^.UTF8StringValue);
cctBool : WriteBoolValue(ACell, cell^.Boolvalue);
cctError : WriteErrorValue(ACell, cell^.ErrorValue);
cctEmpty : WriteBlank(ACell);
end;
end;
rtEmpty : WriteBlank(ACell);
rtError : WriteErrorValue(ACell, res.ResError);
rtInteger : WriteNumber(ACell, res.ResInteger);
rtFloat : WriteNumber(ACell, res.ResFloat);
rtDateTime : WriteDateTime(ACell, res.ResDateTime);
rtString : WriteUTF8Text(ACell, res.ResString);
rtHyperlink : begin
link := ArgToString(res);
p := pos(HYPERLINK_SEPARATOR, link);
if p > 0 then
begin
txt := Copy(link, p+Length(HYPERLINK_SEPARATOR), Length(link));
link := Copy(link, 1, p-1);
end else
txt := link;
WriteHyperlink(ACell, link);
WriteUTF8Text(ACell, txt);
end;
rtBoolean : WriteBoolValue(ACell, res.ResBoolean);
rtCell : begin
cell := GetCell(res.ResRow, res.ResCol);
case cell^.ContentType of
cctNumber : WriteNumber(ACell, cell^.NumberValue);
cctDateTime : WriteDateTime(ACell, cell^.DateTimeValue);
cctUTF8String: WriteUTF8Text(ACell, cell^.UTF8StringValue);
cctBool : WriteBoolValue(ACell, cell^.Boolvalue);
cctError : WriteErrorValue(ACell, cell^.ErrorValue);
cctEmpty : WriteBlank(ACell);
end;
end;
end;
finally
parser.Free;

2
components/fpspreadsheet/xlsconst.pas
View File

@ -249,6 +249,8 @@ const
INT_EXCEL_SHEET_FUNC_COUNTBLANK = 347; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_DATEDIF = 351; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_HYPERLINK = 359; // BIFF8 only
{ Control Tokens, Special Tokens }
// 01H tExp Matrix formula or shared formula
// 02H tTbl Multiple operation table