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

fpspreadsheet: Add new property AutoExpand to the WorksheetGrid. Extend fpsgrids demo (no install version) correspondingly.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4451 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2016-01-21 16:23:56 +00:00
parent 71a97d460c
commit 58b31b09a7
6 changed files with 213 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
components/fpspreadsheet/examples/visual/fpsgrid/mainform.lfm
View File

@ -46,41 +46,18 @@ object Form1: TForm1
OnClick = BtnNewClick
TabOrder = 2
end
object Label2: TLabel
Left = 296
Height = 15
Top = 13
Width = 132
Caption = 'New text for cell [AB110]:'
ParentColor = False
end
object EdNewCellText: TEdit
Left = 451
Height = 23
Top = 9
Width = 104
TabOrder = 3
Text = 'Test'
end
object BtnEnterText: TButton
Left = 566
Height = 25
Top = 8
Width = 75
Caption = 'Set text'
OnClick = BtnEnterTextClick
TabOrder = 4
end
end
object WorksheetGrid: TsWorksheetGrid
Left = 0
Height = 572
Top = 36
Height = 576
Top = 32
Width = 894
AutoCalc = True
FrozenCols = 0
FrozenRows = 0
ReadFormulas = False
SelectionPen.JoinStyle = pjsMiter
SelectionPen.Width = 3
WorkbookSource = WorksheetGrid.internal
Align = alClient
AutoAdvance = aaDown
@ -95,18 +72,18 @@ object Form1: TForm1
end
object Panel2: TPanel
Left = 0
Height = 36
Height = 32
Top = 0
Width = 894
Align = alTop
BevelOuter = bvNone
ClientHeight = 36
ClientHeight = 32
ClientWidth = 894
TabOrder = 2
object Label1: TLabel
Left = 8
Height = 15
Top = 9
Top = 8
Width = 37
Caption = 'Sheets:'
ParentColor = False

9
components/fpspreadsheet/examples/visual/fpsgrid/mainform.pas
View File

@ -17,9 +17,6 @@ type
BtnOpen: TButton;
BtnSave: TButton;
BtnNew: TButton;
BtnEnterText: TButton;
EdNewCellText: TEdit;
Label2: TLabel;
SheetsCombo: TComboBox;
Label1: TLabel;
OpenDialog: TOpenDialog;
@ -30,7 +27,6 @@ type
procedure BtnNewClick(Sender: TObject);
procedure BtnOpenClick(Sender: TObject);
procedure BtnSaveClick(Sender: TObject);
procedure BtnEnterTextClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SheetsComboSelect(Sender: TObject);
private
@ -201,11 +197,6 @@ begin
WorksheetGrid.NumberFormat[2,6] := '0.000';
end;
procedure TForm1.BtnEnterTextClick(Sender: TObject);
begin
WorksheetGrid.Worksheet.WriteText(109, 27, EdNewCellText.Text);
end;
procedure TForm1.SheetsComboSelect(Sender: TObject);
begin
WorksheetGrid.SelectSheetByIndex(SheetsCombo.ItemIndex);

107
components/fpspreadsheet/examples/visual/fpsgrid_no_install/mainfrm.lfm
View File

