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

fpspreadsheet: Autoadjust column width and row height in TsWorksheetGrid by double-clicking at border between header cells; update demos.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3626 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-10-03 16:09:54 +00:00
parent 5935c3c63e
commit 6f14b93502
7 changed files with 161 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/fpsgrid/mainform.lfm
View File

@ -58,7 +58,7 @@ object Form1: TForm1
AutoAdvance = aaDown
ColCount = 27
MouseWheelOption = mwGrid
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goEditing, goThumbTracking, goSmoothScroll, goFixedColSizing]
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goEditing, goThumbTracking, goDblClickAutoSize, goSmoothScroll, goHeaderHotTracking, goHeaderPushedLook, goFixedColSizing]
RowCount = 101
TabOrder = 1
TitleStyle = tsNative

18
components/fpspreadsheet/examples/fpsgrid_no_install/mainfrm.pas
View File

@ -53,9 +53,12 @@ begin
// Useful options
Grid.Options := Grid.Options + [goColSizing, goRowSizing,
goFixedColSizing, // useful if the spreadsheet contains frozen columns
goEditing, // needed for modifying cell content
goThumbTracking // see the grid scroll while you drag the scrollbar
goFixedColSizing, // useful if the spreadsheet contains frozen columns
goEditing, // needed for modifying cell content
goThumbTracking, // see the grid scroll while you drag the scrollbar
goHeaderHotTracking, // hot-tracking of header cells
goHeaderPushedLook, // click at header cells --> pushed look
goDblClickAutoSize // optimum col width/row height after dbl click at header border
];
Grid.AutoAdvance := aaDown; // move active cell down on ENTER
Grid.MouseWheelOption := mwGrid; // mouse wheel scrolls the grid, not the active cell
@ -67,11 +70,13 @@ end;
procedure TForm1.BtnLoadClick(Sender: TObject);
begin
if OpenDialog.FileName <> '' then begin
if OpenDialog.FileName <> '' then
begin
OpenDialog.InitialDir := ExtractFileDir(OpenDialog.FileName);
OpenDialog.FileName := ChangeFileExt(ExtractFileName(OpenDialog.FileName), '');
end;
if OpenDialog.Execute then begin
if OpenDialog.Execute then
begin
LoadFile(OpenDialog.FileName);
end;
end;
@ -90,7 +95,8 @@ begin
if Grid.Workbook = nil then
exit;
if Grid.Workbook.Filename <>'' then begin
if Grid.Workbook.Filename <>'' then
begin
SaveDialog.InitialDir := ExtractFileDir(Grid.Workbook.FileName);
SaveDialog.FileName := ChangeFileExt(ExtractFileName(Grid.Workbook.FileName), '');
end;

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

