paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Add methods InsertRow and InsertCol to TsWorksheet and TsWorksheetGrid. Update demo "spready".

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3381 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2014-07-26 17:05:21 +00:00
parent 9f7237554d
commit e7f10f498f
4 changed files with 329 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

105
components/fpspreadsheet/examples/spready/mainform.lfm
View File

@ -188,7 +188,7 @@ object Form1: TForm1
Action = AcSaveAs
end
object ToolButton3: TToolButton
Left = 103
Left = 149
Top = 0
Action = AcQuit
end
@ -205,7 +205,7 @@ object Form1: TForm1
Action = AcEdit
end
object ToolButton6: TToolButton
Left = 98
Left = 144
Top = 0
Width = 5
Caption = 'ToolButton6'
@ -216,6 +216,16 @@ object Form1: TForm1
Top = 0
Action = AcNew
end
object ToolButton23: TToolButton
Left = 98
Top = 0
Action = AcAddColumn
end
object ToolButton27: TToolButton
Left = 121
Top = 0
Action = AcAddRow
end
end
object FormatToolBar: TToolBar
Left = 0
@ -647,6 +657,15 @@ object Form1: TForm1
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
end
object MenuItem64: TMenuItem
Caption = '-'
end
object MenuItem65: TMenuItem
Action = AcAddColumn
end
object MenuItem66: TMenuItem
Action = AcAddRow
end
end
object mnuFormat: TMenuItem
Caption = 'Format'
@ -1067,7 +1086,7 @@ object Form1: TForm1
left = 272
top = 264
Bitmap = {
4C69230000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
4C69250000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00EAC39DFFE6BF96FFE4BB92FFE4BB92FFD1A06CF5D09E6DF6CC96
5FDAC479427EB2673C09FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00E5BE96FFFFFFFEFFFDF3E9FFFDF3EAFFFCF2E8FFFAEFE3FFFAF2
@ -2187,7 +2206,71 @@ object Form1: TForm1
FCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFCFCFFFCFC
FCFDF9F9F9F300000033FFFFFF00FFFFFF000000001D00000034000000360000
0036000000360000003600000036000000360000003600000036000000360000
0036000000330000001DFFFFFF00
0036000000330000001DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00A2AE8EFF5F9771FF4F8E
66FF49895FFFA2AE8EFFFFFFFF00FFFFFF00EFC2A37EEFC1A2E3EDC09FFFEBBE
9DFFEBBC9AFFE9BA96FFE7B793FFE6B590FF9DAF91FF61AB81FF95D4B4FFBAE6
D0FF6ABB8FFF2D8F57FF196B378CFFFFFF00EEC1A1EBFBF7F4FFFBF7F4FFFBF7
F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FF498960FF90D3B1FF92D6B1FFFFFF
FFFF65BC8CFF67BC8FFF196B37F7FFFFFF00ECBF9EFFFBF7F4FF9CD5A5FF98D3
A1FF94D09DFF90CE98FF8BCB93FF87C98EFF317B4CFF9CD4B6FFFFFFFFFFFFFF
FFFFFFFFFFFF95D2B2FF196B37FFFFFFFF00EBBD9BFFFBF7F4FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF22703EFF62BA8BFF60BA87FFFFFF
FFFF60B987FF67BC8FFF196B37F7FFFFFF00E9BA98FFFBF7F4FFE9C3A6FFE9C3
A6FFE9C3A6FFE9C3A6FFE9C3A6FFE9C3A6FFA2AE8EFF288C53FF64BA8DFF95D2
B2FF64BA8DFF288C53FF196B378CFFFFFF00E7B794FFFBF7F4FFE9C3A6FFFFFF
FFFFE8C4A9FFFFFFFFFFFFFFFFFFFFFFFFFFE8C7ACFF84B094FF257341FF196B
37FF247240FF6C7C4AFFFFFFFF00FFFFFF00E5B48FFFFAF6F2FFE9C6AAFFE9C6
ACFFEAC7ACFFE9C7ADFFE9C9AEFFE9C9B0FFE8C7ACFFE9C9B0FFE8C8B0FFE8CC
B5FFF2E7DEFFC88A59FFFFFFFF00FFFFFF00E3B18CFFFAF6F1FFEAC9AEFFFFFF
FFFFEAC9B0FFFFFFFFFFFFFFFFFFFFFFFFFFE8C7ACFFFFFFFFFFFFFFFFFFFFFF
FFFFF1E5DBFFC68655FFFFFFFF00FFFFFF00E1AE87FFFAF4F0FF59B163FF54AB
5EFF4FA358FF4FA358FF489B51FF42924AFF3B8842FF347E3AFF2E7533FF276D
2CFFF0E2D8FFC48654FFFFFFFF00FFFFFF00DFAA82FFF9F3EFFF58B162FFB9DF
BDFFB6DDBAFFB6DDBAFFACD8B0FFA0D3A4FF92CC97FF84C68AFF79C17EFF2265
26FFF0E2D8FFC88D5FFFFFFFFF00FFFFFF00DDA87EFFF9F3EFFF4FA358FF489B
51FF42924AFF42924AFF3B8842FF347E3AFF2E7533FF276D2CFF226526FF1D5F
21FFF0E2D8FFC68A5CFFFFFFFF00FFFFFF00D9A47AFFF9F3EEFFEBD2BEFFFFFF
FFFFEBD3BFFFFFFFFFFFFFFFFFFFFFFFFFFFEAC7ADFFFFFFFFFFFFFFFFFFFFFF
FFFFF0E2D8FFC68C5FFFFFFFFF00FFFFFF00D7A175FFF8F2EDFFF7F0EAFFF6ED
E6FFF4EAE2FFF3E7DEFFF1E4DBFFF0E2D8FFF0E2D8FFF0E2D8FFF0E2D8FFF0E2
D8FFF0E2D8FFC58A5DFDFFFFFF00FFFFFF00D69E72C4D3996EF4D19668FFCE92
63FFCB8E5EFFC98A5BFFC78756FFC38452FFC38452FFC38452FFC38452FFC384
52FFC38452FFBB7742B0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00A2AE8EFF5F9771FF4F8E
66FF49895FFFA2AE8EFFFFFFFF00FFFFFF00EFC2A37EEFC1A2E3EDC09FFFEBBE
9DFFEBBC9AFFE9BA96FFE7B793FFE6B590FF9DAF91FF61AB81FF95D4B4FFBAE6
D0FF6ABB8FFF2D8F57FF196B378CFFFFFF00EEC1A1EBFBF7F4FFFBF7F4FFFBF7
F4FFFBF7F4FFFBF7F4FFFBF7F4FFFBF7F4FF498960FF90D3B1FF92D6B1FFFFFF
FFFF65BC8CFF67BC8FFF196B37F7FFFFFF00ECBF9EFFFBF7F4FF9CD5A5FF98D3
A1FF94D09DFF90CE98FF8BCB93FF87C98EFF317B4CFF9CD4B6FFFFFFFFFFFFFF
FFFFFFFFFFFF95D2B2FF196B37FFFFFFFF00EBBD9BFFFBF7F4FFFFFFFFFFFFFF
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF22703EFF62BA8BFF60BA87FFFFFF
FFFF60B987FF67BC8FFF196B37F7FFFFFF00E9BA98FFFBF7F4FF4FA358FF4FA3
58FF59B163FFE9C3A6FFE9C3A6FFE9C3A6FFA2AE8EFF288C53FF64BA8DFF95D2
B2FF64BA8DFF288C53FF196B378CFFFFFF00E7B794FFFBF7F4FF489B51FFB9DF
BDFF54AB5EFFFFFFFFFFFFFFFFFFFFFFFFFFE8C7ACFF84B094FF257341FF196B
37FF247240FF6C7C4AFFFFFFFF00FFFFFF00E5B48FFFFAF6F2FF42924AFFB6DD
BAFF4FA358FFE9C7ADFFE9C9AEFFE9C9B0FFE8C7ACFFE9C9B0FFE8C8B0FFE8CC
B5FFF2E7DEFFC88A59FFFFFFFF00FFFFFF00E3B18CFFFAF6F1FF3B8842FFACD8
B0FF489B51FFFFFFFFFFFFFFFFFFFFFFFFFFE8C7ACFFFFFFFFFFFFFFFFFFFFFF
FFFFF1E5DBFFC68655FFFFFFFF00FFFFFF00E1AE87FFFAF4F0FF347E3AFFA0D3
A4FF42924AFFEACCB3FFEACCB3FFEACEB7FFE8C7ACFFE8C7ACFFE8C8B0FFE8C8
AEFFF0E2D8FFC48654FFFFFFFF00FFFFFF00DFAA82FFF9F3EFFF2E7533FF92CC
97FF3B8842FFFFFFFFFFFFFFFFFFFFFFFFFFEACFBAFFFBF6F2FFFFFFFFFFFFFF
FFFFF0E2D8FFC88D5FFFFFFFFF00FFFFFF00DDA87EFFF9F3EFFF276D2CFF84C6
8AFF347E3AFFEBD0BBFFEBD0BBFFEBD1BDFFEACDB5FFEACDB5FFEACDB5FFEACD
B5FFF0E2D8FFC68A5CFFFFFFFF00FFFFFF00D9A47AFFF9F3EEFF1D5F21FF2265
26FF276D2CFFFFFFFFFFFFFFFFFFFFFFFFFFEAC7ADFFFFFFFFFFFFFFFFFFFFFF
FFFFF0E2D8FFC68C5FFFFFFFFF00FFFFFF00D7A175FFF8F2EDFFF7F0EAFFF6ED
E6FFF4EAE2FFF3E7DEFFF1E4DBFFF0E2D8FFF0E2D8FFF0E2D8FFF0E2D8FFF0E2
D8FFF0E2D8FFC58A5DFDFFFFFF00FFFFFF00D69E72C4D3996EF4D19668FFCE92
63FFCB8E5EFFC98A5BFFC78756FFC38452FFC38452FFC38452FFC38452FFC384
52FFC38452FFBB7742B0FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00
}
end
object ActionList: TActionList
@ -2619,6 +2702,20 @@ object Form1: TForm1
ImageIndex = 3
OnExecute = AcEditExecute
end
object AcAddColumn: TAction
Category = 'Edit'
Caption = 'Add column'
Hint = 'Add column'
ImageIndex = 36
OnExecute = AcAddColumnExecute
end
object AcAddRow: TAction
Category = 'Edit'
Caption = 'Add row'
Hint = 'Add row'
ImageIndex = 35
OnExecute = AcAddRowExecute
end
end
object FontDialog: TFontDialog
MinFontSize = 0

