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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3626 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/fpsgrid/mainform.lfm

@@ -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

components/fpspreadsheet/examples/fpsgrid_no_install/mainfrm.pas

@@ -53,9 +53,12 @@ begin
 
   // Useful options
   Grid.Options := Grid.Options + [goColSizing, goRowSizing,
-    goFixedColSizing,  // useful if the spreadsheet contains frozen columns
+    goFixedColSizing,    // useful if the spreadsheet contains frozen columns
-    goEditing,         // needed for modifying cell content
+    goEditing,           // needed for modifying cell content
-    goThumbTracking    // see the grid scroll while you drag the scrollbar
+    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;

components/fpspreadsheet/examples/spready/mainform.lfm

@@ -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
+    Height = 82
-    Top = 536
+    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

components/fpspreadsheet/examples/spready/mainform.pas

@@ -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;

components/fpspreadsheet/examples/wikitablemaker/wtmain.pas

@@ -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;

components/fpspreadsheet/fpspreadsheet.pas

@@ -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;
 
 

components/fpspreadsheet/fpspreadsheetgrid.pas

@@ -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;