@ -4,7 +4,7 @@ object MainFrm: TMainFrm
Top = 258
Width = 884
Caption = 'spready'
ClientHeight = 614
ClientHeight = 619
ClientWidth = 884
Menu = MainMenu
OnActivate = FormActivate
@ -13,17 +13,17 @@ object MainFrm: TMainFrm
LCLVersion = '1.3'
object Panel1: TPanel
Left = 0
Height = 78
Top = 536
Height = 82
Top = 537
Width = 884
Align = alBottom
BevelOuter = bvNone
ClientHeight = 78
ClientHeight = 82
ClientWidth = 884
TabOrder = 6
object EdFrozenCols: TSpinEdit
Left = 429
Height = 28
Height = 23
Top = 8
Width = 52
OnChange = EdFrozenColsChange
@ -31,7 +31,7 @@ object MainFrm: TMainFrm
end
object EdFrozenRows: TSpinEdit
Left = 429
Height = 28
Height = 23
Top = 39
Width = 52
OnChange = EdFrozenRowsChange
@ -39,37 +39,37 @@ object MainFrm: TMainFrm
end
object Label1: TLabel
Left = 344
Height = 20
Height = 15
Top = 13
Width = 77
Width = 62
Caption = 'Frozen cols:'
FocusControl = EdFrozenCols
ParentColor = False
end
object Label2: TLabel
Left = 344
Height = 20
Height = 15
Top = 40
Width = 82
Width = 66
Caption = 'Frozen rows:'
FocusControl = EdFrozenRows
ParentColor = False
end
object CbReadFormulas: TCheckBox
Left = 8
Height = 24
Height = 19
Top = 8
Width = 120
Width = 96
Caption = 'Read formulas'
OnChange = CbReadFormulasChange
TabOrder = 0
end
object CbHeaderStyle: TComboBox
Left = 200
Height = 28
Height = 23
Top = 8
Width = 116
ItemHeight = 20
ItemHeight = 15
ItemIndex = 2
Items.Strings = (
'Lazarus'
@ -83,18 +83,18 @@ object MainFrm: TMainFrm
end
object CbAutoCalcFormulas: TCheckBox
Left = 8
Height = 24
Height = 19
Top = 32
Width = 158
Width = 128
Caption = 'Calculate on change'
OnChange = CbAutoCalcFormulasChange
TabOrder = 1
end
object CbTextOverflow: TCheckBox
Left = 8
Height = 24
Height = 19
Top = 56
Width = 114
Width = 91
Caption = 'Text overflow'
Checked = True
OnChange = CbTextOverflowChange
@ -206,19 +206,19 @@ object MainFrm: TMainFrm
end
object FontComboBox: TComboBox
Left = 52
Height = 28
Height = 23
Top = 2
Width = 127
ItemHeight = 20
ItemHeight = 15
OnSelect = FontComboBoxSelect
TabOrder = 0
end
object FontSizeComboBox: TComboBox
Left = 179
Height = 28
Height = 23
Top = 2
Width = 48
ItemHeight = 20
ItemHeight = 15
Items.Strings = (
'8'
'9'
@ -392,7 +392,7 @@ object MainFrm: TMainFrm
end
object InspectorSplitter: TSplitter
Left = 648
Height = 457
Height = 458
Top = 79
Width = 5
Align = alRight
@ -400,7 +400,7 @@ object MainFrm: TMainFrm
end
object InspectorPageControl: TPageControl
Left = 653
Height = 457
Height = 458
Top = 79
Width = 231
ActivePage = PgCellValue
@ -410,11 +410,11 @@ object MainFrm: TMainFrm
OnChange = InspectorPageControlChange
object PgCellValue: TTabSheet
Caption = 'Cell value'
ClientHeight = 424
ClientHeight = 430
ClientWidth = 223
object CellInspector: TValueListEditor
Left = 0
Height = 424
Height = 430
Top = 0
Width = 223
Align = alClient
@ -458,7 +458,7 @@ object MainFrm: TMainFrm
end
object TabControl: TTabControl
Left = 0
Height = 457
Height = 458
Top = 79
Width = 648
OnChange = TabControlChange
@ -466,7 +466,7 @@ object MainFrm: TMainFrm
TabOrder = 3
object WorksheetGrid: TsWorksheetGrid
Left = 2
Height = 452
Height = 453
Top = 3
Width = 644
FrozenCols = 0
@ -477,13 +477,14 @@ object MainFrm: TMainFrm
BorderStyle = bsNone
ColCount = 27
MouseWheelOption = mwGrid
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goThumbTracking, goSmoothScroll, goFixedColSizing]
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goThumbTracking, goDblClickAutoSize, goSmoothScroll, goHeaderHotTracking, goHeaderPushedLook, goFixedColSizing]
RowCount = 101
TabOrder = 1
TitleStyle = tsNative
OnHeaderClick = WorksheetGridHeaderClick
OnSelection = WorksheetGridSelection
ColWidths = (
56
42
64
64
64

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

@ -300,6 +300,8 @@ type
procedure FormCreate(Sender: TObject);
procedure InspectorPageControlChange(Sender: TObject);
procedure TabControlChange(Sender: TObject);
procedure WorksheetGridHeaderClick(Sender: TObject; IsColumn: Boolean;
Index: Integer);
procedure WorksheetGridSelection(Sender: TObject; aCol, aRow: Integer);
private
FCopiedFormat: TCell;
@ -946,6 +948,12 @@ begin
WorksheetGridSelection(self, WorksheetGrid.Col, WorksheetGrid.Row);
end;
procedure TMainFrm.WorksheetGridHeaderClick(Sender: TObject; IsColumn: Boolean;
Index: Integer);
begin
//ShowMessage('Header click');
end;
procedure TMainFrm.UpdateBackgroundColorIndex;
var
sClr: TsColor;
@ -964,7 +972,8 @@ var
hor_align: TsHorAlignment;
begin
with WorksheetGrid do hor_align := HorAlignments[Selection];
for i:=0 to ActionList.ActionCount-1 do begin
for i:=0 to ActionList.ActionCount-1 do
begin
ac := TAction(ActionList.Actions[i]);
if (ac.Tag >= HORALIGN_TAG) and (ac.Tag < HORALIGN_TAG+10) then
ac.Checked := ((ac.Tag - HORALIGN_TAG) = ord(hor_align));
@ -978,7 +987,8 @@ var
cb: TsCellBorder;
r1,r2,c1,c2: Cardinal;
begin
with CellInspector do begin
with CellInspector do
begin
TitleCaptions[0] := 'Properties';
TitleCaptions[1] := 'Values';
Strings.Clear;
@ -1088,7 +1098,8 @@ begin
else Strings.Add('NumberFormatStr=' + ACell^.NumberFormatStr);
if not WorksheetGrid.Worksheet.IsMerged(ACell) then
Strings.Add('Merged range=')
else begin
else
begin
WorksheetGrid.Worksheet.FindMergedRange(ACell, r1, c1, r2, c2);
Strings.Add('Merged range=' + GetCellRangeString(r1, c1, r2, c2));
end;

3
components/fpspreadsheet/examples/wikitablemaker/wtmain.pas
View File

@ -585,7 +585,8 @@ begin
MouseWheelOption := mwGrid;
Options := [goEditing, goFixedVertLine, goFixedHorzLine, goVertLine,
goHorzLine, goRangeSelect, goRowSizing, goColSizing, goThumbTracking,
goSmoothScroll, goFixedColSizing];
goSmoothScroll, goFixedColSizing, goHeaderHotTracking, goHeaderPushedLook,
goDblClickAutoSize];
TitleStyle := tsNative;
OnSelection := @WorksheetGridSelection;
end;

