8037f9f23a
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@44 8e941d3f-bd1b-0410-a28a-d453659cc2b4
705 lines
24 KiB
ObjectPascal
705 lines
24 KiB
ObjectPascal
{*********************************************************}
|
|
{* OVCTSELL.PAS 4.06 *}
|
|
{*********************************************************}
|
|
|
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
|
{* Version: MPL 1.1 *}
|
|
{* *}
|
|
{* The contents of this file are subject to the Mozilla Public License *}
|
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
|
{* compliance with the License. You may obtain a copy of the License at *}
|
|
{* http://www.mozilla.org/MPL/ *}
|
|
{* *}
|
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
|
{* for the specific language governing rights and limitations under the *}
|
|
{* License. *}
|
|
{* *}
|
|
{* The Original Code is TurboPower Orpheus *}
|
|
{* *}
|
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
|
{* *}
|
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
|
{* *}
|
|
{* Contributor(s): *}
|
|
{* *}
|
|
{* ***** END LICENSE BLOCK ***** *}
|
|
|
|
{$I OVC.INC}
|
|
|
|
{$B-} {Complete Boolean Evaluation}
|
|
{$I+} {Input/Output-Checking}
|
|
{$P+} {Open Parameters}
|
|
{$T-} {Typed @ Operator}
|
|
{.W-} {Windows Stack Frame}
|
|
{$X+} {Extended Syntax}
|
|
|
|
unit ovctsell;
|
|
{-Table cell selection list class}
|
|
|
|
{Notes:
|
|
|
|
The TOvcSelectionList class implements a data structure that stores which
|
|
cells in a table are selected. The structure is implemented as an array
|
|
of (sub)arrays, each element of the outer array pertaining to a single
|
|
column. The items in each subarray are ranges of rows that are selected.
|
|
Thus if the cells (in (row,col) format) (1,1)..(2,3) are all selected,
|
|
the structure will look like this:
|
|
Column Value
|
|
0 nil
|
|
1 array with 1 element: range row 1 to row 2
|
|
2 array with 1 element: range row 1 to row 2
|
|
3 array with 1 element: range row 1 to row 2
|
|
4 nil
|
|
...
|
|
Adding a new selected cell at (4,2) would add an element to the third
|
|
column's subarray: a range from row 4 to row 4.
|
|
|
|
To check whether a cell is selected or not, get the element of the array
|
|
pertaining to the column. If nil, the cell is not selected. If not,
|
|
search through the ranges sequentially until the cell's row falls into a
|
|
range.
|
|
|
|
Adding a selected cell (or cells) will generally add a new row range
|
|
element to the relevant column array, but it might cause row range
|
|
mergings. Deselecting a cell (or cells) might cause range splittings and
|
|
mergings.
|
|
|
|
To aid in dynamic selection of cells, the class remembers the 'current
|
|
range'. The table using this class will set the anchor cell address and
|
|
then periodically set the new active cell; the difference between these
|
|
is the current range. The class will move the current range to the above
|
|
data structure when the anchor cell is set. IsCellSelected and
|
|
HaveSelection will both look at this current range as well as the data
|
|
structure. Note that the current range could be for selecting as well as
|
|
deselecting cells: there's a flag to define which.
|
|
|
|
One important assumption has been made. This is that generally there are
|
|
'few' selections (obviously one can imagine the fanatical user who is
|
|
determined to see 1000 separate disjoint selections, but normally there
|
|
will be one selection to maybe half a dozen). In other words it will be
|
|
more efficient to code a sequential search internally rather than a
|
|
binary one, and other similar types of speed improvements have not been
|
|
used.
|
|
}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF} SysUtils, OvcTCmmn;
|
|
|
|
type
|
|
TOvcSelRowRange = packed record {a row range}
|
|
L, H : TRowNum;
|
|
end;
|
|
|
|
POvcSelRRArray = ^TOvcSelRRArray; {an array of row ranges}
|
|
TOvcSelRRArray = packed record
|
|
RRCount : integer;
|
|
RRTotal : integer;
|
|
RRs : array [0..(MaxInt div sizeof(TOvcSelRowRange))-2] of TOvcSelRowRange;
|
|
end;
|
|
|
|
POvcSelColArray = ^TOvcSelColArray; {an array of arrays of row ranges}
|
|
TOvcSelColArray = array [0..(MaxInt div sizeof(POvcSelRRArray))-1] of POvcSelRRArray;
|
|
|
|
TOvcSelectionList = class {class to manage list of selected cells}
|
|
protected {private}
|
|
{.Z+}
|
|
{even sized}
|
|
slArray : POvcSelColArray; {array of arrays of row ranges}
|
|
slColCount : TColNum; {number of columns in slArray}
|
|
slColWithSelCount : TColNum; {num of columns with at least 1 selected cell}
|
|
slActiveCol : TColNum; {current active cell-column}
|
|
slActiveRow : TColNum; { -row}
|
|
slAnchorCol : TColNum; {current anchor-column}
|
|
slAnchorRow : TColNum; { -row}
|
|
slRowCount : TRowNum; {number of rows in slArray}
|
|
slColMin : TColNum; {current range-minimum column}
|
|
slColMax : TColNum; { -maximum column}
|
|
slRowMin : TRowNum; { -minimum row}
|
|
slRowMax : TRowNum; { -maximum row}
|
|
{odd sized}
|
|
slSelecting : boolean; {current range is for selection}
|
|
slEmptyRange : boolean; {current range is empty}
|
|
{.Z-}
|
|
protected
|
|
{.Z+}
|
|
procedure slDeselectCellRangeInCol(Row1, Row2 : TRowNum; ColNum : TColNum);
|
|
procedure slSelectCellRangeInCol(Row1, Row2 : TRowNum; ColNum : TColNum);
|
|
{.Z-}
|
|
public
|
|
constructor Create(RowCount : TRowNum; ColCount : TColNum);
|
|
{-Create a new instance for RowCount rows & ColCount columns}
|
|
destructor Destroy; override;
|
|
{-Destroy the instance}
|
|
|
|
procedure DeselectAll;
|
|
{-Deselect all cells}
|
|
procedure DeselectCell(RowNum : TRowNum; ColNum : TColNum);
|
|
{-Deselect a single cell}
|
|
procedure DeselectCellRange(FromRow : TRowNum; FromCol : TColNum;
|
|
ToRow : TRowNum; ToCol : TColNum);
|
|
{-Deselect a range of cells}
|
|
procedure ExtendRange(RowNum : TRowNum; ColNum : TColNum;
|
|
IsSelecting : boolean);
|
|
{-Extend/shrink the current range to RowNum, ColNum}
|
|
function HaveSelection : boolean;
|
|
{-Return true if at least one cell is selected}
|
|
function IsCellSelected(RowNum : TRowNum; ColNum : TColNum) : boolean;
|
|
{-Return true if specified cell is selected}
|
|
procedure Iterate(SI : TSelectionIterator; ExtraData : pointer);
|
|
{-Iterate through all the selection ranges calling SI for each}
|
|
procedure SelectAll;
|
|
{-Select all cells}
|
|
procedure SelectCell(RowNum : TRowNum; ColNum : TColNum);
|
|
{-Mark a single cell as selected}
|
|
procedure SelectCellRange(FromRow : TRowNum; FromCol : TColNum;
|
|
ToRow : TRowNum; ToCol : TColNum);
|
|
{-Mark a range of cells as selected}
|
|
procedure SetColCount(ColCount : TColNum);
|
|
{-Change the number of columns}
|
|
procedure SetRangeAnchor(RowNum : TRowNum; ColNum : TColNum;
|
|
Action : TOvcTblSelectionType);
|
|
{-Set the anchor cell; if Action is tstAdditional the current
|
|
selection is stored, if not all DeselectAll is called}
|
|
procedure SetRowCount(RowCount : TRowNum);
|
|
{-Change the number of rows}
|
|
end;
|
|
|
|
implementation
|
|
|
|
const
|
|
RRArrayInc = 16;
|
|
RRElemSize = sizeof(TOvcSelRowRange);
|
|
|
|
{===Helper routines==================================================}
|
|
function CalcRRArraySize(ElementCount : integer) : integer;
|
|
{-Given a number of elements, calcs the memory block size}
|
|
begin
|
|
Result := (ElementCount * RRElemSize) + (2 * sizeof(integer));
|
|
end;
|
|
{--------}
|
|
procedure AllocRRArray(var RRA : POvcSelRRArray);
|
|
{-Allocates/grows a row range array}
|
|
var
|
|
NewTotal : integer;
|
|
NewArray: POvcSelRRArray;
|
|
begin
|
|
{are we growing a current allocation?}
|
|
if Assigned(RRA) then
|
|
begin
|
|
NewTotal := RRA^.RRTotal + RRArrayInc;
|
|
NewArray := AllocMem(CalcRRArraySize(NewTotal));
|
|
NewArray^.RRTotal := NewTotal;
|
|
NewArray^.RRCount := RRA^.RRCount;
|
|
Move(RRA^.RRs, NewArray^.RRs, RRA^.RRCount * RRElemSize);
|
|
FreeMem(RRA, CalcRRArraySize(RRA^.RRTotal));
|
|
RRA := NewArray;
|
|
end
|
|
{otherwise this is a new allocation}
|
|
else
|
|
begin
|
|
RRA := AllocMem(CalcRRArraySize(RRArrayInc));
|
|
RRA^.RRTotal := RRArrayInc;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure FreeRRArray(var RRA : POvcSelRRArray);
|
|
{-Frees a row range array}
|
|
begin
|
|
{Note: assumes RRA is not nil}
|
|
FreeMem(RRA, CalcRRArraySize(RRA^.RRTotal));
|
|
RRA := nil;
|
|
end;
|
|
{--------}
|
|
procedure ReallocColArray(var CA : POvcSelColArray; OldCC, NewCC : TColNum);
|
|
{-Reallocates (ie allocs or frees or grows) a column array}
|
|
var
|
|
NewArray : POvcSelColArray;
|
|
i : integer;
|
|
begin
|
|
{if there's no change, forget it}
|
|
if (NewCC = OldCC) then
|
|
Exit;
|
|
{if the new array size is greater then just copy over the
|
|
old array's contents after clearing the new array}
|
|
if (NewCC > OldCC) then
|
|
begin
|
|
NewArray := AllocMem(NewCC * sizeof(pointer));
|
|
if (OldCC > 0) then
|
|
Move(CA^, NewArray^, OldCC * sizeof(pointer));
|
|
end
|
|
{if the new array size is smaller then we have to dispose of
|
|
the subarrays that will no longer be used, then copy over
|
|
the remaining elements (if any).}
|
|
else
|
|
begin
|
|
for i := NewCC to pred(OldCC) do
|
|
if Assigned(CA^[i]) then
|
|
FreeRRArray(CA^[i]);
|
|
if (NewCC = 0) then
|
|
NewArray := nil
|
|
else
|
|
begin
|
|
GetMem(NewArray, NewCC * sizeof(pointer));
|
|
Move(CA^, NewArray^, NewCC * sizeof(pointer));
|
|
end;
|
|
end;
|
|
{dispose of the old array, return the new one}
|
|
if (OldCC > 0) then
|
|
FreeMem(CA, OldCC * sizeof(pointer));
|
|
CA := NewArray;
|
|
end;
|
|
{====================================================================}
|
|
|
|
|
|
{===TOvcSelectionList================================================}
|
|
constructor TOvcSelectionList.Create(RowCount : TRowNum; ColCount : TColNum);
|
|
begin
|
|
{inherited Create;}
|
|
SetRowCount(RowCount);
|
|
SetColCount(ColCount);
|
|
end;
|
|
{--------}
|
|
destructor TOvcSelectionList.Destroy;
|
|
begin
|
|
SetColCount(0);
|
|
{inherited Destroy;}
|
|
end;
|
|
{--------}
|
|
procedure TOvcSelectionList.DeselectAll;
|
|
var
|
|
ColNum : TColNum;
|
|
begin
|
|
if (slColWithSelCount > 0) then
|
|
begin
|
|
for ColNum := 0 to pred(slColCount) do
|
|
if Assigned(slArray^[ColNum]) then
|
|
FreeRRArray(slArray^[ColNum]);
|
|
slColWithSelCount := 0;
|
|
end;
|
|
slEmptyRange := true;
|
|
end;
|
|
{--------}
|
|
procedure TOvcSelectionList.DeselectCell(RowNum : TRowNum; ColNum : TColNum);
|
|
begin
|
|
{sanity checks}
|
|
if (RowNum < 0) or (RowNum >= slRowCount) or
|
|
(ColNum < 0) or (ColNum >= slColCount) then
|
|
Exit;
|
|
{do it}
|
|
slDeselectCellRangeInCol(RowNum, RowNum, ColNum);
|
|
end;
|
|
{--------}
|
|
procedure TOvcSelectionList.DeselectCellRange(FromRow : TRowNum; FromCol : TColNum;
|
|
ToRow : TRowNum; ToCol : TColNum);
|
|
var
|
|
ColNum : TColNum;
|
|
SwapTemp : longint;
|
|
begin
|
|
{save the caller from himself: sort the rows/cols into ascending order}
|
|
if FromRow > ToRow then
|
|
begin
|
|
SwapTemp := FromRow;
|
|
FromRow := ToRow;
|
|
ToRow := SwapTemp;
|
|
end;
|
|
if FromCol > ToCol then
|
|
begin
|
|
SwapTemp := FromCol;
|
|
FromCol := ToCol;
|
|
ToCol := SwapTemp;
|
|
end;
|
|
{sanity checks}
|
|
if (FromRow < 0) or (FromRow >= slRowCount) or
|
|
(ToRow < 0) or (ToRow >= slRowCount) or
|
|
(FromCol < 0) or (FromCol >= slColCount) or
|
|
(ToCol < 0) or (ToCol >= slColCount) then
|
|
Exit;
|
|
{for each column, deselect cells in that column}
|
|
for ColNum := FromCol to ToCol do
|
|
slDeselectCellRangeInCol(FromRow, ToRow, ColNum);
|
|
end;
|
|
{--------}
|
|
{$IFDEF SuppressWarnings}
|
|
{$WARNINGS OFF}
|
|
{$ENDIF}
|
|
procedure TOvcSelectionList.slDeselectCellRangeInCol(Row1, Row2 : TRowNum;
|
|
ColNum : TColNum);
|
|
var
|
|
Inx : integer;
|
|
i : integer;
|
|
RRA : POvcSelRRArray;
|
|
MustDelete : boolean;
|
|
StillGoing : boolean;
|
|
begin
|
|
Inx := 0;
|
|
{take care of the simple special case first: there are no
|
|
selections in the column at all}
|
|
if (not Assigned(slArray^[ColNum])) then
|
|
Exit;
|
|
{make sure the array has at least one spare element: we could
|
|
be splitting a range}
|
|
RRA := slArray^[ColNum];
|
|
if (RRA^.RRCount = RRA^.RRTotal) then
|
|
begin
|
|
AllocRRArray(RRA);
|
|
slArray^[ColNum] := RRA;
|
|
end;
|
|
{with this array}
|
|
with RRA^ do
|
|
begin
|
|
{search for the place to delete from}
|
|
MustDelete := false;
|
|
for i := 0 to pred(RRCount) do
|
|
if (Row1 < RRs[i].L) then
|
|
begin
|
|
MustDelete := true;
|
|
Inx := i;
|
|
Break;{out of for loop}
|
|
end
|
|
else if (Row1 <= RRs[i].H) then
|
|
begin
|
|
MustDelete := true;
|
|
Inx := succ(i);
|
|
Break;{out of for loop}
|
|
end;
|
|
|
|
{if the range to deselect appears after all other
|
|
ranges, just exit, nothing to do}
|
|
if not MustDelete then
|
|
Exit;
|
|
{walk through the array starting at pred(Inx)
|
|
and split/remove as we go}
|
|
if (Inx > 0) then
|
|
dec(Inx);
|
|
StillGoing := true;
|
|
while StillGoing and (Inx < RRCount) do
|
|
if (RRs[Inx].L < Row1) then
|
|
if (RRs[Inx].H < Row1) then
|
|
inc(Inx)
|
|
else {H >= Row1} if (RRs[Inx].H > Row2) then
|
|
begin
|
|
{split, the deselect range is entirely within this range}
|
|
Move(RRs[Inx], RRs[succ(Inx)], (RRCount-Inx)*RRElemSize);
|
|
inc(RRCount);
|
|
RRs[Inx].H := pred(Row1);
|
|
RRs[succ(Inx)].L := succ(Row2);
|
|
StillGoing := false;
|
|
end
|
|
else {H >= Row1 and <= Row2}
|
|
begin
|
|
RRs[Inx].H := pred(Row1);
|
|
inc(Inx);
|
|
end
|
|
else {L >= Row1} if (RRs[Inx].L <= Row2) then
|
|
if (RRs[Inx].H > Row2) then
|
|
begin
|
|
RRs[Inx].L := succ(Row2);
|
|
StillGoing := false;
|
|
end
|
|
else {H <= Row2}
|
|
begin
|
|
{delete the range completely}
|
|
dec(RRCount);
|
|
Move(RRs[succ(Inx)], RRs[Inx], (RRCount-Inx)*RRElemSize);
|
|
end
|
|
else {L >= Row1 and > Row2}
|
|
StillGoing := false;
|
|
end;
|
|
{check to see whether we've managed to deselect every cell, if so
|
|
free the row range array}
|
|
if (RRA^.RRCount = 0) then
|
|
begin
|
|
FreeRRArray(slArray^[ColNum]);
|
|
dec(slColWithSelCount);
|
|
end;
|
|
end;
|
|
{$IFDEF SuppressWarnings}
|
|
{$WARNINGS ON}
|
|
{$ENDIF}
|
|
{--------}
|
|
procedure TOvcSelectionList.ExtendRange(RowNum : TRowNum; ColNum : TColNum;
|
|
IsSelecting : boolean);
|
|
begin
|
|
if (RowNum < 0) or (RowNum >= slRowCount) or
|
|
(ColNum < 0) or (ColNum >= slColCount) then
|
|
Exit;
|
|
slSelecting := IsSelecting;
|
|
slActiveRow := RowNum;
|
|
slActiveCol := ColNum;
|
|
slEmptyRange := (slAnchorRow = RowNum) and (slAnchorCol = ColNum);
|
|
if not slEmptyRange then
|
|
begin
|
|
slColMin := MinL(slAnchorCol, ColNum);
|
|
slColMax := MaxL(slAnchorCol, ColNum);
|
|
slRowMin := MinL(slAnchorRow, RowNum);
|
|
slRowMax := MaxL(slAnchorRow, RowNum);
|
|
end;
|
|
end;
|
|
{--------}
|
|
function TOvcSelectionList.HaveSelection : boolean;
|
|
begin
|
|
Result := (not slEmptyRange) or (slColWithSelCount <> 0);
|
|
end;
|
|
{--------}
|
|
function TOvcSelectionList.IsCellSelected(RowNum : TRowNum; ColNum : TColNum) : boolean;
|
|
var
|
|
i : integer;
|
|
begin
|
|
{assume false, the cell is not selected}
|
|
Result := false;
|
|
{sanity checks}
|
|
if (RowNum < 0) or (RowNum >= slRowCount) or
|
|
(ColNum < 0) or (ColNum >= slColCount) then
|
|
Exit;
|
|
{check in current range}
|
|
if (not slEmptyRange) then
|
|
if (slColMin <= ColNum) and (ColNum <= slColMax) and
|
|
(slRowMin <= RowNum) and (RowNum <= slRowMax) then
|
|
begin
|
|
Result := slSelecting;
|
|
Exit;
|
|
end;
|
|
{if the column array exists, search through it; note we use a
|
|
sequential search: it'll be faster than a binary search for a
|
|
'few' elements, and generally there will be 'few' elements}
|
|
if Assigned(slArray^[ColNum]) then with slArray^[ColNum]^ do
|
|
for i := 0 to pred(RRCount) do
|
|
if (RRs[i].L <= RowNum) and (RowNum <= RRs[i].H) then
|
|
begin
|
|
Result := true;
|
|
Exit;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TOvcSelectionList.Iterate(SI : TSelectionIterator; ExtraData : pointer);
|
|
var
|
|
ColNum : TColNum;
|
|
RangeNum : integer;
|
|
begin
|
|
{fix the current range}
|
|
if not slEmptyRange then
|
|
begin
|
|
if slSelecting then
|
|
SelectCellRange(slRowMin, slColMin, slRowMax, slColMax)
|
|
else
|
|
DeselectCellRange(slRowMin, slColMin, slRowMax, slColMax);
|
|
slEmptyRange := true;
|
|
end;
|
|
{iterate through the ranges}
|
|
for ColNum := 0 to pred(slColCount) do
|
|
if Assigned(slArray^[ColNum]) then
|
|
with slArray^[ColNum]^ do
|
|
for RangeNum := 0 to pred(RRCount) do
|
|
if not SI(RRs[RangeNum].L, ColNum, RRs[RangeNum].H, ColNum, ExtraData) then
|
|
Exit;
|
|
end;
|
|
{--------}
|
|
procedure TOvcSelectionList.SelectAll;
|
|
var
|
|
ColNum : TColNum;
|
|
begin
|
|
for ColNum := 0 to pred(slColCount) do
|
|
begin
|
|
if not Assigned(slArray^[ColNum]) then
|
|
AllocRRArray(slArray^[ColNum]);
|
|
with slArray^[ColNum]^ do
|
|
begin
|
|
RRCount := 1;
|
|
RRs[0].L := 0;
|
|
RRs[0].H := pred(slRowCount);
|
|
end;
|
|
end;
|
|
slColWithSelCount := slColCount;
|
|
end;
|
|
{--------}
|
|
procedure TOvcSelectionList.SelectCell(RowNum : TRowNum; ColNum : TColNum);
|
|
begin
|
|
{sanity checks}
|
|
if (RowNum < 0) or (RowNum >= slRowCount) or
|
|
(ColNum < 0) or (ColNum >= slColCount) then
|
|
Exit;
|
|
{do it}
|
|
slSelectCellRangeInCol(RowNum, RowNum, ColNum);
|
|
end;
|
|
{--------}
|
|
procedure TOvcSelectionList.SelectCellRange(FromRow : TRowNum; FromCol : TColNum;
|
|
ToRow : TRowNum; ToCol : TColNum);
|
|
var
|
|
ColNum : TColNum;
|
|
SwapTemp : longint;
|
|
begin
|
|
{save the caller from himself: sort the rows/cols into ascending order}
|
|
if FromRow > ToRow then
|
|
begin
|
|
SwapTemp := FromRow;
|
|
FromRow := ToRow;
|
|
ToRow := SwapTemp;
|
|
end;
|
|
if FromCol > ToCol then
|
|
begin
|
|
SwapTemp := FromCol;
|
|
FromCol := ToCol;
|
|
ToCol := SwapTemp;
|
|
end;
|
|
{sanity checks}
|
|
if (FromRow < 0) or (FromRow >= slRowCount) or
|
|
(ToRow < 0) or (ToRow >= slRowCount) or
|
|
(FromCol < 0) or (FromCol >= slColCount) or
|
|
(ToCol < 0) or (ToCol >= slColCount) then
|
|
Exit;
|
|
{for each column, select cells in that column}
|
|
for ColNum := FromCol to ToCol do
|
|
slSelectCellRangeInCol(FromRow, ToRow, ColNum);
|
|
end;
|
|
{--------}
|
|
{$IFDEF SuppressWarnings}
|
|
{$WARNINGS OFF}
|
|
{$ENDIF}
|
|
procedure TOvcSelectionList.slSelectCellRangeInCol(Row1, Row2 : TRowNum;
|
|
ColNum : TColNum);
|
|
var
|
|
i : integer;
|
|
Inx : integer;
|
|
NextInx : integer;
|
|
RRA : POvcSelRRArray;
|
|
MustInsert : boolean;
|
|
StillGoing : boolean;
|
|
AlreadyMerged: boolean;
|
|
begin
|
|
Inx := 0;
|
|
{take care of the simple special case first: there are no
|
|
selections in the column as yet}
|
|
if (not Assigned(slArray^[ColNum])) then
|
|
begin
|
|
AllocRRArray(slArray^[ColNum]);
|
|
inc(slColWithSelCount);
|
|
with slArray^[ColNum]^ do
|
|
begin
|
|
RRCount := 1;
|
|
RRs[0].L := Row1;
|
|
RRs[0].H := Row2;
|
|
end;
|
|
Exit;
|
|
end;
|
|
{make sure the array has at least one spare element}
|
|
RRA := slArray^[ColNum];
|
|
if (RRA^.RRCount = RRA^.RRTotal) then
|
|
begin
|
|
AllocRRArray(RRA);
|
|
slArray^[ColNum] := RRA;
|
|
end;
|
|
{with this array}
|
|
with RRA^ do
|
|
begin
|
|
{search for the place to insert/merge}
|
|
MustInsert := false;
|
|
for i := 0 to pred(RRCount) do
|
|
if (Row1 < RRs[i].L) then
|
|
begin
|
|
MustInsert := true;
|
|
Inx := i;
|
|
Break;{out of for loop}
|
|
end;
|
|
{if the new range appears after all the other ranges, add it
|
|
to the end of the list; check to be able to merge it first}
|
|
if not MustInsert then
|
|
begin
|
|
if (Row1 <= succ(RRs[pred(RRCount)].H)) then
|
|
RRs[pred(RRCount)].H := MaxL(Row2, RRs[pred(RRCount)].H)
|
|
else
|
|
begin
|
|
RRs[RRCount].L := Row1;
|
|
RRs[RRCount].H := Row2;
|
|
inc(RRCount);
|
|
end;
|
|
Exit;
|
|
end;
|
|
{otherwise we must insert; first insert the new range}
|
|
Move(RRs[Inx], RRs[succ(Inx)], (RRCount-Inx) * RRElemSize);
|
|
RRs[Inx].L := Row1;
|
|
RRs[Inx].H := Row2;
|
|
inc(RRCount);
|
|
{now walk through the array starting at pred(Inx) and merge
|
|
ranges as we move forward}
|
|
if (Inx > 0) then
|
|
dec(Inx);
|
|
NextInx := succ(Inx);
|
|
AlreadyMerged := false;
|
|
StillGoing := true;
|
|
while StillGoing and (NextInx < RRCount) do
|
|
begin
|
|
if (succ(RRs[Inx].H) >= RRs[NextInx].L) then
|
|
begin
|
|
RRs[Inx].H := MaxL(RRs[Inx].H, RRs[NextInx].H);
|
|
inc(NextInx);
|
|
AlreadyMerged := true;
|
|
end
|
|
else if AlreadyMerged then
|
|
StillGoing := false
|
|
else
|
|
begin
|
|
inc(Inx);
|
|
inc(NextInx);
|
|
AlreadyMerged := true;
|
|
end;
|
|
end;
|
|
{by this point we know we must get rid of the elements
|
|
in between Inx and NextInx -- they've been merged into
|
|
other ranges}
|
|
if ((NextInx - Inx) > 1) then
|
|
begin
|
|
if (NextInx < RRCount) then
|
|
Move(RRs[NextInx], RRs[succ(Inx)], (RRCount-NextInx)*RRElemSize);
|
|
dec(RRCount, NextInx - Inx - 1);
|
|
end;
|
|
end;
|
|
end;
|
|
{$IFDEF SuppressWarnings}
|
|
{$WARNINGS ON}
|
|
{$ENDIF}
|
|
{--------}
|
|
procedure TOvcSelectionList.SetRangeAnchor(RowNum : TRowNum; ColNum : TColNum;
|
|
Action : TOvcTblSelectionType);
|
|
begin
|
|
{sanity checks}
|
|
if (RowNum < 0) or (RowNum >= slRowCount) or
|
|
(ColNum < 0) or (ColNum >= slColCount) then
|
|
Exit;
|
|
{what's happening? deselecting all, or adding a new range}
|
|
if (Action = tstDeselectAll) then
|
|
DeselectAll
|
|
else {an additional range is being set up}
|
|
if not slEmptyRange then
|
|
if slSelecting then
|
|
SelectCellRange(slRowMin, slColMin, slRowMax, slColMax)
|
|
else
|
|
DeselectCellRange(slRowMin, slColMin, slRowMax, slColMax);
|
|
slAnchorRow := RowNum;
|
|
slAnchorCol := ColNum;
|
|
slActiveRow := RowNum;
|
|
slActiveCol := ColNum;
|
|
slEmptyRange := true;
|
|
end;
|
|
{--------}
|
|
procedure TOvcSelectionList.SetColCount(ColCount : TColNum);
|
|
begin
|
|
if (ColCount >= 0) then
|
|
begin
|
|
ReallocColArray(slArray, slColCount, ColCount);
|
|
slColCount := ColCount;
|
|
end;
|
|
end;
|
|
{--------}
|
|
procedure TOvcSelectionList.SetRowCount(RowCount : TRowNum);
|
|
begin
|
|
if (RowCount >= 0) then
|
|
slRowCount := RowCount;
|
|
end;
|
|
{====================================================================}
|
|
|
|
end.
|