fpspreadsheet: Add zoom actions. Make worksheetgrid and spreadsheet inspector react on zoom changes. Update fpsctrls demo.

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

components/fpspreadsheet/examples/visual/fpsctrls/main.lfm

@@ -1772,6 +1772,68 @@ object MainForm: TMainForm
       Hint = 'Delete hyperlink from selected cell'
       ImageIndex = 58
     end
+    object AcZoom30: TsWorksheetZoomAction
+      Category = 'FPSpreadsheet'
+      WorkbookSource = WorkbookSource
+      Caption = '30%'
+      Hint = 'Zoom factor 30%'
+      Zoom = 30
+    end
+    object AcZoom50: TsWorksheetZoomAction
+      Category = 'FPSpreadsheet'
+      WorkbookSource = WorkbookSource
+      Caption = '50%'
+      Hint = 'Zoom factor 50%'
+      Zoom = 50
+    end
+    object AcZoom75: TsWorksheetZoomAction
+      Category = 'FPSpreadsheet'
+      WorkbookSource = WorkbookSource
+      Caption = '75%'
+      Hint = 'Zoom factor 75%'
+      Zoom = 75
+    end
+    object AcZoom90: TsWorksheetZoomAction
+      Category = 'FPSpreadsheet'
+      WorkbookSource = WorkbookSource
+      Caption = '90%'
+      Hint = 'Zoom factor 90%'
+      Zoom = 90
+    end
+    object AcZoom100: TsWorksheetZoomAction
+      Category = 'FPSpreadsheet'
+      WorkbookSource = WorkbookSource
+      Caption = '100%'
+      Hint = 'Zoom factor 100%'
+    end
+    object AcZoom150: TsWorksheetZoomAction
+      Category = 'FPSpreadsheet'
+      WorkbookSource = WorkbookSource
+      Caption = '150%'
+      Hint = 'Zoom factor 150%'
+      Zoom = 150
+    end
+    object AcZoom200: TsWorksheetZoomAction
+      Category = 'FPSpreadsheet'
+      WorkbookSource = WorkbookSource
+      Caption = '200%'
+      Hint = 'Zoom factor 200%'
+      Zoom = 200
+    end
+    object AcZoom300: TsWorksheetZoomAction
+      Category = 'FPSpreadsheet'
+      WorkbookSource = WorkbookSource
+      Caption = '300%'
+      Hint = 'Zoom factor 300%'
+      Zoom = 300
+    end
+    object AcZoom500: TsWorksheetZoomAction
+      Category = 'FPSpreadsheet'
+      WorkbookSource = WorkbookSource
+      Caption = '500%'
+      Hint = 'Zoom factor 500%'
+      Zoom = 500
+    end
   end
   object ImageList: TImageList
     left = 176
@@ -4367,6 +4429,45 @@ object MainForm: TMainForm
       object MenuItem133: TMenuItem
         Caption = '-'
       end
+      object MnuZoom: TMenuItem
+        Caption = 'Zoom'
+        object MenuItem148: TMenuItem
+          Action = AcZoom30
+        end
+        object MenuItem149: TMenuItem
+          Action = AcZoom50
+        end
+        object MenuItem150: TMenuItem
+          Action = AcZoom75
+        end
+        object MenuItem146: TMenuItem
+          Action = AcZoom90
+        end
+        object MenuItem153: TMenuItem
+          Caption = '-'
+        end
+        object MenuItem151: TMenuItem
+          Action = AcZoom100
+        end
+        object MenuItem154: TMenuItem
+          Caption = '-'
+        end
+        object MenuItem152: TMenuItem
+          Action = AcZoom150
+        end
+        object MenuItem155: TMenuItem
+          Action = AcZoom200
+        end
+        object MenuItem156: TMenuItem
+          Action = AcZoom300
+        end
+        object MenuItem157: TMenuItem
+          Action = AcZoom500
+        end
+      end
+      object MenuItem147: TMenuItem
+        Caption = '-'
+      end
       object MenuItem52: TMenuItem
         Action = AcViewInspector
         AutoCheck = True

components/fpspreadsheet/examples/visual/fpsctrls/main.pas

@@ -83,6 +83,19 @@ type
     MenuItem143: TMenuItem;
     MenuItem144: TMenuItem;
     MenuItem145: TMenuItem;
