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

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5242 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2016-10-03 22:00:27 +00:00
parent abe0de42e1
commit 85187e4927
7 changed files with 241 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
components/fpspreadsheet/examples/visual/fpsctrls/main.lfm
View File

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

25
components/fpspreadsheet/examples/visual/fpsctrls/main.pas
View File

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

9
components/fpspreadsheet/examples/visual/zoom/zdmain.pas
View File

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

38
components/fpspreadsheet/fpsactions.pas
View File

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

28
components/fpspreadsheet/fpspreadsheet.pas
View File

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

16
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

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

61
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

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