@ -10,18 +10,18 @@ object Form1: TForm1
LCLVersion = '1.7'
object ButtonPanel: TPanel
Left = 0
Height = 38
Top = 382
Height = 42
Top = 378
Width = 680
Align = alBottom
BevelOuter = bvNone
ClientHeight = 38
ClientHeight = 42
ClientWidth = 680
TabOrder = 0
object BtnNew: TButton
Left = 8
Height = 25
Top = 6
Top = 8
Width = 75
Caption = 'New'
OnClick = BtnNewClick
@ -30,7 +30,7 @@ object Form1: TForm1
object BtnLoad: TButton
Left = 94
Height = 25
Top = 6
Top = 8
Width = 75
Caption = 'Load...'
OnClick = BtnLoadClick
@ -39,41 +39,24 @@ object Form1: TForm1
object BtnSave: TButton
Left = 180
Height = 25
Top = 6
Top = 8
Width = 75
Caption = 'Save...'
OnClick = BtnSaveClick
TabOrder = 2
end
object Label1: TLabel
Left = 288
Height = 15
Top = 11
Width = 144
Caption = 'Enter value for cell [AB110]:'
ParentColor = False
end
object EdCellValue: TEdit
Left = 439
Height = 23
Top = 7
Width = 137
TabOrder = 3
Text = 'Test'
end
object BtnEnterText: TButton
Left = 584
Height = 25
Top = 6
Width = 75
Caption = 'Enter text'
OnClick = BtnEnterTextClick
TabOrder = 4
object Bevel1: TBevel
Left = 0
Height = 3
Top = 0
Width = 680
Align = alTop
Shape = bsTopLine
end
end
object TabControl: TTabControl
Left = 0
Height = 382
Height = 345
Top = 0
Width = 680
OnChange = TabControlChange
@ -84,6 +67,68 @@ object Form1: TForm1
Align = alClient
TabOrder = 1
end
object Panel1: TPanel
Left = 0
Height = 33
Top = 345
Width = 680
Align = alBottom
BevelOuter = bvNone
ClientHeight = 33
ClientWidth = 680
TabOrder = 2
object Label2: TLabel
Left = 8
Height = 15
Top = 8
Width = 101
Caption = 'AutoExpand mode:'
ParentColor = False
end
object CbAutoExpandOnData: TCheckBox
Left = 128
Height = 19
Top = 6
Width = 44
Caption = 'Data'
OnChange = CbAutoExpandOnDataChange
TabOrder = 0
end
object CbAutoExpandOnNavigation: TCheckBox
Left = 184
Height = 19
Top = 6
Width = 78
Caption = 'Navigation'
OnChange = CbAutoExpandOnNavigationChange
TabOrder = 1
end
object Label1: TLabel
Left = 288
Height = 15
Top = 8
Width = 144
Caption = 'Enter value for cell [AB110]:'
ParentColor = False
end
object EdCellValue: TEdit
Left = 439
Height = 23
Top = 4
Width = 137
TabOrder = 2
Text = 'Test'
end
object BtnEnterText: TButton
Left = 584
Height = 25
Top = 3
Width = 75
Caption = 'Enter text'
OnClick = BtnEnterTextClick
TabOrder = 3
end
end
object OpenDialog: TOpenDialog
DefaultExt = '.xls'
Filter = 'Excel spreadsheet (*.xls)|*.xls|Excel XML spreadsheet (*.xlsx)|*.xlsx|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Wikitable (pipes) (.wikitable_pipes)|.wikitable_pipes|All files (*.*)|*.*'

30
components/fpspreadsheet/examples/visual/fpsgrid_no_install/mainfrm.pas
View File

