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

fpspreadsheet: Initial version of TsWorkbookChartSource (will replace TsWorksheetChartSource)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3865 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-01-03 20:03:55 +00:00
parent 4f9cf13e5f
commit 98b35354b6
4 changed files with 457 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
components/fpspreadsheet/fpspreadsheet.pas
View File

@@ -97,6 +97,7 @@ type
{@@ These tokens identify basic operations in RPN formulas. }
TBasicOperationTokens = fekAdd..fekParen;
type
{@@ Flags to mark the address or a cell or a range of cells to be <b>absolute</b>
or <b>relative</b>. They are used in the set TsRelFlags. }
TsRelFlag = (rfRelRow, rfRelCol, rfRelRow2, rfRelCol2);
@@ -105,6 +106,14 @@ type
or <b>relative</b>. It is a set consisting of TsRelFlag elements. }
TsRelFlags = set of TsRelFlag;
const
{@@ Abbreviation of all-relative cell reference flags }
rfAllRel = [rfRelRow, rfRelCol, rfRelRow2, rfRelCol2];
{@@ Separator between worksheet name and cell (range) reference in an address }
SHEETSEPARATOR = '!';
type
{@@ Elements of an expanded formula.
Note: If ElementKind is fekCellOffset, "Row" and "Col" have to be cast
to signed integers! }
@@ -591,6 +600,7 @@ type
destructor Destroy; override;
{ Utils }
class function CellInRange(ARow, ACol: Cardinal; ARange: TsCellRange): Boolean;
class function CellPosToText(ARow, ACol: Cardinal): string;
procedure RemoveAllCells;
procedure UpdateCaches;
@@ -1840,6 +1850,17 @@ begin
cell^.CalcState := csNotCalculated;
end;
{@@ ----------------------------------------------------------------------------
Checks whether a cell given by its row and column indexes belongs to a
specified rectangular cell range.
-------------------------------------------------------------------------------}
class function TsWorksheet.CellInRange(ARow, ACol: Cardinal;
ARange: TsCellRange): Boolean;
begin
Result := (ARow >= ARange.Row1) and (ARow <= ARange.Row2) and
(ACol >= ARange.Col1) and (ACol <= ARange.Col2);
end;
{@@ ----------------------------------------------------------------------------
Converts a FPSpreadsheet cell position, which is Row, Col in numbers
and zero based - e.g. 0,0 - to a textual representation which is [Col][Row],

359
components/fpspreadsheet/fpspreadsheetchart.pas
View File

@@ -17,7 +17,7 @@ uses
// TChart
{tasources,} TACustomSource,
// FPSpreadsheet Visual
fpspreadsheetgrid,
fpspreadsheetctrls, fpspreadsheetgrid,
// FPSpreadsheet
fpspreadsheet, fpsutils;
@@ -31,6 +31,8 @@ type
{ TsWorksheetChartSource }
{ DEPRECTATED - use TsWorkbookChartSource instead! }
TsWorksheetChartSource = class(TCustomChartSource)
private
FInternalWorksheet: TsWorksheet;
@@ -71,15 +73,60 @@ type
property YSelectionDirection: TsSelectionDirection read FYSelectionDirection write SetYSelectionDirection;
end;
{ TsWorkbookChartSource }
TsXYRange = (rngX, rngY);
TsWorkbookChartSource = class(TCustomChartSource)
private
FWorkbookSource: TsWorkbookSource;
FWorkbook: TsWorkbook;
FWorksheets: array[TsXYRange] of TsWorksheet;
FRanges: array[TsXYRange] of TsCellRangeArray;
FDirections: array[TsXYRange] of TsSelectionDirection;
FPointsNumber: Cardinal;
function GetRange(AIndex: TsXYRange): String;
function GetWorkbook: TsWorkbook;
procedure GetXYItem(XOrY:TsXYRange; APointIndex: Integer;
out ANumber: Double; out AText: String);
procedure SetRange(AIndex: TsXYRange; const AValue: String);
procedure SetWorkbookSource(AValue: TsWorkbookSource);
protected
FCurItem: TChartDataItem;
function CountValues(AIndex: TsXYRange): Integer;
function GetCount: Integer; override;
function GetItem(AIndex: Integer): PChartDataItem; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetYCount(AValue: Cardinal); override;
public
destructor Destroy; override;
procedure ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil);
procedure Reset;
property PointsNumber: Cardinal read FPointsNumber;
property Workbook: TsWorkbook read GetWorkbook;
published
property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource;
property XRange: String index rngX read GetRange write SetRange;
property YRange: String index rngY read GetRange write SetRange;
end;
procedure Register;
implementation
uses
Math;
procedure Register;
begin
RegisterComponents('Chart', [TsWorksheetChartSource]);
RegisterComponents('Chart', [TsWorksheetChartSource, TsWorkbookChartSource]);
end;
{ TsWorksheetChartSource }
procedure TsWorksheetChartSource.SetPointsNumber(const AValue: Integer);
@@ -218,4 +265,312 @@ begin
FPointsNumber := lXCount;
end;
{------------------------------------------------------------------------------}
{ TsWorkbookChartSource }
{------------------------------------------------------------------------------}
destructor TsWorkbookChartSource.Destroy;
begin
if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self);
inherited Destroy;
end;
{@@ ----------------------------------------------------------------------------
Counts the number of x or y values contained in the x/y ranges
-------------------------------------------------------------------------------}
function TsWorkbookChartSource.CountValues(AIndex: TsXYRange): Integer;
var
ir: Integer;
begin
Result := 0;
case FDirections[AIndex] of
fpsVerticalSelection:
for ir:=0 to High(FRanges[AIndex]) do
inc(Result, FRanges[AIndex, ir].Row2 - FRanges[AIndex, ir].Row1 + 1);
fpsHorizontalSelection:
for ir:=0 to High(FRanges[AIndex]) do
inc(Result, FRanges[AIndex, ir].Col2 - FRanges[AIndex, ir].Col1 + 1);
end;
end;
{@@ ----------------------------------------------------------------------------
Inherited ChartSource method telling the series how many data points are
available
-------------------------------------------------------------------------------}
function TsWorkbookChartSource.GetCount: Integer;
begin
Result := FPointsNumber;
end;
{@@ ----------------------------------------------------------------------------
Main ChartSource method called from the series requiring data for plotting.
Retrieves the data from the workbook.
-------------------------------------------------------------------------------}
function TsWorkbookChartSource.GetItem(AIndex: Integer): PChartDataItem;
var
dummy: String;
begin
GetXYItem(rngX, AIndex, FCurItem.X, FCurItem.Text);
GetXYItem(rngY, AIndex, FCurItem.Y, dummy);
Result := @FCurItem;
end;
{@@ ----------------------------------------------------------------------------
Getter method for the cell range used for x or y coordinates (or x labels)
@param AIndex Determines whether the methods deals with x or y values
@return An Excel string containing workbookname and cell block(s) in A1
notation. Multiple blocks are separated by the ListSeparator defined
by the workbook's FormatSettings.
-------------------------------------------------------------------------------}
function TsWorkbookChartsource.GetRange(AIndex: TsXYRange): String;
var
L: TStrings;
ir: Integer;
begin
if FWorksheets[AIndex] = nil then
begin
Result := '';
exit;
end;
L := TStringList.Create;
try
L.Delimiter := Workbook.FormatSettings.ListSeparator;
for ir:=0 to High(FRanges[AIndex]) do
L.Add(GetCellRangeString(FRanges[AIndex, ir], rfAllRel, true));
Result := FWorksheets[AIndex].Name + SHEETSEPARATOR + L.DelimitedText;
finally
L.Free;
end;
end;
{@@ ----------------------------------------------------------------------------
Getter method for the linked workbook
-------------------------------------------------------------------------------}
function TsWorkbookChartSource.GetWorkbook: TsWorkbook;
begin
if FWorkbookSource <> nil then
Result := WorkbookSource.Workbook
else
Result := nil;
FWorkbook := Result;
end;
procedure TsWorkbookChartSource.GetXYItem(XOrY:TsXYRange; APointIndex: Integer;
out ANumber: Double; out AText: String);
var
range: TsCellRange;
i, j: Integer;
len: Integer;
row, col: Cardinal;
cell: PCell;
begin
cell := nil;
i := 0;
case FDirections[XOrY] of
fpsVerticalSelection:
for j:=0 to High(FRanges[XOrY]) do begin
range := FRanges[XOrY, j];
len := range.Row2 - range.Row1 + 1;
if (APointIndex >= i) and (APointIndex < i + len) then begin
row := range.Row1 + APointIndex - i;
col := range.Col1;
cell := FWorksheets[XOrY].FindCell(row, col);
break;
end;
inc(i, len);
end;
fpsHorizontalSelection:
for j:=0 to High(FRanges[XOrY]) do begin
range := FRanges[XOrY, j];
len := range.Col2 - range.Col1 + 1;
if (APointIndex >= i) and (APointIndex < i + len) then begin
row := range.Row1;
col := range.Col1 + APointIndex - i;
cell := FWorksheets[XOrY].FindCell(row, col);
break;
end;
inc(i, len);
end;
end;
if cell = nil then begin
ANumber := NaN;
AText := '';
end else
if cell^.ContentType = cctUTF8String then begin
ANumber := APointIndex;
AText := FWorksheets[rngX].ReadAsUTF8Text(cell);
end else
begin
ANumber := FWorksheets[rngX].ReadAsNumber(cell);
AText := '';
end;
end;
{@@ ----------------------------------------------------------------------------
Notification message received from the WorkbookSource telling which
spreadsheet item has changed.
Responds to workbook changes by reading the worksheet names into the tabs,
and to worksheet changes by selecting the tab corresponding to the selected
worksheet.
@param AChangedItems Set with elements identifying whether workbook, worksheet
cell content or cell formatting has changed
@param AData Additional data, not used here
-------------------------------------------------------------------------------}
procedure TsWorkbookChartSource.ListenerNotification(
AChangedItems: TsNotificationItems; AData: Pointer = nil);
var
ir: Integer;
cell: PCell;
ResetDone: Boolean;
xy: TsXYRange;
begin
Unused(AData);
// Worksheet changes
if (lniWorksheet in AChangedItems) and (Workbook <> nil) then
Reset;
// Cell changes: Enforce recalculation of axes if modified cell is within the
// x or y range(s).
if (lniCell in AChangedItems) and (Workbook <> nil) then
begin
cell := PCell(AData);
if (cell <> nil) then begin
ResetDone := false;
for xy in TsXYrange do
for ir:=0 to High(FRanges[xy]) do
begin
if FWorksheets[xy].CellInRange(cell^.Row, cell^.Col, FRanges[xy, ir]) then
begin
Reset;
ResetDone := true;
break;
end;
if ResetDone then break;
end;
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Standard component notification: The ChartSource is notified that the
WorkbookSource is being removed.
-------------------------------------------------------------------------------}
procedure TsWorkbookChartSource.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FWorkbookSource) then
SetWorkbookSource(nil);
end;
{@@ ----------------------------------------------------------------------------
Resets internal buffers and notfies chart elements of the changes,
in particular, enforces recalculation of axis limits
-------------------------------------------------------------------------------}
procedure TsWorkbookChartSource.Reset;
begin
InvalidateCaches;
Notify;
end;
{@@ ----------------------------------------------------------------------------
Setter method for the cell range used for x or y data (or labels) in the chart
If it does not contain the worksheet name the currently active worksheet of
the WorkbookSource is assumed.
@param AIndex Distinguishes whether the method deals with x or y ranges
@param AValue String in Excel syntax containing the cell range to be
used for x or y (depending on AIndex). Can contain multiple
cell blocks which must be separator by the ListSeparator
character defined in the Workbook's FormatSettings.
-------------------------------------------------------------------------------}
procedure TsWorkbookChartSource.SetRange(AIndex: TsXYRange; const AValue: String);
var
s: String;
p, i: Integer;
L: TStrings;
sd: TsSelectionDirection;
sd0: TsSelectionDirection;
begin
if (FWorkbook = nil) then
exit;
p := pos(SHEETSEPARATOR, AValue);
if p = 0 then
begin
FWorksheets[AIndex] := FWorkbook.ActiveWorksheet;
s := AValue;
end else
begin
s := Copy(AValue, 1, p-1);
FWorksheets[AIndex] := FWorkbook.GetWorksheetByName(s);
if FWorksheets[AIndex] = nil then
raise Exception.CreateFmt('%s cell range "%s" is in a non-existing '+
'worksheet.', [''+char(ord('x')+ord(AIndex)), AValue]);
s := Copy(AValue, p+1, Length(AValue));
end;
L := TStringList.Create;
try
L.Delimiter := FWorkbook.FormatSettings.ListSeparator;
L.DelimitedText := s;
if L.Count = 0 then
raise Exception.CreateFmt('No %s cell range contained in "%s".',
[''+char(ord('x')+ord(AIndex)), AValue]
);
sd := fpsVerticalSelection;
SetLength(FRanges[AIndex], L.Count);
for i:=0 to L.Count-1 do
if ParseCellRangeString(L[i], FRanges[AIndex, i]) then begin
if FRanges[AIndex, i].Col1 = FRanges[AIndex, i].Col2 then
sd := fpsVerticalSelection
else
if FRanges[AIndex, i].Row1 = FRanges[AIndex, i].Row2 then
sd := fpsHorizontalSelection
else
raise Exception.Create('Selection can only be 1 column wide or 1 row high');
end else
raise Exception.CreateFmt('No valid %s cell range in "%s".',
[''+char(ord('x')+ord(AIndex)), L[i]]
);
FPointsNumber := Max(CountValues(rngX), CountValues(rngY));
// If x and y ranges are of different size empty data points will be plotted.
Reset;
finally
L.Free;
end;
end;
{@@ ----------------------------------------------------------------------------
Setter method for the WorkbookSource
-------------------------------------------------------------------------------}
procedure TsWorkbookChartSource.SetWorkbookSource(AValue: TsWorkbookSource);
begin
if AValue = FWorkbookSource then
exit;
if FWorkbookSource <> nil then
FWorkbookSource.RemoveListener(self);
FWorkbookSource := AValue;
if FWorkbookSource <> nil then
FWorkbookSource.AddListener(self);
FWorkbook := GetWorkbook;
ListenerNotification([lniWorkbook, lniWorksheet]);
end;
{@@ ----------------------------------------------------------------------------
Inherited ChartSource method telling the series how many y values are used.
Currently we support only single valued data
-------------------------------------------------------------------------------}
procedure TsWorkbookChartSource.SetYCount(AValue: Cardinal);
begin
FYCount := AValue;
// currently not used
end;
end.