8
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -1418,19 +1418,19 @@ end;
function CompareCells(Item1, Item2: Pointer): Integer;
begin
result := PCell(Item1).Row - PCell(Item2).Row;
result := LongInt(PCell(Item1).Row) - PCell(Item2).Row;
if Result = 0 then
Result := PCell(Item1).Col - PCell(Item2).Col;
Result := LongInt(PCell(Item1).Col) - PCell(Item2).Col;
end;
function CompareRows(Item1, Item2: Pointer): Integer;
begin
result := PRow(Item1).Row - PRow(Item2).Row;
result := LongInt(PRow(Item1).Row) - PRow(Item2).Row;
end;
function CompareCols(Item1, Item2: Pointer): Integer;
begin
result := PCol(Item1).Col - PCol(Item2).Col;
result := LongInt(PCol(Item1).Col) - PCol(Item2).Col;
end;

103
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -119,9 +119,12 @@ type
protected
{ Protected declarations }
procedure AutoAdjustColumn(ACol: Integer); override;
procedure AutoAdjustRow(ARow: Integer); virtual;
function CellOverflow(ACol, ARow: Integer; AState: TGridDrawState;
out ACol1, ACol2: Integer; var ARect: TRect): Boolean;
procedure CreateNewWorkbook;
procedure DblClick; override;
procedure DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); override;
procedure DrawAllRows; override;
procedure DrawCellBorders; overload;
@ -135,7 +138,7 @@ type
function GetCellText(ACol, ARow: Integer): String;
function GetEditText(ACol, ARow: Integer): String; override;
function HasBorder(ACell: PCell; ABorder: TsCellBorder): Boolean;
procedure HeaderSized(IsColumn: Boolean; index: Integer); override;
procedure HeaderSized(IsColumn: Boolean; AIndex: Integer); override;
procedure InternalDrawTextInCell(AText, AMeasureText: String; ARect: TRect;
AJustification: Byte; ACellHorAlign: TsHorAlignment;
ACellVertAlign: TsVertAlignment; ATextRot: TsTextRotation;
@ -745,6 +748,57 @@ begin
inherited Destroy;
end;
{@@ ----------------------------------------------------------------------------
Is called when goDblClickAutoSize is in the grid's options and a double click
has occured at the border of a column header. Sets optimum column with.
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.AutoAdjustColumn(ACol: Integer);
var
gRow: Integer; // row in grid coordinates
c: Cardinal;
r: Cardinal;
lastRow: Cardinal;
cell: PCell;
w, maxw: Integer;
fnt: TFont;
txt: String;
begin
if FWorksheet = nil then
exit;
c := GetWorksheetCol(ACol);
lastRow := FWorksheet.GetLastOccupiedRowIndex;
maxw := -1;
for r := 0 to lastRow do
begin
gRow := GetGridRow(r);
fnt := GetCellFont(ACol, gRow);
txt := GetCellText(ACol, gRow);
PrepareCanvas(ACol, gRow, []);
w := Canvas.TextWidth(txt);
if (txt <> '') and (w > maxw) then maxw := w;
end;
if maxw > -1 then
maxw := maxw + 2*constCellPadding
else
maxw := DefaultColWidth;
ColWidths[ACol] := maxW;
HeaderSized(true, ACol);
end;
{@@ ----------------------------------------------------------------------------
Is called when goDblClickAutoSize is in the grid's options and a double click
has occured at the border of a row header. Sets optimum row height.
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.AutoAdjustRow(ARow: Integer);
begin
if FWorksheet <> nil then
RowHeights[ARow] := CalcAutoRowHeight(ARow)
else
RowHeights[ARow] := DefaultRowHeight;
HeaderSized(false, ARow);
end;
{@@ ----------------------------------------------------------------------------
The BeginUpdate/EndUpdate pair suppresses unnecessary painting of the grid.
Call BeginUpdate to stop refreshing the grid, and call EndUpdate to release
@ -1102,6 +1156,35 @@ begin
SetAutoCalc(FAutoCalc);
end;
{@@ ----------------------------------------------------------------------------
Is called when a Double-click occurs. Overrides the inherited method to
react on double click on cell border in row headers to auto-adjust the
row heights
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.DblClick;
var
oldHeight: Integer;
gRow: Integer;
begin
SelectActive := False;
FGridState := gsNormal;
if (goRowSizing in Options) and (Cursor = crVSplit) and (FHeaderCount > 0) then
begin
if (goDblClickAutoSize in Options) then
begin
gRow := GCache.MouseCell.y;
if CellRect(0, gRow).Bottom - GCache.ClickMouse.y > 0 then dec(gRow);
oldHeight := RowHeights[gRow];
AutoAdjustRow(gRow);
if oldHeight <> RowHeights[gRow] then
Cursor := crDefault; //ChangeCursor;
end
end
else
inherited DblClick;
end;
{@@ ----------------------------------------------------------------------------
Adjusts the grid's canvas before painting a given cell. Considers
background color, horizontal alignment, vertical alignment, etc.
@ -1513,6 +1596,7 @@ var
Include(gds, gdPushed);
end;
end;
Canvas.SaveHandleState;
try
Rgn := CreateRectRgn(_clipRect.Left, _clipRect.Top, _clipRect.Right, _clipRect.Bottom);
@ -2168,7 +2252,14 @@ begin
cell := FWorksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if (cell <> nil) then
begin
fnt := FWorkbook.GetFont(cell^.FontIndex);
if (uffBold in cell^.UsedFormattingFields) then
fnt := FWorkbook.GetFont(1)
else
if (uffFont in cell^.UsedFormattingFields) then
fnt := FWorkbook.GetFont(cell^.FontIndex)
else
fnt := FWorkbook.GetDefaultFont;
// fnt := FWorkbook.GetFont(cell^.FontIndex);
Convert_sFont_to_Font(fnt, FCellFont);
Result := FCellFont;
end;
@ -2539,7 +2630,7 @@ end;
(true) or a row height (false)
@param Index Index of the changed column or row
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.HeaderSized(IsColumn: Boolean; index: Integer);
procedure TsCustomWorksheetGrid.HeaderSized(IsColumn: Boolean; AIndex: Integer);
var
w0: Integer;
h, h_pts: Single;
@ -2552,13 +2643,13 @@ begin
// The grid's column width is in "pixels", the worksheet's column width is
// in "characters".
w0 := Canvas.TextWidth('0');
FWorksheet.WriteColWidth(GetWorksheetCol(Index), ColWidths[Index] div w0);
FWorksheet.WriteColWidth(GetWorksheetCol(AIndex), ColWidths[AIndex] div w0);
end else begin
// The grid's row heights are in "pixels", the worksheet's row heights are
// in "lines"
h_pts := PxToPts(RowHeights[Index] - 4, Screen.PixelsPerInch); // in points
h_pts := PxToPts(RowHeights[AIndex] - 4, Screen.PixelsPerInch); // in points
h := h_pts / (FWorkbook.GetFont(0).Size + ROW_HEIGHT_CORRECTION);
FWorksheet.WriteRowHeight(GetWorksheetRow(Index), h);
FWorksheet.WriteRowHeight(GetWorksheetRow(AIndex), h);
end;
end;