@ -14,20 +14,27 @@ type
{ TForm1 }
TForm1 = class(TForm)
Bevel1: TBevel;
BtnNew: TButton;
BtnLoad: TButton;
BtnSave: TButton;
BtnEnterText: TButton;
ButtonPanel: TPanel;
CbAutoExpandOnData: TCheckBox;
CbAutoExpandOnNavigation: TCheckBox;
EdCellValue: TEdit;
Label1: TLabel;
Label2: TLabel;
OpenDialog: TOpenDialog;
Panel1: TPanel;
SaveDialog: TSaveDialog;
TabControl: TTabControl;
procedure BtnEnterTextClick(Sender: TObject);
procedure BtnLoadClick(Sender: TObject);
procedure BtnNewClick(Sender: TObject);
procedure BtnSaveClick(Sender: TObject);
procedure CbAutoExpandOnDataChange(Sender: TObject);
procedure CbAutoExpandOnNavigationChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TabControlChange(Sender: TObject);
private
@ -65,6 +72,8 @@ begin
// Useful options and properties
Grid.Options := Grid.Options + [goColSizing, goRowSizing,
// goAutoAddRows,
// goAutoAddRowsSkipContentCheck,
goFixedColSizing, // useful if the spreadsheet contains frozen columns
goEditing, // needed for modifying cell content
goThumbTracking, // see the grid scroll while you drag the scrollbar
@ -81,6 +90,9 @@ begin
Grid.RowCount := 10; // Prepare 10 columns (incl fixed header)
Grid.ColCount := 8; // and 8 rows (incl fixed header) - but grid expands automatically
CbAutoExpandOnData.Checked := aeData in Grid.AutoExpand;
CbAutoExpandOnNavigation.Checked := aeNavigation in Grid.AutoExpand;
// Add some cells and formats
Grid.ColWidths[1] := 180;
Grid.ColWidths[2] := 100;
@ -90,7 +102,7 @@ begin
Grid.HorAlignment[1,1] := haCenter;
Grid.CellBorders[1,1, 2,1] := [cbSouth];
Grid.CellBorderStyles[1,1, 2,1, cbSouth] := THICK_BORDER;
Grid.BackgroundColors[1,1, 2,1] := RGBToColor(220, 220, 220);
Grid.BackgroundColors[1,1, 2,1] := RGBToColor(232, 242, 255);
Grid.CellFontColor[1,1] := clNavy;
Grid.CellFontStyle[1,1] := [fssBold];
@ -127,6 +139,8 @@ begin
Grid.Cells[2,6] := '=B2^2*PI()';
Grid.CellComment[2,6] := 'Area of the circle with radius given in cell B2';
Grid.NumberFormat[2,6] := '0.000';
ActiveControl := Grid;
end;
procedure TForm1.BtnLoadClick(Sender: TObject);
@ -186,6 +200,20 @@ begin
end;
end;
procedure TForm1.CbAutoExpandOnDataChange(Sender: TObject);
begin
if CbAutoExpandOnData.Checked then
Grid.AutoExpand := Grid.AutoExpand + [aeData] else
Grid.AutoExpand := Grid.AutoExpand - [aeData];
end;
procedure TForm1.CbAutoExpandOnNavigationChange(Sender: TObject);
begin
if CbAutoExpandOnNavigation.Checked then
Grid.AutoExpand := Grid.AutoExpand + [aeNavigation] else
Grid.AutoExpand := Grid.AutoExpand - [aeNavigation];
end;
// Loads first worksheet from file into grid
procedure TForm1.LoadFile(const AFileName: String);
var

150
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -36,6 +36,9 @@ type
{ TsCustomWorksheetGrid }
TsAutoExpandMode = (aeData, aeNavigation);
TsAutoExpandModes = set of TsAutoExpandMode;
TsHyperlinkClickEvent = procedure(Sender: TObject;
const AHyperlink: TsHyperlink) of object;
@ -61,6 +64,7 @@ type
FReadFormulas: Boolean;
FDrawingCell: PCell;
FTextOverflowing: Boolean;
FAutoExpand: TsAutoExpandModes;
FEnhEditMode: Boolean;
FSelPen: TPen;
FHyperlinkTimer: TTimer;
@ -169,6 +173,8 @@ type
{ Protected declarations }
procedure AutoAdjustColumn(ACol: Integer); override;
procedure AutoAdjustRow(ARow: Integer); virtual;
procedure AutoExpandToCol(ACol: Integer; AMode: TsAutoExpandMode);
procedure AutoExpandToRow(ARow: Integer; AMode: TsAutoExpandMode);
function CalcWorksheetColWidth(AValue: Integer): Single;
function CalcWorksheetRowHeight(AValue: Integer): Single;
function CellOverflow(ACol, ARow: Integer; AState: TGridDrawState;
@ -204,21 +210,13 @@ type
ACellHorAlign: TsHorAlignment; ACellVertAlign: TsVertAlignment;
ATextRot: TsTextRotation; ATextWrap: Boolean; AFontIndex: Integer;
AOverrideTextColor: TColor; ARichTextParams: TsRichTextParams);
{
procedure InternalDrawTextInCell(AText, AMeasureText: String; ARect: TRect;
AJustification: Byte; ACellHorAlign: TsHorAlignment;
ACellVertAlign: TsVertAlignment; ATextRot: TsTextRotation;
ATextWrap, ReplaceTooLong: Boolean; ARichTextParams: TsRichTextParams);
}
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
procedure Loaded; override;
// procedure LoadFromWorksheet(AWorksheet: TsWorksheet);
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MoveSelection; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
// function SelectCell(AGridCol, AGridRow: Integer): Boolean; override;
procedure SelectEditor; override;
procedure SelPenChangeHandler(Sender: TObject);
procedure SetEditText(ACol, ARow: Longint; const AValue: string); override;
@ -228,8 +226,11 @@ type
function TrimToCell(ACell: PCell): String;
procedure UpdateColWidths(AStartIndex: Integer = 0);
procedure UpdateRowHeights(AStartIndex: Integer = 0);
{@@ Automatically recalculate formulas whenever a cell value changes. }
property AutoCalc: Boolean read FAutoCalc write SetAutoCalc default false;
{@@ Automatically expand grid dimensions }
property AutoExpand: TsAutoExpandModes read FAutoExpand write FAutoExpand;
{@@ 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;
@ -465,6 +466,8 @@ type
// inherited from TsCustomWorksheetGrid
{@@ Automatically recalculates the worksheet if a cell value changes. }
property AutoCalc;
{@@ Automatically expand grid dimensions }
property AutoExpand default [aeData];
{@@ Displays column and row headers in the fixed col/row style of the grid.
Deprecated. Use ShowHeaders instead. }
property DisplayFixedColRow; deprecated 'Use ShowHeaders';
@ -953,6 +956,7 @@ begin
FSelPen.Color := clBlack;
FSelPen.JoinStyle := pjsMiter;
FSelPen.OnChange := @SelPenChangeHandler;
FAutoExpand := [aeData];
FHyperlinkTimer := TTimer.Create(self);
FHyperlinkTimer.Interval := HYPERLINK_TIMER_INTERVAL;
FHyperlinkTimer.OnTimer := @HyperlinkTimerElapsed;
@ -1032,6 +1036,36 @@ begin
HeaderSized(false, ARow);
end;
{@@ ----------------------------------------------------------------------------
Automatically expands the ColCount such that the specified column fits in
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.AutoExpandToCol(ACol: Integer;
AMode: TsAutoExpandMode);
begin
if ACol >= ColCount then
begin
if (AMode in FAutoExpand) then
ColCount := ACol + 1
else
raise Exception.Create(rsOperationExceedsColCount);
end;
end;
{@@ ----------------------------------------------------------------------------
Automatically expands the RowCount such that the specified column fits in
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.AutoExpandToRow(ARow: Integer;
AMode: TsAutoExpandMode);
begin
if ARow >= RowCount then
begin
if (AMode in FAutoExpand) then
RowCount := ARow + 1
else
raise Exception.Create(rsOperationExceedsRowCount);
end;
end;
{@@ ----------------------------------------------------------------------------
The BeginUpdate/EndUpdate pair suppresses unnecessary painting of the grid.
Call BeginUpdate to stop refreshing the grid, and call EndUpdate to release
@ -2447,15 +2481,14 @@ begin
if Assigned(FOnClickHyperlink) then FOnClickHyperlink(self, hlink);
end;
{@@ ----------------------------------------------------------------------------
Copies the borders of a cell to its neighbors. This avoids the nightmare of
changing borders due to border conflicts of adjacent cells.
Copies the borders of a cell to the correspondig edges of its neighbors.
This avoids the nightmare of changing borders due to border conflicts
of adjacent cells.
@param ACell Pointer to the cell
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.FixNeighborCellBorders(ACell: PCell);
//Col, ARow: Integer);
procedure SetNeighborBorder(NewRow, NewCol: Cardinal;
ANewBorder: TsCellBorder; const ANewBorderStyle: TsCellBorderStyle;
@ -2481,21 +2514,19 @@ procedure TsCustomWorksheetGrid.FixNeighborCellBorders(ACell: PCell);
var
fmt: PsCellFormat;
begin
if Worksheet = nil then
if (Worksheet = nil) or (ACell = nil) then
exit;
// cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if (Worksheet <> nil) and (ACell <> nil) then
with ACell^ do
begin
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
if Col > 0 then
SetNeighborBorder(Row, Col-1, cbEast, fmt^.BorderStyles[cbWest], cbWest in fmt^.Border);
SetNeighborBorder(Row, Col+1, cbWest, fmt^.BorderStyles[cbEast], cbEast in fmt^.Border);
if Row > 0 then
SetNeighborBorder(Row-1, Col, cbSouth, fmt^.BorderStyles[cbNorth], cbNorth in fmt^.Border);
SetNeighborBorder(Row+1, Col, cbNorth, fmt^.BorderStyles[cbSouth], cbSouth in fmt^.Border);
end;
with ACell^ do
begin
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
if Col > 0 then
SetNeighborBorder(Row, Col-1, cbEast, fmt^.BorderStyles[cbWest], cbWest in fmt^.Border);
SetNeighborBorder(Row, Col+1, cbWest, fmt^.BorderStyles[cbEast], cbEast in fmt^.Border);
if Row > 0 then
SetNeighborBorder(Row-1, Col, cbSouth, fmt^.BorderStyles[cbNorth], cbNorth in fmt^.Border);
SetNeighborBorder(Row+1, Col, cbNorth, fmt^.BorderStyles[cbSouth], cbSouth in fmt^.Border);
end;
end;
(*
@ -2755,7 +2786,7 @@ begin
end;
{@@ ----------------------------------------------------------------------------
Returns the font to be used when painting text in a cell.
Returns the (LCL) font to be used when painting text in a cell.
@param ACol Grid column index of the cell
@param ARow Grid row index of the cell
@ -2781,8 +2812,8 @@ begin
end;
{@@ ----------------------------------------------------------------------------
Returns the font to be used when painting text in the cells defined by the
rectangle of row/column indexes.
Returns the (LCL) font to be used when painting text in the cells defined
by the rectangle of row/column indexes.
@param ALeft Index of the left column of the cell range
@param ATop Index of the top row of the cell range
@ -2949,6 +2980,7 @@ begin
// Read comment
comment := Worksheet.ReadComment(cell);
// Read hyperlink info
if Worksheet.HasHyperlink(cell) then begin
hlink := Worksheet.FindHyperlink(cell);
@ -2970,6 +3002,7 @@ begin
if (Result = '') and (comment <> '') then
Result := comment;
// Call hint event handler
if Assigned(OnGetCellHint) then
OnGetCellHint(self, ACol, ARow, Result);
end;
@ -3608,21 +3641,45 @@ end;
*)
{@@ ----------------------------------------------------------------------------
Standard key handling method inherited from TCustomGrid. Is overridden to
catch the ESC key during editing in order to restore the old cell text
catch some keys for special processing.
@param Key Key which has been pressed
@param Shift Additional shift keys which are pressed
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.KeyDown(var Key : Word; Shift : TShiftState);
var
R: TRect;
begin
if (Key = VK_F2) then
FEnhEditMode := true
else
if (Key = VK_ESCAPE) and FEditing then begin
SetEditText(Col, Row, FOldEditText);
EditorHide;
exit;
case Key of
VK_RIGHT:
if (aeNavigation in FAutoExpand) and (Col = ColCount-1) then
ColCount := ColCount + 1;
VK_DOWN:
if (aeNavigation in FAutoExpand) and (Row = RowCount-1) then
RowCount := RowCount + 1;
VK_END:
if (aeNavigation in FAutoExpand) and (Col = ColCount-1) then
begin
R := GCache.FullVisibleGrid;
ColCount := ColCount + R.Right - R.Left;
end;
VK_NEXT: // Page down
if (aeNavigation in FAutoExpand) and (Row = RowCount-1) then
begin
R := GCache.FullVisibleGrid;
RowCount := Row + R.Bottom - R.Top;
end;
VK_F2:
FEnhEditMode := true;
VK_ESCAPE:
if FEditing then
begin
SetEditText(Col, Row, FOldEditText);
EditorHide;
exit;
end;
end;
inherited;
end;
@ -3776,10 +3833,8 @@ begin
if (cell <> nil) then begin
grow := GetGridRow(cell^.Row);
gcol := GetGridCol(cell^.Col);
if grow >= RowCount then
RowCount := grow + 1;
if gcol >= ColCount then
ColCount := gcol + 1;
AutoExpandToRow(grow, aeData);
AutoExpandToCol(gcol, aeData);
end;
Invalidate;
end;
@ -3789,10 +3844,8 @@ begin
begin
grow := GetGridRow(Worksheet.ActiveCellRow);
gcol := GetGridCol(Worksheet.ActiveCellCol);
if grow >= RowCount then
RowCount := grow + 1;
if gcol >= ColCount then
ColCount := gcol + 1;
AutoExpandToRow(grow, aeNavigation);
AutoExpandToCol(gcol, aeNavigation);
if (grow <> Row) or (gcol <> Col) then
MoveExtend(false, gcol, grow);
end;
@ -3808,8 +3861,7 @@ begin
if (lniRow in AChangedItems) and (Worksheet <> nil) then
begin
grow := GetGridRow({%H-}PtrInt(AData));
if grow >= RowCount then
RowCount := grow + 1;
AutoExpandToRow(grow, aeData);
RowHeights[grow] := CalcAutoRowHeight(grow);
end;
end;
@ -4150,8 +4202,6 @@ begin
if (Worksheet = nil) or (Worksheet.GetCellCount = 0) then begin
if ShowHeaders then begin
// ColCount := FInitColCount + 1; //2;
// RowCount := FInitRowCount + 1; //2;
FixedCols := 1;
FixedRows := 1;
ColWidths[0] := GetDefaultHeaderColWidth;
@ -4159,8 +4209,6 @@ begin
end else begin
FixedCols := 0;
FixedRows := 0;
// ColCount := FInitColCount; //0;
// RowCount := FInitRowCount; //0;
end;
end else
if Worksheet <> nil then begin
@ -4168,8 +4216,6 @@ begin
Canvas.Font.Assign(Font);
ColCount := Max(GetGridCol(Worksheet.GetLastColIndex) + 1, ColCount);
RowCount := Max(GetGridRow(Worksheet.GetLastRowIndex) + 1, RowCount);
//ColCount := Max(integer(Worksheet.GetLastColIndex) + 1 + FHeaderCount, FInitColCount);
//RowCount := Max(integer(Worksheet.GetLastRowIndex) + 1 + FHeaderCount, FInitRowCount);
FixedCols := FFrozenCols + FHeaderCount;
FixedRows := FFrozenRows + FHeaderCount;
if ShowHeaders then begin

3
components/fpspreadsheet/fpsstrings.pas
View File

@ -163,6 +163,9 @@ resourcestring
rsErrArgError = '#N/A';
rsErrFormulaNotSupported = '<FORMULA?>';
rsOperationExceedsColCount = 'This operation exceeds the range of defined grid columns.';
rsOperationExceedsRowCount = 'This operation exceeds the range of defined grid rows.';
implementation
end.