paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
3b0e46b92c
lazarus-ccr/components/fpspreadsheet/source/common/fpsclasses.pas

1796 lines
58 KiB
ObjectPascal
Raw Blame History

unit fpsclasses;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, avglvltree,
fpstypes, fpsExprParser;
type
{ forward declarations }
TsRowColAVLTree = class;
{ TsRowCol }
TsRowCol = record
Row, Col: Cardinal;
end;
PsRowCol = ^TsRowCol;
{ TsRowColEnumerator }
TsRowColEnumerator = class
private
protected
FCurrentNode: TAvgLvlTreeNode;
FTree: TsRowColAVLTree;
FStartRow, FEndRow, FStartCol, FEndCol: LongInt;
FDone: Boolean;
FReverse: Boolean;
function GetCurrent: PsRowCol;
public
constructor Create(ATree: TsRowColAVLTree;
AStartRow, AStartCol, AEndRow, AEndCol: LongInt; AReverse: Boolean);
function GetEnumerator: TsRowColEnumerator; inline;
function MoveNext: Boolean;
property Current: PsRowCol read GetCurrent;
property StartRow: LongInt read FStartRow;
property EndRow: LongInt read FEndRow;
property StartCol: LongInt read FStartCol;
property EndCol: LongInt read FEndCol;
end;
{ TsRowColAVLTree }
TsRowColAVLTree = class(TAvgLvlTree)
private
FOwnsData: Boolean;
protected
procedure DisposeData(var AData: Pointer); virtual; abstract;
function NewData: Pointer; virtual; abstract;
public
constructor Create(AOwnsData: Boolean = true);
destructor Destroy; override;
function Add(ARow, ACol: Cardinal): PsRowCol; overload;
procedure Clear;
procedure Delete(ANode: TAvgLvlTreeNode); overload;
procedure Delete(ARow, ACol: Cardinal); overload;
procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); virtual;
procedure Exchange(ARow1, ACol1, ARow2, ACol2: Cardinal); virtual;
function FindByRowCol(ARow, ACol: Cardinal): PsRowCol; overload;
function GetData(ANode: TAvgLvlTreeNode): PsRowCol;
function GetFirst: PsRowCol;
function GetLast: PsRowCol;
procedure InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean);
procedure MoveAlongCol(ARow, ACol, AToRow: Cardinal);
procedure MoveAlongRow(ARow, ACol, AToCol: Cardinal);
procedure Remove(ARow, ACol: Cardinal); overload;
end;
{ TsCells }
TsCellEnumerator = class(TsRowColEnumerator)
protected
function GetCurrent: PCell;
public
function GetEnumerator: TsCellEnumerator; inline;
property Current: PCell read GetCurrent;
end;
TsCells = class(TsRowColAVLTree)
private
FWorksheet: TsBasicWorksheet; // Must be cast to TsWorksheet
protected
procedure DisposeData(var AData: Pointer); override;
function NewData: Pointer; override;
public
constructor Create(AWorksheet: TsBasicWorksheet; AOwnsData: Boolean = true);
function AddCell(ARow, ACol: Cardinal): PCell;
procedure DeleteCell(ARow, ACol: Cardinal);
function FindCell(ARow, ACol: Cardinal): PCell;
function GetFirstCell: PCell;
function GetFirstCellOfRow(ARow: Cardinal): PCell;
function GetLastCell: PCell;
function GetLastCellOfRow(ARow: Cardinal): PCell;
// enumerators
function GetEnumerator: TsCellEnumerator;
function GetReverseEnumerator: TsCellEnumerator;
function GetColEnumerator(ACol: Cardinal; AStartRow: Cardinal = 0;
AEndRow: Cardinal = $7FFFFFFF): TsCellEnumerator;
function GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Cardinal): TsCellEnumerator;
function GetRowEnumerator(ARow: Cardinal; AStartCol:Cardinal = 0;
AEndCol: Cardinal = $7FFFFFFF): TsCellEnumerator;
function GetReverseColEnumerator(ACol: Cardinal; AStartRow: Cardinal = 0;
AEndRow: Cardinal = $7FFFFFFF): TsCellEnumerator;
function GetReverseRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Cardinal): TsCellEnumerator;
function GetReverseRowEnumerator(ARow: Cardinal; AStartCol:Cardinal = 0;
AEndCol: Cardinal = $7FFFFFFF): TsCellEnumerator;
end;
{ TsComments }
TsCommentEnumerator = class(TsRowColEnumerator)
protected
function GetCurrent: PsComment;
public
function GetEnumerator: TsCommentEnumerator; inline;
property Current: PsComment read GetCurrent;
end;
TsComments = class(TsRowColAVLTree)
protected
procedure DisposeData(var AData: Pointer); override;
function NewData: Pointer; override;
public
function AddComment(ARow, ACol: Cardinal; AComment: String): PsComment;
procedure DeleteComment(ARow, ACol: Cardinal);
// enumerators
function GetEnumerator: TsCommentEnumerator;
function GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Cardinal): TsCommentEnumerator;
end;
{ TsHyperlinks }
TsHyperlinkEnumerator = class(TsRowColEnumerator)
protected
function GetCurrent: PsHyperlink;
public
function GetEnumerator: TsHyperlinkEnumerator; inline;
property Current: PsHyperlink read GetCurrent;
end;
TsHyperlinks = class(TsRowColAVLTree)
protected
procedure DisposeData(var AData: Pointer); override;
function NewData: Pointer; override;
public
function AddHyperlink(ARow, ACol: Cardinal; ATarget: String;
ATooltip: String = ''): PsHyperlink;
procedure DeleteHyperlink(ARow, ACol: Cardinal);
// enumerators
function GetEnumerator: TsHyperlinkEnumerator;
function GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Cardinal): TsHyperlinkEnumerator;
end;
{ TsMergedCells }
TsCellRangeEnumerator = class(TsRowColEnumerator)
protected
function GetCurrent: PsCellRange;
public
function GetEnumerator: TsCellRangeEnumerator; inline;
property Current: PsCellRange read GetCurrent;
end;
TsMergedCells = class(TsRowColAVLTree)
protected
procedure DisposeData(var AData: Pointer); override;
function NewData: Pointer; override;
public
function AddRange(ARow1, ACol1, ARow2, ACol2: Cardinal): PsCellRange;
procedure DeleteRange(ARow, ACol: Cardinal);
procedure DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean); override;
procedure Exchange(ARow1, ACol1, ARow2, ACol2: Cardinal); override;
function FindRangeWithCell(ARow, ACol: Cardinal): PsCellRange;
// enumerators
function GetEnumerator: TsCellRangeEnumerator;
end;
{ TsFormulas }
TsFormulaEnumerator = class(TsRowColEnumerator)
protected
function GetCurrent: PsFormula;
public
function GetEnumerator: TsFormulaEnumerator; inline;
property Current: PsFormula read GetCurrent;
end;
TsFormulas = class(TsRowColAVLTree)
protected
procedure DisposeData(var AData: Pointer); override;
function NewData: Pointer; override;
public
function AddFormula(ARow, ACol: Cardinal; AFormula: String = '';
AParsedFormula: TsExpressionParser = nil): PsFormula;
procedure DeleteFormula(ACell: PCell); overload;
procedure DeleteFormula(ARow, ACol: Cardinal); overload;
function FindFormula(ACell: PCell): PsFormula; overload;
function FindFormula(ARow, ACol: Cardinal): PsFormula; overload;
procedure FixReferences(AIndex: Cardinal; IsRow, IsDeleting: Boolean;
InSheet: TsBasicWorksheet);
// enumerators
function GetEnumerator: TsFormulaEnumerator;
end;
{ TsCellFormatList }
TsCellFormatList = class(TFPList)
private
FAllowDuplicates: Boolean;
function GetItem(AIndex: Integer): PsCellFormat;
procedure SetItem(AIndex: Integer; const AValue: PsCellFormat);
public
constructor Create(AAllowDuplicates: Boolean);
destructor Destroy; override;
function Add(const AItem: TsCellFormat): Integer; overload;
function Add(AItem: PsCellFormat): Integer; overload;
procedure Clear;
procedure Delete(AIndex: Integer);
function FindIndexOfID(ID: Integer): Integer;
function FindIndexOfName(AName: String): Integer;
function IndexOf(const AItem: TsCellFormat): Integer; overload;
property Items[AIndex: Integer]: PsCellFormat read GetItem write SetItem; default;
end;
{ TsIntegerStack }
TsIntegerStack = class
private
FValues: Array of Integer;
public
procedure Push(AValue: Integer);
function Pop: Integer;
end;
function FindFontInList(AFontList: TFPList; AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor; APos: TsFontPosition): Integer;
implementation
uses
Math,
fpsUtils;
{ Helper function for sorting }
function CompareRowCol(Item1, Item2: Pointer): Integer;
begin
Result := Longint(PsRowCol(Item1)^.Row) - PsRowCol(Item2)^.Row;
if Result = 0 then
Result := Longint(PsRowCol(Item1)^.Col) - PsRowCol(Item2)^.Col;
end;
{ Call-back function for formulas when rows/cols are inserted/deleted }
procedure FixDeletedCol(AExprNode: TsExprNode; AData1, AData2: Pointer;
var MustRebuildFormulas: Boolean);
var
colIndex: Cardinal;
referencedSheet, referencedSheet2: TsBasicWorksheet;
changedSheet: TsBasicWorksheet;
rng: TsCellRange;
begin
colIndex := PtrInt(AData1);
changedSheet := TsBasicWorksheet(AData2);
if AExprNode is TsCellExprNode then
begin
if TsCellExprNode(AExprNode).Error <> errOK then
exit;
referencedSheet := TsCellExprNode(AExprNode).GetSheet;
if TsCellExprNode(AExprNode).Has3dLink and (referencedSheet <> changedSheet) then
exit;
if TsCellExprNode(AExprNode).Col > colIndex then begin
TsCellExprNode(AExprNode).Col := TsCellExprNode(AExprNode).Col - 1;
MustRebuildFormulas := true;
end else
if TsCellExprNode(AExprNode).col = colIndex then begin
TsCellExprNode(AExprNode).Error := errIllegalRef;
MustRebuildFormulas := true;
end;
end
else
if AExprNode is TsCellRangeExprNode then
begin
if TsCellRangeExprNode(AExprNode).Error <> errOK then
exit;
referencedSheet := TsCellRangeExprNode(AExprNode).GetSheet(1);
referencedSheet2 := TsCellRangeExprNode(AExprNode).GetSheet(2);
if TsCellRangeExprNode(AExprNode).Has3dLink and
(referencedSheet <> changedSheet) and
(referencedSheet2 <> changedSheet)
then
exit;
rng := TsCellRangeExprNode(AExprNode).Range;
if (rng.Col1 = colIndex) and (rng.Col2 = colIndex) then begin
TsCellRangeExprNode(AExprNode).Error := errIllegalRef;
MustRebuildFormulas := true;
end else begin
if rng.Col1 > colIndex then begin
dec(rng.Col1);
MustRebuildFormulas := true;
end;
if rng.Col2 >= colIndex then begin
dec(rng.Col2);
MustRebuildFormulas := true;
end;
TsCellRangeExprNode(AExprNode).Range := rng;
end;
end;
end;
procedure FixDeletedRow(AExprNode: TsExprNode; AData1, AData2: Pointer;
var MustRebuildFormulas: Boolean);
var
rowIndex: Cardinal;
rng: TsCellRange;
changedSheet: TsBasicWorksheet;
referencedSheet, referencedSheet2: TsBasicWorksheet;
begin
rowIndex := PtrInt(AData1);
changedSheet := TsBasicWorksheet(AData2);
if AExprNode is TsCellExprNode then
begin
if TsCellExprNode(AExprNode).Error <> errOK then
exit;
referencedSheet := TsCellExprNode(AExprNode).GetSheet;
if TsCellExprNode(AExprNode).Has3dLink and (referencedSheet <> changedSheet) then
exit;
if TsCellExprNode(AExprNode).Row > rowIndex then begin
TsCellExprNode(AExprNode).Row := TsCellExprNode(AExprNode).Row - 1;
MustRebuildFormulas := true;
end else
if TsCellExprNode(AExprNode).Row = rowIndex then begin
TsCellExprNode(AExprNode).Error := errIllegalRef;
MustRebuildFormulas := true;
end;
end
else
if AExprNode is TsCellRangeExprNode then
begin
if TsCellRangeExprNode(AExprNode).Error <> errOK then
exit;
referencedSheet := TsCellRangeExprNode(AExprNode).GetSheet(1);
referencedSheet2 := TsCellRangeExprNode(AExprNode).GetSheet(2);
if TsCellRangeExprNode(AExprNode).Has3dLink and
(referencedSheet <> changedSheet) and
(referencedSheet2 <> changedSheet)
then
exit;
rng := TsCellRangeExprNode(AExprNode).Range;
if (rng.Row1 = rowIndex) and (rng.Row2 = rowIndex) then begin
TsCellRangeExprNode(AExprNode).Error := errIllegalRef;
MustRebuildFormulas := true;
end else
begin
if rng.Row1 > rowIndex then begin
dec(rng.Row1);
MustRebuildFormulas := true;
end;
if rng.Row2 >= rowIndex then begin
dec(rng.Row2);
MustRebuildFormulas := true;
end;
TsCellRangeExprNode(AExprNode).Range := rng;
end;
end;
end;
procedure FixInsertedCol(AExprNode: TsExprNode; AData1, AData2: Pointer;
var MustRebuildFormulas: Boolean);
var
colIndex: Cardinal;
changedSheet: TsBasicWorksheet;
referencedSheet, referencedSheet2: TsBasicWorksheet;
rng: TsCellRange;
begin
colIndex := PtrInt(AData1);
changedSheet := TsBasicWorksheet(AData2);
if AExprNode is TsCellExprNode then
begin
if TsCellExprNode(AExprNode).Error <> errOK then
exit;
referencedSheet := TsCellExprNode(AExprNode).GetSheet;
if TsCellExprNode(AExprNode).Has3dLink and (referencedSheet <> changedSheet) then
exit;
if TsCellExprNode(AExprNode).Col >= colIndex then begin
TsCellExprNode(AExprNode).Col := TsCellExprNode(AExprNode).Col + 1;
MustRebuildFormulas := true;
end;
end else
if AExprNode is TsCellRangeExprNode then
begin
if TsCellRangeExprNode(AExprNode).Error <> errOK then
exit;
referencedSheet := TsCellRangeExprNode(AExprNode).GetSheet(1);
referencedSheet2 := TsCellRangeExprNode(AExprNode).GetSheet(2);
if TsCellRangeExprNode(AExprNode).Has3dLink and
(referencedSheet <> changedSheet) and
(referencedSheet2 <> changedSheet)
then
exit;
rng := TsCellRangeExprNode(AExprNode).Range;
if rng.Col1 >= colIndex then begin
inc(rng.Col1);
MustRebuildFormulas := true;
end;
if rng.Col2 >= colIndex then begin
inc(rng.Col2);
MustRebuildFormulas := true;
end;
TsCellRangeExprNode(AExprNode).Range := rng;
end;
end;
procedure FixInsertedRow(AExprNode: TsExprNode; AData1, AData2: Pointer;
var MustRebuildFormulas: Boolean);
var
rowIndex: Cardinal;
changedSheet: TsBasicWorksheet;
referencedSheet, referencedSheet2: TsBasicWorksheet;
rng: TsCellRange;
begin
rowIndex := PtrInt(AData1);
changedSheet := TsBasicWorksheet(AData2);
if AExprNode is TsCellExprNode then
begin
if TsCellExprNode(AExprNode).Error <> errOK then
exit;
referencedSheet := TsCellExprNode(AExprNode).GetSheet;
if TsCellExprNode(AExprNode).Has3dLink and (referencedSheet <> changedSheet) then
exit;
if TsCellExprNode(AExprNode).Row >= rowIndex then begin
TsCellExprNode(AExprNode).Row := TsCellExprNode(AExprNode).Row + 1;
MustRebuildFormulas := true;
end;
end else
if AExprNode is TsCellRangeExprNode then
begin
if TsCellRangeExprNode(AExprNode).Error <> errOK then
exit;
referencedSheet := TsCellRangeExprNode(AExprNode).GetSheet(1);
referencedSheet2 := TsCellRangeExprNode(AExprNode).GetSheet(2);
if TsCellRangeExprNode(AExprNode).Has3dLink and
(referencedSheet <> changedSheet) and
(referencedSheet2 <> changedSheet)
then
exit;
rng := TsCellRangeExprNode(AExprNode).Range;
if rng.Row1 >= rowIndex then begin
inc(rng.Row1);
MustRebuildFormulas := true;
end;
if rng.Row2 >= rowIndex then begin
inc(rng.Row2);
MustRebuildFormulas := true;
end;
TsCellRangeExprNode(AExprNode).Range := rng;
end;
end;
{==============================================================================}
{ TsRowColEnumerator }
{ A specialized enumerator for TsRowColAVLTree using the pointers to the data }
{ records. }
{==============================================================================}
constructor TsRowColEnumerator.Create(ATree: TsRowColAVLTree;
AStartRow, AStartCol, AEndRow, AEndCol: LongInt; AReverse: Boolean);
var
node: TAvgLvlTreeNode;
begin
FTree := ATree;
FReverse := AReverse;
if AStartRow <= AEndRow then
begin
FStartRow := AStartRow;
FEndRow := AEndRow;
end else
begin
FStartRow := AEndRow;
FEndRow := AStartRow;
end;
if AStartCol <= AEndCol then
begin
FStartCol := AStartCol;
FEndCol := AEndCol;
end else
begin
FStartCol := AEndCol;
FEndCol := AStartCol;
end;
if FEndRow = $7FFFFFFF then
begin
node := FTree.FindHighest;
if node <> nil then
FEndRow := PsRowCol(node.Data)^.Row;
end;
end;
function TsRowColEnumerator.GetCurrent: PsRowCol;
begin
if Assigned(FCurrentNode) then
Result := PsRowCol(FCurrentNode.Data)
else
Result := nil;
end;
function TsRowColEnumerator.GetEnumerator: TsRowColEnumerator;
begin
Result := self;
end;
function TsRowColEnumerator.MoveNext: Boolean;
var
curr: PsRowCol;
rc: TsRowCol;
begin
Result := false;
if FCurrentNode <> nil then begin
if FReverse then
begin
FCurrentNode := FTree.FindPrecessor(FCurrentNode);
if FCurrentNode <> nil then
begin
curr := PsRowCol(FCurrentNode.Data);
if not InRange(LongInt(curr^.Col), FStartCol, FEndCol) then
begin
rc := curr^;
if LongInt(rc.Col) < FStartCol then
dec(LongInt(rc.Row));
rc.Col := FEndCol;
FCurrentNode := FTree.FindNearest(@rc);
if FCurrentNode <> nil then begin
curr := PsRowCol(FCurrentNode.Data);
while (FCurrentNode <> nil) and
not (InRange(curr^.Row, FStartRow, FEndRow) and InRange(curr^.Col, FStartCol, FEndCol))
do begin
FCurrentNode := FTree.FindPrecessor(FCurrentNode);
if FCurrentNode <> nil then curr := PsRowCol(FCurrentNode.Data);
end;
end;
end;
end;
end else
begin
FCurrentNode := FTree.FindSuccessor(FCurrentNode);
if FCurrentNode <> nil then
begin
curr := PsRowCol(FCurrentNode.Data);
rc.Col := FStartCol;
if LongInt(rc.Col) > FEndCol then inc(rc.Row);
if not InRange(LongInt(curr^.Col), FStartCol, FEndCol) then
begin
rc := curr^;
if LongInt(rc.Col) > FEndCol then inc(rc.Row);
rc.Col := FStartCol;
FCurrentNode := FTree.FindNearest(@rc);
if FCurrentNode <> nil then
begin
curr := PsRowCol(FCurrentNode.Data);
if (LongInt(curr^.Col) < FStartCol) then
while (FCurrentNode <> nil) and not InRange(curr^.Col, FStartCol, FEndCol) do
begin
FCurrentNode := FTree.FindSuccessor(FCurrentNode);
if FCurrentNode <> nil then curr := PsRowCol(FCurrentNode.Data);
end;
while (FCurrentNode <> nil) and
not (InRange(curr^.Row, FStartRow, FEndRow) and InRange(curr^.Col, FStartCol, FEndCol))
do begin
FCurrentNode := FTree.FindSuccessor(FCurrentNode);
if FCurrentNode <> nil then curr := PsRowCol(FCurrentNode.Data);
end;
end;
end;
end;
end;
Result := (FCurrentNode <> nil) and
InRange(curr^.Col, FStartCol, FEndCol) and
InRange(curr^.Row, FStartRow, FEndRow);
end else
begin
if FReverse then
begin
rc.Row := FEndRow;
rc.Col := FEndCol;
FCurrentNode := FTree.FindNearest(@rc);
if FCurrentNode <> nil then
curr := PsRowCol(FCurrentNode.Data);
while (FCurrentNode <> nil) and
not (InRange(curr^.Row, FStartRow, FEndRow) and InRange(curr^.Col, FStartCol, FEndCol))
do begin
FCurrentNode := FTree.FindPrecessor(FCurrentNode);
if FCurrentNode <> nil then curr := PsRowCol(FCurrentNode.Data);
end;
end else
begin
rc.Row := FStartRow;
rc.Col := FStartCol;
FCurrentNode := FTree.FindNearest(@rc);
if FCurrentNode <> nil then
curr := PsRowCol(FCurrentNode.Data);
while (FCurrentNode <> nil) and
not (InRange(curr^.Row, FStartRow, FEndRow) and InRange(curr^.Col, FStartCol, FEndCol))
do begin
FCurrentNode := FTree.FindSuccessor(FCurrentNode);
if FCurrentNode <> nil then curr := PsRowCol(FCurrentNode.Data);
end;
end;
Result := (FCurrentNode <> nil);
end;
end;
{==============================================================================}
{ TsRowColAVLTree: A specialized AVLTree working with records containing }
{ row and column indexes. }
{==============================================================================}
{@@ ----------------------------------------------------------------------------
Constructor of the AVLTree. Installs a compare procedure for row and column
indexes. If AOwnsData is true then the tree automatically destroys the
data records attached to the tree nodes.
-------------------------------------------------------------------------------}
constructor TsRowColAVLTree.Create(AOwnsData: Boolean = true);
begin
inherited Create(@CompareRowCol);
FOwnsData := AOwnsData;
end;
{@@ ----------------------------------------------------------------------------
Destructor of the AVLTree. Clears the tree nodes and, if the tree has been
created with AOwnsData=true, destroys the data records
-------------------------------------------------------------------------------}
destructor TsRowColAVLTree.Destroy;
begin
Clear;
inherited;
end;
{@@ ----------------------------------------------------------------------------
Adds a new node to the tree identified by the specified row and column
indexes.
-------------------------------------------------------------------------------}
function TsRowColAVLTree.Add(ARow, ACol: Cardinal): PsRowCol;
begin
Result := NewData;
Result^.Row := ARow;
Result^.Col := ACol;
inherited Add(Result);
end;
{@@ ----------------------------------------------------------------------------
Clears the tree, i.e, destroys the data records (if the tree has been created
with AOwnsData = true) and removes all nodes.
-------------------------------------------------------------------------------}
procedure TsRowColAVLTree.Clear;
var
node, nextnode: TAvgLvlTreeNode;
begin
node := FindLowest;
while node <> nil do begin
nextnode := FindSuccessor(node);
Delete(node);
node := nextnode;
end;
end;
{@@ ----------------------------------------------------------------------------
Removes the specified node from the tree. If the tree has been created with
AOwnsData = true then the data record is destroyed as well
-------------------------------------------------------------------------------}
procedure TsRowColAVLTree.Delete(ANode: TAvgLvlTreeNode);
begin
if FOwnsData and Assigned(ANode) then
DisposeData(PsRowCol(ANode.Data));
inherited Delete(ANode);
end;
procedure TsRowColAVLTree.Delete(ARow, ACol: Cardinal);
var
node: TAvgLvlTreeNode;
cell: TCell;
begin
cell.Row := ARow;
cell.Col := ACol;
node := inherited Find(@cell);
if Assigned(node) then
Delete(node);
end;
{@@ ----------------------------------------------------------------------------
This procedure adjusts row or column indexes stored in the tree nodes if a
row or column will be deleted from the underlying worksheet.
@param AIndex Index of the row (if IsRow=true) or column (if IsRow=false)
to be deleted
@param IsRow Identifies whether AIndex refers to a row or column index
-------------------------------------------------------------------------------}
procedure TsRowColAVLTree.DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean);
var
node, nextnode: TAvgLvlTreeNode;
item: PsRowCol;
begin
node := FindLowest;
while Assigned(node) do begin
nextnode := FindSuccessor(node);
item := PsRowCol(node.Data);
if IsRow then
begin
// Update all RowCol records at row indexes above the deleted row
if item^.Row > AIndex then
dec(item^.Row)
else
// Remove and destroy the RowCol record if it is in the deleted row
if item^.Row = AIndex then
Delete(node);
end else
begin
// Update all RowCol records at column indexes above the deleted column
if item^.Col > AIndex then
dec(item^.Col)
else
// Remove the RowCol record if it is in the deleted column
if item^.Col = AIndex then
Delete(node);
end;
node := nextnode;
end;
end;
{@@ ----------------------------------------------------------------------------
Exchanges two nodes
-------------------------------------------------------------------------------}
procedure TsRowColAVLTree.Exchange(ARow1, ACol1, ARow2, ACol2: Cardinal);
var
item1, item2: PsRowCol;
begin
item1 := FindByRowCol(ARow1, ACol1);
item2 := FindByRowCol(ARow2, ACol2);
// There are entries for both locations: Exchange row/col indexes
if (item1 <> nil) and (item2 <> nil) then
begin
Remove(item1);
Remove(item2);
item1^.Row := ARow2;
item1^.Col := ACol2;
item2^.Row := ARow1;
item2^.Col := ACol1;
inherited Add(item1); // The items are sorted to the correct position
inherited Add(item2); // when they are added to the tree
end else
// Only the 1st item exists --> give it the row/col indexes of the 2nd item
if (item1 <> nil) then
begin
Remove(item1);
item1^.Row := ARow2;
item1^.Col := ACol2;
inherited Add(item1);
end else
// Only the 2nd item exists --> give it the row/col indexes of the 1st item
if (item2 <> nil) then
begin
Remove(item2);
item2^.Row := ARow1;
item2^.Col := ACol1;
inherited Add(item2); // just adds the existing item at the new position
end;
end;
{@@ ----------------------------------------------------------------------------
Seeks the entire tree for a node of the specified row and column indexes and
returns a pointer to the data record.
Returns nil if such a node does not exist
-------------------------------------------------------------------------------}
function TsRowColAVLTree.FindByRowCol(ARow, ACol: Cardinal): PsRowCol;
var
data: TsRowCol;
node: TAvgLvlTreeNode;
begin
Result := nil;
if (Count = 0) then
exit;
data.Row := ARow;
data.Col := ACol;
node := inherited Find(@data);
if Assigned(node) then
Result := PsRowCol(node.Data);
end;
{@@ ----------------------------------------------------------------------------
Extracts the pointer to the data record from a tree node
-------------------------------------------------------------------------------}
function TsRowColAVLTree.GetData(ANode: TAvgLvlTreeNode): PsRowCol;
begin
if ANode <> nil then
Result := PsRowCol(ANode.Data)
else
Result := nil;
end;
{@@ ----------------------------------------------------------------------------
The combination of the methods GetFirst and GetNext allow a fast iteration
through all nodes of the tree.
-------------------------------------------------------------------------------}
function TsRowColAVLTree.GetFirst: PsRowCol;
begin
Result := GetData(FindLowest);
end;
function TsRowColAVLTree.GetLast: PsRowCol;
begin
Result := GetData(FindHighest);
end;
{@@ ----------------------------------------------------------------------------
This procedure adjusts row or column indexes stored in the tree nodes if a
row or column will be inserted into the underlying worksheet.
@param AIndex Index of the row (if IsRow=true) or column (if IsRow=false)
to be inserted
@param IsRow Identifies whether AIndex refers to a row or column index
-------------------------------------------------------------------------------}
procedure TsRowColAVLTree.InsertRowOrCol(AIndex: Cardinal; IsRow: Boolean);
var
node: TAvgLvlTreeNode;
item: PsRowCol;
begin
node := FindLowest;
while Assigned(node) do begin
item := PsRowCol(node.Data);
if IsRow then
begin
if item^.Row >= AIndex then inc(item^.Row);
end else
begin
if item^.Col >= AIndex then inc(item^.Col);
end;
node := FindSuccessor(node);
end;
end;
{@@ ----------------------------------------------------------------------------
This method moves the cell in the specified column (ACol) and at row AFromRow
along the row before the row with index AToRow.
-------------------------------------------------------------------------------}
procedure TsRowColAVLTree.MoveAlongCol(ARow, ACol, AToRow: Cardinal);
var
r: Cardinal;
node: TAvgLvlTreeNode;
item: PsRowCol;
begin
if ARow = AToRow then
exit;
if ARow < AToRow then
begin
node := FindLowest;
while Assigned(node) do
begin
item := PsRowCol(node.Data);
if item^.Col = ACol then break;
node := FindSuccessor(node);
end;
r := ARow;
while r < AToRow do begin
Exchange(r, ACol, r+1, ACol);
inc(r);
end;
end else
begin
node:= FindHighest;
while Assigned(node) do
begin
item := PsRowCol(node.Data);
if item^.Col = ACol then break;
node := FindPrecessor(node);
end;
r := ARow;
while r > AToRow do begin
Exchange(r, ACol, r-1, ACol);
dec(r);
end;
end;
end;
{@@ ----------------------------------------------------------------------------
This method moves the cell in the specified row (ARow) and at column AFromCol
along the row before the column with index AToCol.
-------------------------------------------------------------------------------}
procedure TsRowColAVLTree.MoveAlongRow(ARow, ACol, AToCol: Cardinal);
var
c: Cardinal;
node: TAvgLvlTreeNode;
item: PsRowCol;
begin
if ACol = AToCol then
exit;
if ACol < AToCol then
begin
node := FindLowest;
while Assigned(node) do
begin
item := PsRowCol(node.Data);
if item^.Row > ARow then exit;
if item^.Row = ARow then break;
node := FindSuccessor(node);
end;
c := ACol;
while c < AToCol do begin
Exchange(ARow, c, ARow, c+1);
inc(c);
end;
end else
begin
node:= FindHighest;
while Assigned(node) do
begin
item := PsRowCol(node.Data);
if item^.Row < ARow then exit;
if item^.Row = ARow then break;
node := FindPrecessor(node);
end;
c := ACol;
while c > AToCol do begin
Exchange(ARow, c, ARow, c-1);
dec(c);
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Removes the node, but does NOT destroy the associated data reocrd
-------------------------------------------------------------------------------}
procedure TsRowColAVLTree.Remove(ARow, ACol: Cardinal);
var
node: TAvgLvlTreeNode;
item: TsRowCol;
begin
item.Row := ARow;
item.Col := ACol;
node := inherited Find(@item);
Remove(node);
// Delete(node);
end;
{==============================================================================}
{ TsCellEnumerator: enumerator for the TsCells AVLTree }
{==============================================================================}
function TsCellEnumerator.GetEnumerator: TsCellEnumerator;
begin
Result := self;
end;
function TsCellEnumerator.GetCurrent: PCell;
begin
Result := PCell(inherited GetCurrent);
end;
{==============================================================================}
{ TsCells: an AVLTree to store spreadsheet cells }
{==============================================================================}
constructor TsCells.Create(AWorksheet: TsBasicWorksheet;
AOwnsData: Boolean = true);
begin
inherited Create(AOwnsData);
FWorksheet := AWorksheet;
end;
{@@ ----------------------------------------------------------------------------
Adds a node with a new TCell record to the tree.
Returns a pointer to the cell record.
NOTE: It must be checked first that there ia no other record at the same
col/row. (Check omitted for better performance).
-------------------------------------------------------------------------------}
function TsCells.AddCell(ARow, ACol: Cardinal): PCell;
begin
Result := PCell(Add(ARow, ACol));
end;
{@@ ----------------------------------------------------------------------------
Deletes the node for the specified row and column index along with the
associated cell data record.
-------------------------------------------------------------------------------}
procedure TsCells.DeleteCell(ARow, ACol: Cardinal);
begin
Delete(ARow, ACol);
end;
{@@ ----------------------------------------------------------------------------
Helper procedure which disposes the memory occupied by the cell data
record attached to a tree node.
-------------------------------------------------------------------------------}
procedure TsCells.DisposeData(var AData: Pointer);
begin
if AData <> nil then
Dispose(PCell(AData));
AData := nil;
end;
{@@ ----------------------------------------------------------------------------
Checks whether a specific cell already exists
-------------------------------------------------------------------------------}
function TsCells.FindCell(ARow, ACol: Cardinal): PCell;
begin
Result := PCell(FindByRowCol(ARow, ACol));
end;
{@@ ----------------------------------------------------------------------------
Cell enumerators (use in "for ... in" syntax)
-------------------------------------------------------------------------------}
function TsCells.GetEnumerator: TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false);
end;
function TsCells.GetColEnumerator(ACol: Cardinal; AStartRow: Cardinal = 0;
AEndRow: Cardinal = $7FFFFFFF): TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(Self, AStartRow, ACol, AEndRow, ACol, false);
end;
function TsCells.GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Cardinal): TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(Self,
AStartRow, AStartCol, AEndRow, AEndCol, false);
end;
function TsCells.GetRowEnumerator(ARow: Cardinal; AStartCol: Cardinal = 0;
AEndCol: Cardinal = $7FFFFFFF): TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(Self,
ARow, AStartCol, ARow, AEndCol, false);
end;
function TsCells.GetReverseColEnumerator(ACol: Cardinal; AStartRow: Cardinal = 0;
AEndRow: Cardinal = $7FFFFFFF): TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(Self,
AStartRow, ACol, AEndRow, ACol, true);
end;
function TsCells.GetReverseEnumerator: TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, true);
end;
function TsCells.GetReverseRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Cardinal): TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(Self,
AStartRow, AStartCol, AEndRow, AEndCol, true);
end;
function TsCells.GetReverseRowEnumerator(ARow: Cardinal; AStartCol: Cardinal = 0;
AEndCol: Cardinal = $7FFFFFFF): TsCellEnumerator;
begin
Result := TsCellEnumerator.Create(Self,
ARow, AStartCol, ARow, AEndCol, true);
end;
{@@ ----------------------------------------------------------------------------
Returns a pointer to the first cell of the tree.
-------------------------------------------------------------------------------}
function TsCells.GetFirstCell: PCell;
begin
Result := PCell(GetFirst);
end;
{@@ ----------------------------------------------------------------------------
Returns a pointer to the first cell in a specified row
-------------------------------------------------------------------------------}
function TsCells.GetFirstCellOfRow(ARow: Cardinal): PCell;
begin
Result := nil;
// Creating the row enumerator automatically finds the first cell of the row
for Result in GetRowEnumerator(ARow) do
exit;
end;
{@@ ----------------------------------------------------------------------------
Returns a pointer to the last cell of the tree.
-------------------------------------------------------------------------------}
function TsCells.GetLastCell: PCell;
begin
Result := PCell(GetLast);
end;
{@@ ----------------------------------------------------------------------------
Returns a pointer to the last cell of a specified row
-------------------------------------------------------------------------------}
function TsCells.GetLastCellOfRow(ARow: Cardinal): PCell;
begin
Result := nil;
// Creating the reverse row enumerator finds the last cell of the row
for Result in GetReverseRowEnumerator(ARow) do
exit;
end;
{@@ ----------------------------------------------------------------------------
Alloates memory for a cell data record.
-------------------------------------------------------------------------------}
function TsCells.NewData: Pointer;
var
cell: PCell;
begin
New(cell);
InitCell(cell^);
cell^.Worksheet := FWorksheet;
Result := cell;
end;
{==============================================================================}
{ TsCommentEnumerator: enumerator for the TsComments AVLTree }
{==============================================================================}
function TsCommentEnumerator.GetEnumerator: TsCommentEnumerator;
begin
Result := self;
end;
function TsCommentEnumerator.GetCurrent: PsComment;
begin
Result := PsComment(inherited GetCurrent);
end;
{==============================================================================}
{ TsComments: an AVLTree to store comment records for cells }
{==============================================================================}
{@@ ----------------------------------------------------------------------------
Adds a node with a new comment record to the tree. If a node already
exists then its data will be replaced by the specified ones.
Returns a pointer to the comment record.
-------------------------------------------------------------------------------}
function TsComments.AddComment(ARow, ACol: Cardinal;
AComment: String): PsComment;
begin
Result := PsComment(FindByRowCol(ARow, ACol));
if Result = nil then
Result := PsComment(Add(ARow, ACol));
Result^.Text := AComment;
end;
{@@ ----------------------------------------------------------------------------
Deletes the node for the specified row and column index along with the
associated comment data record.
-------------------------------------------------------------------------------}
procedure TsComments.DeleteComment(ARow, ACol: Cardinal);
begin
Delete(ARow, ACol);
end;
{@@ ----------------------------------------------------------------------------
Helper procedure which disposes the memory occupied by the comment data
record attached to a tree node.
-------------------------------------------------------------------------------}
procedure TsComments.DisposeData(var AData: Pointer);
begin
if AData <> nil then
Dispose(PsComment(AData));
AData := nil;
end;
{@@ ----------------------------------------------------------------------------
Alloates memory of a comment data record.
-------------------------------------------------------------------------------}
function TsComments.NewData: Pointer;
var
comment: PsComment;
begin
New(comment);
Result := comment;
end;
{@@ ----------------------------------------------------------------------------
Comments enumerators (use in "for ... in" syntax)
-------------------------------------------------------------------------------}
function TsComments.GetEnumerator: TsCommentEnumerator;
begin
Result := TsCommentEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false);
end;
function TsComments.GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Cardinal): TsCommentEnumerator;
begin
Result := TsCommentEnumerator.Create(Self,
AStartRow, AStartCol, AEndRow, AEndCol, false);
end;
{==============================================================================}
{ TsHyperlinkEnumerator: enumerator for the TsHyperlinks AVLTree }
{==============================================================================}
function TsHyperlinkEnumerator.GetCurrent: PsHyperlink;
begin
Result := PsHyperlink(inherited GetCurrent);
end;
function TsHyperlinkEnumerator.GetEnumerator: TsHyperlinkEnumerator;
begin
Result := self;
end;
{==============================================================================}
{ TsHyperlinks: an AVLTree to store hyperlink records for cells }
{==============================================================================}
{@@ ----------------------------------------------------------------------------
Adds a node with a new hyperlink record to the tree. If a node already
exists then its data will be replaced by the specified ones.
Returns a pointer to the hyperlink record.
-------------------------------------------------------------------------------}
function TsHyperlinks.AddHyperlink(ARow, ACol: Cardinal; ATarget: String;
ATooltip: String = ''): PsHyperlink;
begin
Result := PsHyperlink(FindByRowCol(ARow, ACol));
if Result = nil then
Result := PsHyperlink(Add(ARow, ACol));
Result^.Target := ATarget;
Result^.Tooltip := ATooltip;
end;
{@@ ----------------------------------------------------------------------------
Deletes the node for the specified row and column index along with the
associated hyperlink data record.
-------------------------------------------------------------------------------}
procedure TsHyperlinks.DeleteHyperlink(ARow, ACol: Cardinal);
begin
Delete(ARow, ACol);
end;
{@@ ----------------------------------------------------------------------------
Helper procedure which disposes the memory occupied by the hyperlink data
record attached to a tree node.
-------------------------------------------------------------------------------}
procedure TsHyperlinks.DisposeData(var AData: Pointer);
begin
if AData <> nil then
Dispose(PsHyperlink(AData));
AData := nil;
end;
{@@ ----------------------------------------------------------------------------
Hyperlink enumerators (use in "for ... in" syntax)
-------------------------------------------------------------------------------}
function TsHyperlinks.GetEnumerator: TsHyperlinkEnumerator;
begin
Result := TsHyperlinkEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false);
end;
function TsHyperlinks.GetRangeEnumerator(AStartRow, AStartCol,
AEndRow, AEndCol: Cardinal): TsHyperlinkEnumerator;
begin
Result := TsHyperlinkEnumerator.Create(Self,
AStartRow, AStartCol, AEndRow, AEndCol, false);
end;
{@@ ----------------------------------------------------------------------------
Alloates memory of a hyperlink data record.
-------------------------------------------------------------------------------}
function TsHyperlinks.NewData: Pointer;
var
hyperlink: PsHyperlink;
begin
New(hyperlink);
Result := hyperlink;
end;
{==============================================================================}
{ TsCellRangeEnumerator: enumerator for the cell range records }
{==============================================================================}
function TsCellRangeEnumerator.GetEnumerator: TsCellRangeEnumerator;
begin
Result := self;
end;
function TsCellRangeEnumerator.GetCurrent: PsCellRange;
begin
Result := PsCellRange(inherited GetCurrent);
end;
{==============================================================================}
{ TsMergedCells: a AVLTree to store merged cell range records for cells }
{==============================================================================}
{@@ ----------------------------------------------------------------------------
Adds a node with a new merge cell range record to the tree. If a node already
exists then its data will be replaced by the specified ones.
Returns a pointer to the cell range record.
-------------------------------------------------------------------------------}
function TsMergedCells.AddRange(ARow1, ACol1, ARow2, ACol2: Cardinal): PsCellRange;
begin
Result := PsCellRange(FindByRowCol(ARow1, ACol1));
if Result = nil then
Result := PsCellRange(Add(ARow1, ACol1));
Result^.Row2 := ARow2;
Result^.Col2 := ACol2;
end;
{@@ ----------------------------------------------------------------------------
Deletes the node for which the top/left corner of the cell range matches the
specified parameters. There is only a single range fulfilling this criterion.
-------------------------------------------------------------------------------}
procedure TsMergedCells.DeleteRange(ARow, ACol: Cardinal);
begin
Delete(ARow, ACol);
end;
{@@ ----------------------------------------------------------------------------
This procedure adjusts row or column indexes stored in the tree nodes if a
row or column will be deleted from the underlying worksheet.
@param AIndex Index of the row (if IsRow=true) or column (if IsRow=false)
to be deleted
@param IsRow Identifies whether AIndex refers to a row or column index
-------------------------------------------------------------------------------}
procedure TsMergedCells.DeleteRowOrCol(AIndex: Cardinal; IsRow: Boolean);
var
rng: PsCellRange;
R: TsCellRange;
node, nextnode: TAvgLvlTreeNode;
begin
node := FindLowest;
while Assigned(node) do begin
rng := PsCellRange(node.Data);
nextnode := FindSuccessor(node);
if IsRow then
begin
// Deleted row is above the merged range --> Shift entire range up by 1
// NOTE:
// The "merged" flags do not have to be changed, they move with the cells.
if (AIndex < rng^.Row1) then begin
R := rng^; // Store range parameters
Delete(node); // Delete node from tree, adapt the row indexes, ...
AddRange(R.Row1-1, R.Col1, R.Row2-1, R.Col2); // ... and re-insert to get it sorted correctly
end else
// Single-row merged block coincides with row to be deleted
if (AIndex = rng^.Row1) and (rng^.Row1 = rng^.Row2) then
DeleteRange(rng^.Row1, rng^.Col1)
else
// Deleted row runs through the merged block --> Shift bottom row up by 1
// NOTE: The "merged" flags disappear with the deleted cells
if (AIndex >= rng^.Row1) and (AIndex <= rng^.Row2) then
dec(rng^.Row2); // no need to remove & re-insert because Row1 does not change
end else
begin
// Deleted column is at the left of the merged range
// --> Shift entire merged range to the left by 1
// NOTE:
// The "merged" flags do not have to be changed, they move with the cells.
if (AIndex < rng^.Col1) then begin
R := rng^;
Delete(node);
AddRange(R.Row1, R.Col1-1, R.Row2, R.Col2-1);
end else
// Single-column block coincides with the column to be deleted
// NOTE: The "merged" flags disappear with the deleted cells
if (AIndex = rng^.Col1) and (rng^.Col1 = rng^.Col2) then
DeleteRange(rng^.Row1, rng^.Col1)
else
// Deleted column runs through the merged block
// --> Shift right column to the left by 1
if (AIndex >= rng^.Col1) and (AIndex <= rng^.Col2) then
dec(rng^.Col2);
end;
// Proceed with next merged range
node := nextnode;
end;
end;
{@@ ----------------------------------------------------------------------------
Helper procedure which disposes the memory occupied by the merged cell range
data record attached to a tree node.
-------------------------------------------------------------------------------}
procedure TsMergedCells.DisposeData(var AData: Pointer);
begin
if AData <> nil then
Dispose(PsCellRange(AData));
AData := nil;
end;
procedure TsMergedCells.Exchange(ARow1, ACol1, ARow2, ACol2: Cardinal);
var
rng: PsCellrange;
dr, dc: Cardinal;
begin
rng := PsCellrange(FindByRowCol(ARow1, ACol1));
if rng <> nil then
begin
dr := rng^.Row2 - rng^.Row1;
dc := rng^.Col2 - rng^.Col1;
rng^.Row1 := ARow2;
rng^.Col1 := ACol2;
rng^.Row2 := ARow2 + dr;
rng^.Col2 := ACol2 + dc;
end;
rng := PsCellRange(FindByRowCol(ARow2, ACol2));
if rng <> nil then
begin
dr := rng^.Row2 - rng^.Row1;
dc := rng^.Col2 - rng^.Col1;
rng^.Row1 := ARow1;
rng^.Col1 := ACol1;
rng^.Row2 := ARow1 + dr;
rng^.Col2 := ACol1 + dc;
end;
inherited Exchange(ARow1, ACol1, ARow2, ACol2);
end;
{@@ ----------------------------------------------------------------------------
Finds the cell range which contains the cell specified by its row and column
index
-------------------------------------------------------------------------------}
function TsMergedCells.FindRangeWithCell(ARow, ACol: Cardinal): PsCellRange;
var
node: TAvgLvlTreeNode;
begin
node := FindLowest;
while Assigned(node) do
begin
Result := PsCellRange(node.Data);
if (ARow >= Result^.Row1) and (ARow <= Result^.Row2) and
(ACol >= Result^.Col1) and (ACol <= Result^.Col2) then exit;
node := FindSuccessor(node);
end;
end;
{@@ ----------------------------------------------------------------------------
Cell range enumerator (use in "for ... in" syntax)
-------------------------------------------------------------------------------}
function TsMergedCells.GetEnumerator: TsCellRangeEnumerator;
begin
Result := TsCellRangeEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false);
end;
{@@ ----------------------------------------------------------------------------
Alloates memory of a merged cell range data record.
-------------------------------------------------------------------------------}
function TsMergedCells.NewData: Pointer;
var
range: PsCellRange;
begin
New(range);
Result := range;
end;
{==============================================================================}
{ TsFormulaEnumerator }
{==============================================================================}
function TsFormulaEnumerator.GetCurrent: PsFormula;
begin
Result := PsFormula(inherited GetCurrent);
end;
function TsFormulaEnumerator.GetEnumerator: TsFormulaEnumerator;
begin
Result := self;
end;
{==============================================================================}
{ TsFormulas }
{==============================================================================}
function TsFormulas.AddFormula(ARow, ACol: Cardinal; AFormula: String = '';
AParsedFormula: TsExpressionParser = nil): PsFormula;
begin
Result := PsFormula(FindByRowCol(ARow, ACol));
if Result = nil then
Result := PsFormula(Add(ARow, ACol));
Result^.Text := AFormula; // unparsed formula
FreeAndNil(Result^.Parser); // Destroy previously existing parser
Result^.Parser := AParsedFormula; // if nil, will be parsed on next calculation
Result^.CalcState := csNotCalculated;
end;
procedure TsFormulas.DeleteFormula(ACell: PCell);
begin
if ACell <> nil then
Delete(ACell^.Row, ACell^.Col);
end;
procedure TsFormulas.DeleteFormula(ARow, ACol: Cardinal);
begin
Delete(ARow, ACol); // will release memory automatically
end;
procedure TsFormulas.DisposeData(var AData: Pointer);
begin
if AData <> nil then begin
PsFormula(AData)^.Text := '';
PsFormula(AData)^.Parser.Free;
Dispose(PsFormula(AData));
end;
AData := nil;
end;
function TsFormulas.FindFormula(ACell: PCell): PsFormula;
begin
if ACell <> nil then
Result := PsFormula(FindbyRowCol(ACell^.Row, ACell^.Col))
else
Result := nil;
end;
function TsFormulas.FindFormula(ARow, ACol: Cardinal): PsFormula;
begin
Result := PsFormula(FindByRowCol(ARow, ACol));
end;
{ In worksheet "InSheet" a row or column has been inserted or deleted at the
given index. "IsRow" tells whether it is a row or a column, and "IsDeleteing"
tells whether it has been deleted (true) or inserted (false).
This method must scan the formulas of the current worksheet whether there is
a reference to the modified sheet and must adapt the reference correspondingly
}
procedure TsFormulas.FixReferences(AIndex: Cardinal; IsRow, IsDeleting: Boolean;
InSheet: TsBasicWorksheet);
var
formula: PsFormula;
proc: TsExprNodeProc;
begin
if IsRow and IsDeleting then
proc := @FixDeletedRow
else if IsRow and not IsDeleting then
proc := @FixInsertedRow
else if not IsRow and IsDeleting then
proc := @FixDeletedCol
else
proc := @fixInsertedCol;
for formula in self do
if formula^.Parser.IterateNodes(proc, Pointer(PtrInt(AIndex)), InSheet) then
formula^.Text := formula^.Parser.Expression;
end;
// Formula enumerators (use in "for ... in" syntax)
function TsFormulas.GetEnumerator: TsFormulaEnumerator;
begin
Result := TsFormulaEnumerator.Create(self, 0, 0, $7FFFFFFF, $7FFFFFFF, false);
end;
function TsFormulas.NewData: Pointer;
var
f: PsFormula;
begin
New(f);
f^.Text := '';
f^.Parser := nil;
f^.CalcState := csNotCalculated;
Result := f;
end;
{==============================================================================}
{ TsCellFormatList }
{==============================================================================}
constructor TsCellFormatList.Create(AAllowDuplicates: Boolean);
begin
inherited Create;
FAllowDuplicates := AAllowDuplicates;
end;
destructor TsCellFormatList.Destroy;
begin
Clear;
inherited;
end;
function TsCellFormatList.Add(const AItem: TsCellFormat): Integer;
var
P: PsCellFormat;
begin
if FAllowDuplicates then
Result := -1
else
Result := IndexOf(AItem);
if Result = -1 then begin
New(P);
P^.Name := AItem.Name;
P^.ID := AItem.ID;
P^.UsedFormattingFields := AItem.UsedFormattingFields;
P^.FontIndex := AItem.FontIndex;
P^.TextRotation := AItem.TextRotation;
P^.HorAlignment := AItem.HorAlignment;
P^.VertAlignment := AItem.VertAlignment;
P^.Border := AItem.Border;
P^.BorderStyles := AItem.BorderStyles;
P^.Background := AItem.Background;
P^.NumberFormatIndex := AItem.NumberFormatIndex;
P^.NumberFormat := AItem.NumberFormat;
P^.NumberFormatStr := AItem.NumberFormatStr;
P^.BiDiMode := AItem.BiDiMode;
P^.Protection := AItem.Protection;
Result := inherited Add(P);
end;
end;
{@@ ----------------------------------------------------------------------------
Adds a pointer to a FormatRecord to the list. Allows nil for the predefined
formats which are not stored in the file.
-------------------------------------------------------------------------------}
function TsCellFormatList.Add(AItem: PsCellFormat): Integer;
begin
if AItem = nil then
Result := inherited Add(AItem)
else
Result := Add(AItem^);
end;
procedure TsCellFormatList.Clear;
var
i: Integer;
begin
for i:=Count-1 downto 0 do
Delete(i);
inherited;
end;
procedure TsCellFormatList.Delete(AIndex: Integer);
var
P: PsCellFormat;
begin
P := GetItem(AIndex);
if P <> nil then
Dispose(P);
inherited Delete(AIndex);
end;
function TsCellFormatList.GetItem(AIndex: Integer): PsCellFormat;
begin
Result := inherited Items[AIndex];
end;
function TsCellFormatList.FindIndexOfID(ID: Integer): Integer;
var
P: PsCellFormat;
begin
for Result := 0 to Count-1 do
begin
P := GetItem(Result);
if (P <> nil) and (P^.ID = ID) then
exit;
end;
Result := -1;
end;
function TsCellFormatList.FindIndexOfName(AName: String): Integer;
var
P: PsCellFormat;
begin
for Result := 0 to Count-1 do
begin
P := GetItem(Result);
if (P <> nil) and (P^.Name = AName) then
exit;
end;
Result := -1;
end;
function TsCellFormatList.IndexOf(const AItem: TsCellFormat): Integer;
var
P: PsCellFormat;
equ: Boolean;
b: TsCellBorder;
begin
for Result := 0 to Count-1 do
begin
P := GetItem(Result);
if (P = nil) then continue;
if (P^.UsedFormattingFields <> AItem.UsedFormattingFields) then continue;
if (uffFont in AItem.UsedFormattingFields) then
if (P^.FontIndex) <> (AItem.FontIndex) then continue;
if (uffTextRotation in AItem.UsedFormattingFields) then
if (P^.TextRotation <> AItem.TextRotation) then continue;
if (uffHorAlign in AItem.UsedFormattingFields) then
if (P^.HorAlignment <> AItem.HorAlignment) then continue;
if (uffVertAlign in AItem.UsedFormattingFields) then
if (P^.VertAlignment <> AItem.VertAlignment) then continue;
if (uffBorder in AItem.UsedFormattingFields) then
if (P^.Border <> AItem.Border) then continue;
// Border styles can be set even if borders are not used --> don't check uffBorder!
equ := true;
for b in TsCellBorder {AItem.Border} do begin
if (P^.BorderStyles[b].LineStyle <> AItem.BorderStyles[b].LineStyle) or
(P^.BorderStyles[b].Color <> Aitem.BorderStyles[b].Color)
then begin
equ := false;
break;
end;
end;
if not equ then continue;
if (uffBackground in AItem.UsedFormattingFields) then begin
if (P^.Background.Style <> AItem.Background.Style) then continue;
if (P^.Background.BgColor <> AItem.Background.BgColor) then continue;
if (P^.Background.FgColor <> AItem.Background.FgColor) then continue;
end;
if (uffNumberFormat in AItem.UsedFormattingFields) then begin
if (P^.NumberFormatIndex <> AItem.NumberFormatIndex) then continue;
if (P^.NumberFormat <> AItem.NumberFormat) then continue;
if (P^.NumberFormatStr <> AItem.NumberFormatStr) then continue;
end;
if (uffBiDi in AItem.UsedFormattingFields) then
if (P^.BiDiMode <> AItem.BiDiMode) then continue;
if (P^.Protection <> AItem.Protection) then continue;
// If we arrive here then the format records match.
exit;
end;
// We get here if no record matches
Result := -1;
end;
procedure TsCellFormatList.SetItem(AIndex: Integer; const AValue: PsCellFormat);
begin
inherited Items[AIndex] := AValue;
end;
{==============================================================================}
{ TsIntegerStack }
{==============================================================================}
procedure TsIntegerStack.Push(AValue: Integer);
begin
SetLength(FValues, Length(FValues)+1);
FValues[High(FValues)] := AValue;
end;
function TsIntegerStack.Pop: Integer;
begin
if Length(FValues) = 0 then
Result := -1
else
begin
Result := FValues[High(FValues)];
SetLength(FValues, Length(FValues)-1);
end;
end;
{==============================================================================}
{ Utilities }
{==============================================================================}
function FindFontInList(AFontList: TFPList; AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor; APos: TsFontPosition): Integer;
begin
for Result := 0 to AFontList.Count-1 do
if SameFont(
TsFont(AFontList.Items[Result]),
AFontName, ASize, AStyle, AColor, APos
)
then
exit;
Result := -1;
end;
end.
Reference in New Issue View Git Blame Copy Permalink