21
components/fpspreadsheet/examples/spready/mainform.pas
View File

@ -69,6 +69,8 @@ type
AcNFCusstomMS: TAction;
AcNFCustomMSZ: TAction;
AcNew: TAction;
AcAddColumn: TAction;
AcAddRow: TAction;
AcWordwrap: TAction;
AcVAlignDefault: TAction;
AcVAlignTop: TAction;
@ -146,6 +148,9 @@ type
MenuItem61: TMenuItem;
MenuItem62: TMenuItem;
MenuItem63: TMenuItem;
MenuItem64: TMenuItem;
MenuItem65: TMenuItem;
MenuItem66: TMenuItem;
MnuFmtDateTimeMSZ: TMenuItem;
MnuTimeInterval: TMenuItem;
MnuShortTimeAM: TMenuItem;
@ -198,6 +203,8 @@ type
FormulaToolBar: TToolBar;
FormulaToolbarSplitter: TSplitter;
ToolButton22: TToolButton;
ToolButton23: TToolButton;
ToolButton27: TToolButton;
WorksheetGrid: TsWorksheetGrid;
TabSheet1: TTabSheet;
ToolBar1: TToolBar;
@ -228,6 +235,8 @@ type
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
procedure AcAddColumnExecute(Sender: TObject);
procedure AcAddRowExecute(Sender: TObject);
procedure AcBorderExecute(Sender: TObject);
procedure AcCopyFormatExecute(Sender: TObject);
procedure AcEditExecute(Sender: TObject);
@ -407,6 +416,18 @@ begin
end;
end;
procedure TForm1.AcAddColumnExecute(Sender: TObject);
begin
WorksheetGrid.InsertCol(WorksheetGrid.Col);
WorksheetGrid.Col := WorksheetGrid.Col + 1;
end;
procedure TForm1.AcAddRowExecute(Sender: TObject);
begin
WorksheetGrid.InsertRow(WorksheetGrid.Row);
WorksheetGrid.Row := WorksheetGrid.Row + 1;
end;
procedure TForm1.AcCopyFormatExecute(Sender: TObject);
var
cell: PCell;

