diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm index 349fe6fe8..899142db9 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm +++ b/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 diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas index 05d174401..644cef4bc 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas +++ b/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); diff --git a/components/fpspreadsheet/examples/visual/zoom/zdmain.pas b/components/fpspreadsheet/examples/visual/zoom/zdmain.pas index e1be668fc..0080906d5 100644 --- a/components/fpspreadsheet/examples/visual/zoom/zdmain.pas +++ b/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; diff --git a/components/fpspreadsheet/fpsactions.pas b/components/fpspreadsheet/fpsactions.pas index fd13c6078..e62e17a9c 100644 --- a/components/fpspreadsheet/fpsactions.pas +++ b/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); diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 88d56e46d..1e5e06ad9 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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. diff --git a/components/fpspreadsheet/fpspreadsheetctrls.pas b/components/fpspreadsheet/fpspreadsheetctrls.pas index 6d3b8e4a9..3bb399769 100644 --- a/components/fpspreadsheet/fpspreadsheetctrls.pas +++ b/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])); diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 06462038c..f2d5d9ee9 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/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); - 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; + AdaptToZoomFactor; end; end; + {@@ ---------------------------------------------------------------------------- Registers the worksheet grid in the Lazarus component palette, page "FPSpreadsheet".