+    MenuItem146: TMenuItem;
+    MenuItem148: TMenuItem;
+    MenuItem149: TMenuItem;
+    MenuItem150: TMenuItem;
+    MenuItem151: TMenuItem;
+    MenuItem152: TMenuItem;
+    MenuItem153: TMenuItem;
+    MenuItem154: TMenuItem;
+    MenuItem155: TMenuItem;
+    MenuItem156: TMenuItem;
+    MenuItem157: TMenuItem;
+    MnuZoom: TMenuItem;
+    MenuItem147: TMenuItem;
     MnuSettings: TMenuItem;
     MenuItem11: TMenuItem;
     MenuItem12: TMenuItem;
@@ -278,6 +291,15 @@ type
     AcNumFormatText: TsNumberFormatAction;
     Splitter2: TSplitter;
     Splitter3: TSplitter;
+    AcZoom100: TsWorksheetZoomAction;
+    AcZoom90: TsWorksheetZoomAction;
+    AcZoom30: TsWorksheetZoomAction;
+    AcZoom50: TsWorksheetZoomAction;
+    AcZoom75: TsWorksheetZoomAction;
+    AcZoom150: TsWorksheetZoomAction;
+    AcZoom200: TsWorksheetZoomAction;
+    AcZoom300: TsWorksheetZoomAction;
+    AcZoom500: TsWorksheetZoomAction;
     ToolBar2: TToolBar;
     ToolBar3: TToolBar;
     ToolButton1: TToolButton;
@@ -666,7 +688,8 @@ procedure TMainForm.AcViewInspectorExecute(Sender: TObject);
 begin
   InspectorTabControl.Visible := AcViewInspector.Checked;
   InspectorSplitter.Visible := AcViewInspector.Checked;
-  InspectorSplitter.Left := 0;  // Make sure that the splitter is always at the left of the inspector
+  InspectorSplitter.Left := 0;
+  // Make sure that the splitter is always at the left of the inspector tabcontrol
 end;
 
 procedure TMainForm.ColorComboboxAddColors(Sender: TObject);

components/fpspreadsheet/examples/visual/zoom/zdmain.pas

@@ -50,6 +50,9 @@ implementation
 uses
   fpsRegFileFormats;
 
+const
+  MOUSEWHEEL_FACTOR = 1.05;
+
 
 { TMainForm }
 
@@ -60,6 +63,7 @@ begin
   if FWorkbook <> nil then
     OpenDialog.InitialDir := ExtractFileDir(FWorkbook.FileName);
   if OpenDialog.Execute then begin
+    // 3 because FilterIndex is 1-based and there are 2 add'l items at the top.
     if OpenDialog.FilterIndex < 3 then
       fmt := sfidUnknown
     else
@@ -110,6 +114,7 @@ begin
   priorityFormats[7] := ord(sfHTML);
 
   OpenDialog.Filter := GetFileFormatFilter('|', ';', faRead, priorityFormats, true, true);
+    // true, true --> add "All spreadsheet formats" and "All Excel formats" at top
   SaveDialog.Filter := GetFileFormatFilter('|', ';', faWrite, priorityFormats);
 
   FOpenFormats := GetSpreadFormats(faRead, priorityFormats);