140
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -502,6 +502,8 @@ type
{ Callback procedures called when iterating through all cells }
procedure CalcFormulaCallback(data, arg: Pointer);
procedure CalcStateCallback(data, arg: Pointer);
procedure InsertColCallback(data, arg: Pointer);
procedure InsertRowCallback(data, arg: Pointer);
procedure RemoveCallback(data, arg: pointer);
protected
@ -667,6 +669,8 @@ type
function GetRowHeight(ARow: Cardinal): Single;
function GetCol(ACol: Cardinal): PCol;
function GetColWidth(ACol: Cardinal): Single;
procedure InsertCol(ACol: Cardinal);
procedure InsertRow(ARow: Cardinal);
procedure RemoveAllRows;
procedure RemoveAllCols;
procedure WriteRowInfo(ARow: Cardinal; AData: TRow);
@ -3829,8 +3833,10 @@ begin
FillChar(Result^, SizeOf(TRow), #0);
Result^.Row := ARow;
FRows.Add(Result);
if FLastRowIndex = 0 then FLastRowIndex := GetLastRowIndex(true)
else FLastRowIndex := Max(FLastRowIndex, ARow);
if FLastRowIndex = 0 then
FLastRowIndex := GetLastRowIndex(true)
else
FLastRowIndex := Max(FLastRowIndex, ARow);
end;
end;
@ -3849,8 +3855,10 @@ begin
FillChar(Result^, SizeOf(TCol), #0);
Result^.Col := ACol;
FCols.Add(Result);
if FLastColIndex = 0 then FLastColIndex := GetLastColIndex(true)
else FLastColIndex := Max(FLastColIndex, ACol);
if FLastColIndex = 0 then
FLastColIndex := GetLastColIndex(true)
else
FLastColIndex := Max(FLastColIndex, ACol);
end;
end;
@ -3940,6 +3948,130 @@ begin
Result := FWorkbook.DefaultRowHeight;
end;
procedure TsWorksheet.InsertColCallback(data, arg: Pointer);
var
cell: PCell;
col: PtrInt;
fe: TsFormulaElement;
i: Integer;
begin
col := PtrInt(arg);
cell := PCell(data);
// Update column index of moved cells
if cell^.Col >= col then
inc(cell^.Col);
// Update rpn formulas
for i:=0 to Length(cell^.RPNFormulaValue)-1 do begin
fe := cell^.RPNFormulaValue[i]; // "fe" means "formula element"
case fe.ElementKind of
fekCell, fekCellRef: if fe.Col >= col then inc(fe.Col);
fekCellRange:
begin
if fe.Col >= col then inc(fe.Col);
if fe.Col2 >= col then inc(fe.Col2);
end;
end;
end;
end;
{@@
Inserts a column BEFORE the index specified. Cells with greater column indexes are
moved one column up. Cell references in rpn formulas are considered as well.
However, lacking a parser for string formulas, references in string formulas
are not changed which may lead to incorrect operation!
@param ACol Index of the column before which a new column is inserted.
}
procedure TsWorksheet.InsertCol(ACol: Cardinal);
var
cellnode: TAVLTreeNode;
cell: PCell;
col: PCol;
i: Integer;
begin
// Update column index of cell records
cellnode := FCells.FindLowest;
while Assigned(cellnode) do begin
InsertColCallback(cellnode.Data, pointer(PtrInt(ACol)));
cellnode := FCells.FindSuccessor(cellnode);
end;
// Update column index of column records
for i:=0 to FCols.Count-1 do begin
col := PCol(FCols.Items[i]);
if col^.Col >= ACol then inc(col^.Col);
end;
// Update last column index
inc(FLastColIndex);
ChangedCell(0, ACol);
end;
procedure TsWorksheet.InsertRowCallback(data, arg: Pointer);
var
cell: PCell;
row: PtrInt;
i: Integer;
fe: TsFormulaElement;
begin
row := PtrInt(arg);
cell := PCell(data);
// Update row index of moved cells
if cell^.Row >= row then
inc(cell^.Row);
// Update rpn formulas
for i:=0 to Length(cell^.RPNFormulaValue)-1 do begin
fe := cell^.RPNFormulaValue[i]; // "fe" means "formula element"
case fe.ElementKind of
fekCell, fekCellRef: if fe.Row >= row then inc(fe.Row);
fekCellRange:
begin
if fe.Row >= row then inc(fe.Row);
if fe.Row2 >= row then inc(fe.Row2);
end;
end;
end;
end;
{@@
Inserts a row BEFORE the row specified. Cells with greater row indexes are
moved one row up. Cell references in rpn formulas are considered as well.
However, lacking a parser for string formulas, references in string formulas
are not changed which may lead to incorrect operation!
@param ARow Index of the row before which a new row is inserted.
}
procedure TsWorksheet.InsertRow(ARow: Cardinal);
var
cell: PCell;
row: PRow;
cellnode: TAVLTreeNode;
i: Integer;
begin
// Update row index of cell records
cellnode := FCells.FindLowest;
while Assigned(cellnode) do begin
InsertRowCallback(cellnode.Data, pointer(PtrInt(ARow)));
cellnode := FCells.FindSuccessor(cellnode);
end;
// Update row index of row records
for i:=0 to FRows.Count-1 do begin
row := PRow(FRows.Items[i]);
if row^.Row >= ARow then inc(row^.Row);
end;
// Update last row index
inc(FLastRowIndex);
ChangedCell(ARow, 0);
end;
{@@
Removes all row records from the worksheet and frees the occupied memory.
Note: Cells are retained.

85
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -138,6 +138,8 @@ type
procedure SelectEditor; override;
procedure SetEditText(ACol, ARow: Longint; const AValue: string); override;
procedure Setup;
procedure UpdateColWidths(AStartIndex: Integer = 0);
procedure UpdateRowHeights(AStartIndex: Integer = 0);
{@@ Displays column and row headers in the fixed col/row style of the grid.
Deprecated. Use ShowHeaders instead. }
property DisplayFixedColRow: Boolean read GetShowHeaders write SetShowHeaders default true;
@ -168,6 +170,8 @@ type
function GetGridRow(ASheetRow: Cardinal): Integer;
function GetWorksheetCol(AGridCol: Integer): Cardinal;
function GetWorksheetRow(AGridRow: Integer): Cardinal;
procedure InsertCol(AGridCol: Integer);
procedure InsertRow(AGridRow: Integer);
procedure LoadFromSpreadsheetFile(AFileName: string;
AFormat: TsSpreadsheetFormat; AWorksheetIndex: Integer = 0); overload;
procedure LoadFromSpreadsheetFile(AFileName: string;
@ -2235,6 +2239,41 @@ begin
end;
end;
{@@
Inserts an empty column before the column specified
}
procedure TsCustomWorksheetGrid.InsertCol(AGridCol: Integer);
var
c: Cardinal;
begin
if AGridCol < FHeaderCount then
exit;
if FWorksheet.GetLastColIndex+1 + FHeaderCount >= FInitColCount then
ColCount := ColCount + 1;
c := AGridCol - FHeaderCount;
FWorksheet.InsertCol(c);
UpdateColWidths(AGridCol);
end;
{@@
Inserts an empty row before the row specified
}
procedure TsCustomWorksheetGrid.InsertRow(AGridRow: Integer);
var
r: Cardinal;
begin
if AGridRow < FHeaderCount then
exit;
if FWorksheet.GetlastRowIndex+1 + FHeaderCount >= FInitRowCount then
RowCount := RowCount + 1;
r := AGridRow - FHeaderCount;
FWorksheet.InsertRow(r);
UpdateRowHeights(AGridRow);
end;
{@@
Internal general text drawing method.
@ -2855,20 +2894,8 @@ begin
ColWidths[0] := Canvas.TextWidth(' 999999 ');
RowHeights[0] := DefaultRowHeight;
end;
for i := FHeaderCount to ColCount-1 do begin
lCol := FWorksheet.FindCol(i - FHeaderCount);
if (lCol <> nil) then
ColWidths[i] := CalcColWidth(lCol^.Width)
else
ColWidths[i] := DefaultColWidth;
end;
for i := FHeaderCount to RowCount-1 do begin
lRow := FWorksheet.FindRow(i - FHeaderCount);
if (lRow = nil) then
RowHeights[i] := CalcAutoRowHeight(i)
else
RowHeights[i] := CalcRowHeight(lRow^.Height);
end;
UpdateColWidths;
UpdateRowHeights;
end;
Invalidate;
end;
@ -2917,6 +2944,36 @@ begin
end;
end;
procedure TsCustomWorksheetGrid.UpdateColWidths(AStartIndex: Integer = 0);
var
i: Integer;
lCol: PCol;
begin
if AStartIndex = 0 then AStartIndex := FHeaderCount;
for i := AStartIndex to ColCount-1 do begin
lCol := FWorksheet.FindCol(i - FHeaderCount);
if lCol <> nil then
ColWidths[i] := CalcColWidth(lCol^.Width)
else
ColWidths[i] := DefaultColWidth;
end;
end;
procedure TsCustomWorksheetGrid.UpdateRowHeights(AStartIndex: Integer = 0);
var
i: Integer;
lRow: PRow;
begin
if AStartIndex <= 0 then AStartIndex := FHeaderCount;
for i := AStartIndex to RowCount-1 do begin
lRow := FWorksheet.FindRow(i - FHeaderCount);
if (lRow = nil) then
RowHeights[i] := CalcAutoRowHeight(i)
else
RowHeights[i] := CalcRowHeight(lRow^.Height);
end;
end;
{@@
Loads the worksheet into the grid and displays its contents.