14
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

@@ -423,7 +423,7 @@ implementation
uses
Types, Math, TypInfo, LCLType, Dialogs, Forms,
fpsStrings, fpsUtils, fpSpreadsheetGrid;
fpsStrings, fpsUtils, fpSpreadsheetGrid, fpSpreadsheetChart;
{@@ ----------------------------------------------------------------------------
@@ -898,7 +898,11 @@ begin
else
if TObject(FListeners[i]) is TsSpreadsheetInspector then
TsSpreadsheetInspector(FListeners[i]).ListenerNotification(AChangedItems, AData)
else {
else
if TObject(FListeners[i]) is TsWorkbookChartSource then
TsWorkbookChartSource(FListeners[i]).ListenerNotification(AChangedItems, AData)
else
{
if TObject(FListeners[i]) is TsSpreadsheetAction then
TsSpreadsheetAction(FListeners[i]).ListenerNotifiation(AChangedItems, AData)
else }
@@ -937,7 +941,11 @@ begin
else
if (AListener is TsSpreadsheetInspector) then
TsSpreadsheetInspector(AListener).WorkbookSource := nil
else {
else
if (AListener is TsWorkbookChartSource) then
TsWorkbookChartSource(AListener).WorkbookSource := nil
else
{
if (AListener is TsSpreadsheetAction) then
TsSpreadsheetAction(AListener).WorksheetLink := nil
else }

72
components/fpspreadsheet/fpsutils.pas
View File

@@ -72,6 +72,10 @@ function ParseCellRangeString(const AStr: string;
out AFlags: TsRelFlags): Boolean; overload;
function ParseCellRangeString(const AStr: string;
out AFirstCellRow, AFirstCellCol, ALastCellRow, ALastCellCol: Cardinal): Boolean; overload;
function ParseCellRangeString(const AStr: String;
out ARange: TsCellRange; out AFlags: TsRelFlags): Boolean; overload;
function ParseCellRangeString(const AStr: String;
out ARange: TsCellRange): Boolean; overload;
function ParseCellString(const AStr: string;
out ACellRow, ACellCol: Cardinal; out AFlags: TsRelFlags): Boolean; overload;
function ParseCellString(const AStr: string;
@@ -82,11 +86,13 @@ function ParseCellColString(const AStr: string;
out AResult: Cardinal): Boolean;
function GetColString(AColIndex: Integer): String;
function GetCellString(ARow,ACol: Cardinal;
AFlags: TsRelFlags = [rfRelRow, rfRelCol]): String;
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags = [rfRelRow, rfRelCol, rfRelRow2, rfRelCol2];
Compact: Boolean = false): String;
AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload;
function GetCellRangeString(ARange: TsCellRange;
AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload;
function GetErrorValueStr(AErrorValue: TsErrorValue): String;
@@ -509,6 +515,43 @@ begin
);
end;
{@@ ----------------------------------------------------------------------------
Parses strings like A5:C10 into a range selection information.
Returns in AFlags also information on relative/absolute cells.
@param AStr Cell range string, such as A5:C10
@param ARange TsCellRange record of the zero-based row and column
indexes of the top/left and right/bottom corrners
@param AFlags a set containing an element for ARange.Row1 (top row),
ARange.Col1 (left column), ARange.Row2 (bottom row),
ARange.Col2 (right column) if they represent relative
cell addresses.
@return false if the string is not a valid cell range
--------------------------------------------------------------------------------}
function ParseCellRangeString(const AStr: String;
out ARange: TsCellRange; out AFlags: TsRelFlags): Boolean;
begin
Result := ParseCelLRangeString(AStr, ARange.Row1, ARange.Col1, ARange.Row2,
ARange.Col2, AFlags);
end;
{@@ ----------------------------------------------------------------------------
Parses strings like A5:C10 into a range selection information.
Information on relative/absolute cells is ignored.
@param AStr Cell range string, such as A5:C10
@param ARange TsCellRange record of the zero-based row and column
indexes of the top/left and right/bottom corrners
@return false if the string is not a valid cell range
--------------------------------------------------------------------------------}
function ParseCellRangeString(const AStr: String;
out ARange: TsCellRange): Boolean;
begin
Result := ParseCellRangeString(AStr, ARange.Row1, ARange.Col1, ARange.Row2,
ARange.Col2);
end;
{@@ ----------------------------------------------------------------------------
Parses a cell string, like 'A1' into zero-based column and row numbers
Note that there can be several letters to address for more than 26 columns.
@@ -744,8 +787,7 @@ end;
--> $A1:$B3
-------------------------------------------------------------------------------}
function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal;
AFlags: TsRelFlags = [rfRelRow, rfRelCol, rfRelRow2, rfRelCol2];
Compact: Boolean = false): String;
AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String;
begin
if Compact and (ARow1 = ARow2) and (ACol1 = ACol2) then
Result := GetCellString(ARow1, ACol1, AFlags)
@@ -758,6 +800,28 @@ begin
]);
end;
{@@ ----------------------------------------------------------------------------
Calculates a cell range address string from a TsCellRange record
and the relative address state flags.
@param ARange TsCellRange record containing the zero-based indexes of
the first and last row and columns of the range
@param AFlags A set containing an entry for first and last column and
row if their addresses are relative.
@param Compact If the range consists only of a single cell and compact
is true then the simple cell string is returned (e.g. A1).
If compact is false then the cell is repeated (e.g. A1:A1)
@return Excel type of cell address range containing '$' characters for absolute
address parts and a ':' to separate the first and last cells of the
range
-------------------------------------------------------------------------------}
function GetCellRangeString(ARange: TsCellRange;
AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String;
begin
Result := GetCellRangeString(ARange.Row1, ARange.Col1, ARange.Row2, ARange.Col2,
AFlags, Compact);
end;
{@@ ----------------------------------------------------------------------------
Returns the message text assigned to an error value