@@ -123,9 +128,9 @@ procedure TMainForm.GridMouseWheel(Sender: TObject; Shift: TShiftState;
 begin
   if ([ssCtrl, ssShift] * Shift = [ssCtrl, ssShift]) then begin
     if WheelDelta > 0 then
-      Grid.ZoomFactor := Grid.ZoomFactor * 1.05
+      Grid.ZoomFactor := Grid.ZoomFactor * MOUSEWHEEL_FACTOR
     else
-      Grid.ZoomFactor := Grid.ZoomFactor / 1.05;
+      Grid.ZoomFactor := Grid.ZoomFactor / MOUSEWHEEL_FACTOR;
     edZoom.Value := round(Grid.ZoomFactor * 100);
     Handled := true;
   end;

components/fpspreadsheet/fpsactions.pas

@@ -106,6 +106,17 @@ type
       read FOnGetWorksheetName write FOnGetWorksheetName;
   end;
 
+  { Action foz zooming the selected worksheet }
+  TsWorksheetZoomAction= class(TsWorksheetAction)
+  private
+    FZoom: Integer;
+    procedure SetZoom(AValue: Integer);
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure ExecuteTarget(Target: TObject); override;
+  published
+    property Zoom: Integer read FZoom write SetZoom default 100;
+  end;
 
   { --- Actions related to cell and cell selection formatting--- }
 
@@ -537,6 +548,7 @@ begin
   RegisterActions('FPSpreadsheet', [
     // Worksheet-releated actions
     TsWorksheetAddAction, TsWorksheetDeleteAction, TsWorksheetRenameAction,
+    TsWorksheetZoomAction,
     // Cell or cell range formatting actions
     TsCopyAction,
     TsFontStyleAction, TsFontDialogAction, TsBackgroundColorDialogAction,
@@ -789,6 +801,32 @@ begin
 end;
 
 
+{ TsWorksheetZoomAction }
+
+constructor TsWorksheetZoomAction.Create(AOwner: TComponent);
+begin
+  inherited;
+  FZoom := 100;
+end;
+
+procedure TsWorksheetZoomAction.ExecuteTarget(Target: TObject);
+begin
+  if HandlesTarget(Target) then
+    Worksheet.Zoomfactor := FZoom / 100;
+end;
+
+procedure TsWorksheetZoomAction.SetZoom(AValue: Integer);
+begin
+  if AValue = FZoom then
+    exit;
+
+  if FZoom = 0 then
+    raise Exception.Create('Zoomfactor cannot be 0.');
+
+  FZoom := AValue;
+end;
+
+
 { TsCopyAction }
 
 procedure TsCopyAction.ExecuteTarget(Target: TObject);

components/fpspreadsheet/fpspreadsheet.pas

@@ -82,6 +82,8 @@ type
 
   { TsWorksheet }
 
+  TsNotifyEvent = procedure (Sender: TObject) of object;
+
   {@@ This event fires whenever a cell value or cell formatting changes. It is
     handled by TsWorkbookLink to update the listening controls. }
   TsCellEvent = procedure (Sender: TObject; ARow, ACol: Cardinal) of object;
@@ -129,6 +131,7 @@ type
     FZoomFactor: Double;
     FOnChangeCell: TsCellEvent;
     FOnChangeFont: TsCellEvent;
+    FOnZoom: TsNotifyEvent;
     FOnCompareCells: TsCellCompareEvent;
     FOnSelectCell: TsCellEvent;
     FOnWriteCellData: TsWorksheetWriteCellDataEvent;
@@ -143,6 +146,7 @@ type
     procedure SetName(const AName: String);
     procedure SetVirtualColCount(AValue: Cardinal);
     procedure SetVirtualRowCount(AValue: Cardinal);
+    procedure SetZoomFactor(AValue: Double);
 
     { Callback procedures called when iterating through all cells }
     procedure DeleteColCallback(data, arg: Pointer);
@@ -584,7 +588,7 @@ type
     {@@ Number of frozen rows which do not scroll }
     property  TopPaneHeight: Integer read FTopPaneHeight write FTopPaneHeight;
     {@@ Zoom factor }
-    property  ZoomFactor: Double read FZoomFactor write FZoomFactor;
+    property  ZoomFactor: Double read FZoomFactor write SetZoomFactor;
     {@@ Event fired when cell contents or formatting changes }
     property  OnChangeCell: TsCellEvent read FOnChangeCell write FOnChangeCell;
     {@@ Event fired when the font size in a cell changes }
@@ -597,7 +601,8 @@ type
       standard cells are ignored. Intended for converting large database files
       to a spreadsheet format. Requires Option boVirtualMode to be set. }
     property OnWriteCellData: TsWorksheetWriteCellDataEvent read FOnWriteCellData write FOnWriteCellData;
-
+    {@@ Event triggered when the worksheet is zoomed }
+    property OnZoom: TsNotifyEvent read FOnZoom write FOnZoom;
   end;
 
   {@@
@@ -632,8 +637,7 @@ type
   {@@ Set of option flags for the workbook }
   TsWorkbookOptions = set of TsWorkbookOption;
 
-  {@@
+  {@@ Event fired when reading a file in virtual mode. Read data are provided in
-    Event fired when reading a file in virtual mode. Read data are provided in
     the "ADataCell" (which is not added to the worksheet in virtual mode). }
   TsWorkbookReadCellDataEvent = procedure(Sender: TObject; ARow, ACol: Cardinal;
     const ADataCell: PCell) of object;
@@ -644,12 +648,11 @@ type
   {@@ Event procedure called when a worksheet is removed }
   TsRemoveWorksheetEvent = procedure (Sender: TObject; ASheetIndex: Integer) of object;
 
-  {@@ The workbook contains the worksheets and provides methods for reading from
-    and writing to file.
-  }
 
   { TsWorkbook }
 
+  {@@ The workbook contains the worksheets and provides methods for reading from
+    and writing to file. }
   TsWorkbook = class
   private
     { Internal data }
@@ -4096,6 +4099,17 @@ begin
   FVirtualRowCount := AValue;
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Setter method for the zoom factor
+-------------------------------------------------------------------------------}
+procedure TsWorksheet.SetZoomfactor(AValue: Double);
+begin
+  if AValue = FZoomFactor then exit;
+  FZoomFactor := AValue;
+  if Assigned(FOnZoom) then FOnZoom(Self);
+end;
+
+
 {@@ ----------------------------------------------------------------------------
   Writes UTF-8 encoded text to a cell.
 

components/fpspreadsheet/fpspreadsheetctrls.pas

@@ -42,7 +42,7 @@ type
     or a cell formatting, etc. }
   TsNotificationItem = (lniWorkbook,
     lniWorksheet, lniWorksheetAdd, lniWorksheetRemoving, lniWorksheetRemove,
-    lniWorksheetRename,
+    lniWorksheetRename, lniWorksheetZoom,
     lniCell, lniSelection, lniAbortSelection, lniRow); //, lniPalette);
   {@@ This set accompanies the notification between WorkbookSource and visual
     controls and describes which items have changed in the spreadsheet. }
@@ -87,6 +87,7 @@ type
     procedure WorksheetRemovingHandler(Sender: TObject; AWorksheet: TsWorksheet);
     procedure WorksheetRenamedHandler(Sender: TObject; AWorksheet: TsWorksheet);
     procedure WorksheetSelectedHandler(Sender: TObject; AWorksheet: TsWorksheet);
+    procedure WorksheetZoomHandler(Sender: TObject);
 
   protected
     procedure AbortSelection;
@@ -1609,6 +1610,7 @@ begin
     FWorksheet.OnChangeCell := @CellChangedHandler;
     FWorksheet.OnChangeFont := @CellFontChangedHandler;
     FWorksheet.OnSelectCell := @CellSelectedHandler;
+    FWorksheet.OnZoom := @WorksheetZoomHandler;
     NotifyListeners([lniWorksheet]);
     FWorksheet := AWorksheet;  // !!!!!
     if FWorksheet.ActiveCellRow = Cardinal(-1) then
@@ -1622,6 +1624,14 @@ begin
     NotifyListeners([lniWorksheet]);
 end;
 
+{@@ ----------------------------------------------------------------------------
+  Event handler called whenever the workbook is zoomed
+-------------------------------------------------------------------------------}
+procedure TsWorkbookSource.WorksheetZoomHandler(Sender: TObject);
+begin
+  NotifyListeners([lniWorksheetZoom], FWorksheet);
+end;
+
 
 {------------------------------------------------------------------------------}
 {                            TsWorkbookTabControl                              }
@@ -2922,7 +2932,7 @@ begin
       if ([lniWorkbook, lniWorksheet]*AChangedItems <> []) then
         DoUpdate;
     imWorksheet:
-      if ([lniWorksheet, lniSelection]*AChangedItems <> []) then
+      if ([lniWorksheet, lniSelection, lniWorksheetZoom]*AChangedItems <> []) then
         DoUpdate;
     imCellValue, imCellProperties:
       if ([lniCell, lniSelection]*AChangedItems <> []) then
@@ -3378,6 +3388,7 @@ begin
     AStrings.Add('Selection=');
     AStrings.Add('Default column width=');
     AStrings.Add('Default row height=');
+    AStrings.Add('Zoom factor=');
     AStrings.Add('Page layout=');
   end else
   begin
@@ -3395,6 +3406,7 @@ begin
     AStrings.Add(Format('Default row height=%.1f %s', [
       ASheet.ReadDefaultRowHeight(ASheet.Workbook.Units),
       SizeUnitNames[ASheet.Workbook.Units]]));
+    AStrings.Add(Format('Zoom factor=%d%%', [round(ASheet.ZoomFactor*100)]));
     AStrings.Add(Format('Comments=%d items', [ASheet.Comments.Count]));
     AStrings.Add(Format('Hyperlinks=%d items', [ASheet.Hyperlinks.Count]));
     AStrings.Add(Format('MergedCells=%d items', [ASheet.MergedCells.Count]));

components/fpspreadsheet/fpspreadsheetgrid.pas

@@ -188,6 +188,7 @@ type
 
   protected
     { Protected declarations }
+    procedure AdaptToZoomFactor;
     procedure AutoAdjustColumn(ACol: Integer); override;
     procedure AutoAdjustRow(ARow: Integer); virtual;
     procedure AutoExpandToCol(ACol: Integer; AMode: TsAutoExpandMode);
@@ -1034,6 +1035,35 @@ begin
   inherited Destroy;
 end;
 
+procedure TsCustomWorksheetGrid.AdaptToZoomFactor;
+var
+  c, r: Integer;
+begin
+  inc(FZoomLock);
+  DefaultRowHeight := round(GetZoomfactor * FDefRowHeight100);
+  DefaultColWidth := round(GetZoomFactor * FDefColWidth100);
+  UpdateColWidths;
+  UpdateRowHeights;
+  dec(FZoomLock);
+
+  // Bring active cell back into the viewport: There is a ScrollToCell but
+  // this method is private. It is called by SetCol/SetRow, though.
+  if ((Col < GCache.Visiblegrid.Left) or (Col >= GCache.VisibleGrid.Right)) and
+     (GCache.VisibleGrid.Left <> GCache.VisibleGrid.Right) then
+  begin
+    c := Col;
+    Col := c-1;    // "Col" must change in order to call ScrtollToCell
+    Col := c;
+  end;
+  if ((Row < GCache.VisibleGrid.Top) or (Row >= GCache.VisibleGrid.Bottom)) and
+     (GCache.VisibleGrid.Top <> GCache.VisibleGrid.Bottom) then
+  begin
+    r := Row;
+    Row := r-1;
+    Row := r;
+  end;
+end;
+
 procedure TsCustomWorksheetGrid.AutoColWidth(ACol: Integer);
 begin
   AutoAdjustColumn(ACol);
@@ -4110,6 +4140,10 @@ begin
     if (lRow = nil) or (lRow^.RowHeightType <> rhtCustom) then
       UpdateRowHeight(grow, true);
   end;
+
+  // Worksheet zoom
+  if (lniWorksheetZoom in AChangedItems) and (Worksheet <> nil) then
+    AdaptToZoomFactor; // Reads value directly from Worksheet
 end;
 
 {@@ ----------------------------------------------------------------------------
@@ -5932,37 +5966,14 @@ begin
 end;
 
 procedure TsCustomWorksheetGrid.SetZoomFactor(AValue: Double);
-var
-  c,r: Integer;
 begin
   if (AValue <> GetZoomFactor) and Assigned(Worksheet) then begin
-    inc(FZoomLock);
     Worksheet.ZoomFactor := abs(AValue);
-    DefaultRowHeight := round(GetZoomfactor * FDefRowHeight100);
+    AdaptToZoomFactor;
-    DefaultColWidth := round(GetZoomFactor * FDefColWidth100);
-    UpdateColWidths;
-    UpdateRowHeights;
-    dec(FZoomLock);
-
-    // Bring active cell back into the viewport: There is a ScrollToCell but
-    // this method is private. It is called by SetCol/SetRow, though.
-    if ((Col < GCache.Visiblegrid.Left) or (Col >= GCache.VisibleGrid.Right)) and
-       (GCache.VisibleGrid.Left <> GCache.VisibleGrid.Right) then
-    begin
-      c := Col;
-      Col := c-1;    // "Col" must change in order to call ScrtollToCell
-      Col := c;
-    end;
-    if ((Row < GCache.VisibleGrid.Top) or (Row >= GCache.VisibleGrid.Bottom)) and
-       (GCache.VisibleGrid.Top <> GCache.VisibleGrid.Bottom) then
-    begin
-      r := Row;
-      Row := r-1;
-      Row := r;
-    end;
   end;
 end;
 
+
 {@@ ----------------------------------------------------------------------------
   Registers the worksheet grid in the Lazarus component palette,
   page "FPSpreadsheet".