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

fpspreadsheet: Add workbook option boWriteZoomFactor and update xls, xlsx and ods writers. Extend zoom demo by saving command. Add define CALC_ALL_ROWHEIGHTS to fpspreadsheetgrid.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5230 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-09-28 16:35:39 +00:00
parent f87e5706fb
commit ac9245401a
7 changed files with 163 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
components/fpspreadsheet/examples/visual/zoom/zdmain.lfm
View File

@ -1,18 +1,18 @@
object MainForm: TMainForm
Left = 280
Height = 482
Height = 476
Top = 130
Width = 680
Width = 678
Caption = 'Zoom demo'
ClientHeight = 482
ClientWidth = 680
ClientHeight = 476
ClientWidth = 678
OnCreate = FormCreate
LCLVersion = '1.7'
object Grid: TsWorksheetGrid
Left = 5
Height = 429
Height = 386
Top = 8
Width = 667
Width = 665
FrozenCols = 0
FrozenRows = 0
ReadFormulas = False
@ -30,9 +30,9 @@ object MainForm: TMainForm
OnMouseWheel = GridMouseWheel
end
object BtnOpen: TButton
Left = 5
Left = 8
Height = 25
Top = 447
Top = 405
Width = 75
Anchors = [akLeft, akBottom]
Caption = 'Open...'
@ -40,12 +40,16 @@ object MainForm: TMainForm
TabOrder = 1
end
object edZoom: TSpinEdit
Left = 97
AnchorSideLeft.Control = CbOverrideZoomFactor
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = BtnOpen
AnchorSideTop.Side = asrCenter
Left = 282
Height = 23
Top = 448
Top = 406
Width = 66
Alignment = taRightJustify
Anchors = [akLeft, akBottom]
BorderSpacing.Left = 24
MaxValue = 900
MinValue = 10
OnEditingDone = edZoomEditingDone
@ -53,15 +57,48 @@ object MainForm: TMainForm
Value = 100
end
object CbOverrideZoomFactor: TCheckBox
Left = 184
AnchorSideLeft.Control = BtnOpen
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = BtnOpen
AnchorSideTop.Side = asrCenter
Left = 107
Height = 19
Top = 450
Top = 408
Width = 151
BorderSpacing.Left = 24
Caption = 'Override file zoom factor'
TabOrder = 3
end
object BtnSave: TButton
AnchorSideLeft.Control = BtnOpen
AnchorSideTop.Control = BtnOpen
AnchorSideTop.Side = asrBottom
Left = 8
Height = 25
Top = 438
Width = 75
BorderSpacing.Top = 8
Caption = 'Save...'
OnClick = BtnSaveClick
TabOrder = 4
end
object CbWriteZoomFactor: TCheckBox
AnchorSideLeft.Control = CbOverrideZoomFactor
AnchorSideTop.Control = BtnSave
AnchorSideTop.Side = asrCenter
Left = 107
Height = 19
Top = 441
Width = 115
Caption = 'Write zoom factor'
TabOrder = 5
end
object OpenDialog: TOpenDialog
left = 280
top = 128
end
object SaveDialog: TSaveDialog
left = 280
top = 187
end
end

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

@ -6,7 +6,8 @@ interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Spin, fpstypes, fpspreadsheet, fpspreadsheetgrid, Types;
Spin, Types,
fpstypes, fpspreadsheet, fpspreadsheetgrid;
type
@ -14,18 +15,25 @@ type
TMainForm = class(TForm)
BtnOpen: TButton;
BtnSave: TButton;
CbOverrideZoomFactor: TCheckBox;
CbWriteZoomFactor: TCheckBox;
edZoom: TSpinEdit;
Grid: TsWorksheetGrid;
OpenDialog: TOpenDialog;
SaveDialog: TSaveDialog;
procedure BtnOpenClick(Sender: TObject);
procedure BtnSaveClick(Sender: TObject);
procedure edZoomEditingDone(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure GridMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
private
FWorkbook: TsWorkbook;
procedure LoadFile(const AFileName: String);
FOpenFormats: TsSpreadFormatIDArray;
FSaveFormats: TsSpreadFormatIDArray;
procedure LoadFile(const AFileName: String; AFormatID: TsSpreadFormatID);
procedure SaveFile(const AFileName: String; AFormatID: TsSpreadFormatID);
procedure UpdateCaption;
public
@ -46,11 +54,36 @@ uses
{ TMainForm }
procedure TMainForm.BtnOpenClick(Sender: TObject);
var
fmt: TsSpreadFormatID;
begin
if FWorkbook <> nil then
OpenDialog.InitialDir := ExtractFileDir(FWorkbook.FileName);
if OpenDialog.Execute then
LoadFile(OpenDialog.FileName);
if FWorkbook <> nil then
OpenDialog.InitialDir := ExtractFileDir(FWorkbook.FileName);
if OpenDialog.Execute then begin
fmt := FOpenFormats[OpenDialog.FilterIndex-1];
LoadFile(OpenDialog.FileName, fmt);
end;
end;
procedure TMainForm.BtnSaveClick(Sender: TObject);
var
fmt: TsSpreadFormatID;
fmts: TsSpreadFormatIDArray;
i: Integer;
begin
{ Set up the save dialog such that it shows the loaded file name and type }
SaveDialog.InitialDir := ExtractFileDir(OpenDialog.FileName);
SaveDialog.FileName := ExtractFileName(OpenDialog.FileName);
fmts := GetSpreadFormatsFromFileName(faWrite, SaveDialog.FileName);
for i:=0 to High(FSaveFormats) do
if FSaveFormats[i] = fmts[0] then begin
SaveDialog.FilterIndex := i + 1;
break;
end;
if SaveDialog.Execute then begin
fmt := FSaveFormats[SaveDialog.FilterIndex - 1];
SaveFile(SaveDialog.FileName, fmt);
end;
end;
{ Set the zoom factor to the value in the edit control. Is called after
@ -74,6 +107,10 @@ begin
priorityFormats[7] := ord(sfHTML);
OpenDialog.Filter := GetFileFormatFilter('|', ';', faRead, priorityFormats, true, true);
SaveDialog.Filter := GetFileFormatFilter('|', ';', faWrite, priorityFormats);
FOpenFormats := GetSpreadFormats(faRead, priorityFormats);
FSaveFormats := GetSpreadFormats(faWrite, priorityFormats);
end;
{ Mouse wheel event handler for setting the zoom factor using the mouse wheel
@ -91,7 +128,7 @@ begin
end;
end;
procedure TMainForm.LoadFile(const AFileName: String);
procedure TMainForm.LoadFile(const AFileName: String; AFormatID: TsSpreadFormatID);
var
crs: TCursor;
book: TsWorkbook;
@ -103,7 +140,7 @@ begin
try
Screen.Cursor := crHourglass;
// Read the file
book.ReadFromFile(AFilename);
book.ReadFromFile(AFilename, AFormatID);
// If you want to override the zoom factor of the file set it before
// assigning the worksheet to the grid.
book.GetFirstWorksheet.ZoomFactor := edZoom.Value / 100;
@ -126,6 +163,18 @@ begin
end;
end;
{ Saves the spreadsheet to the file selected by the SaveDialog action }
procedure TMainForm.SaveFile(const AFileName: String; AFormatID: TsSpreadFormatID);
begin
Screen.Cursor := crHourglass;
try
Grid.SaveToSpreadsheetFile(AFileName, AFormatID);
UpdateCaption;
finally
Screen.Cursor := crDefault;
end;
end;
procedure TMainForm.UpdateCaption;
begin
if FWorkbook = nil then

7
components/fpspreadsheet/fpsopendocument.pas
View File

@ -4551,10 +4551,8 @@ begin
for i:=0 to Workbook.GetWorksheetCount-1 do
begin
sheet := Workbook.GetWorksheetByIndex(i);
if sheet = Workbook.ActiveWorksheet then begin
if sheet = Workbook.ActiveWorksheet then
actSheet := UTF8TextToXMLText(sheet.Name);
// zoomValue := IntToStr(round(sheet.ZoomFactor));
end;
if not (soShowGridLines in sheet.Options) then showGrid := false;
if not (soShowHeaders in sheet.Options) then showHeaders := false;
end;
@ -6244,7 +6242,8 @@ begin
actY := sheet.TopPaneHeight;
end;
zoom := IntToStr(round(sheet.ZoomFactor*100.0));
if boWriteZoomFactor in FWorkbook.Options then
zoom := IntToStr(round(sheet.ZoomFactor*100.0));
AppendToStream(AStream,
'<config:config-item config:name="CursorPositionX" config:type="int">'+IntToStr(actX)+'</config:config-item>');

6
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -631,9 +631,11 @@ type
@param boReadFormulas Allows to turn off reading of rpn formulas; this is
a precaution since formulas not correctly
implemented by fpspreadsheet could crash the
reading operation. }
reading operation.
@param boWriteZoomfactor Instructs the writer to write the current zoom
factors of the worksheets to file. }
TsWorkbookOption = (boVirtualMode, boBufStream, boFileStream,
boAutoCalc, boCalcBeforeSaving, boReadFormulas);
boAutoCalc, boCalcBeforeSaving, boReadFormulas, boWriteZoomFactor);
{@@ Set of option flags for the workbook }
TsWorkbookOptions = set of TsWorkbookOption;

64
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -12,6 +12,11 @@
-------------------------------------------------------------------------------}
unit fpspreadsheetgrid;
{ Activate this define if the worksheet contains varying row heights and jumps
to specific rows do not meet the requested row. There is a speed penalty in
case of large worksheets. }
{.$DEFINE CALC_ALL_ROWHEIGHTS}
{$mode objfpc}{$H+}
{$I fps.inc}
@ -75,13 +80,12 @@ type
FEnhEditMode: Boolean;
FSelPen: TsSelPen;
FHyperlinkTimer: TTimer;
FHyperlinkCell: PCell; // Selected cell if it stores a hyperlink
FHyperlinkCell: PCell; // Selected cell if it stores a hyperlink
FDefRowHeight100: Integer; // Default row height for 100% zoom factor, in pixels
FDefColWidth100: Integer; // Default col width for 100% zoom factor, in pixels
FZoomLock: Integer;
FRowHeightLock: Integer;
FOldTopRow: Integer;
// FSetupDelayed: Boolean;
FOnClickHyperlink: TsHyperlinkClickEvent;
function CalcAutoRowHeight(ARow: Integer): Integer;
function CalcColWidthFromSheet(AWidth: Single): Integer;
@ -245,7 +249,8 @@ type
procedure TopLeftChanged; override;
function TrimToCell(ACell: PCell): String;
procedure UpdateColWidths(AStartIndex: Integer = 0);
procedure UpdateRowHeights(AStartIndex: Integer = 0);
procedure UpdateRowHeight(ARow: Integer);
procedure UpdateRowHeights;
{@@ Automatically recalculate formulas whenever a cell value changes. }
property AutoCalc: Boolean read FAutoCalc write SetAutoCalc default false;
@ -1511,7 +1516,9 @@ begin
exit;
Worksheet.DeleteRow(GetWorksheetRow(AGridRow));
UpdateRowHeights(AGridRow);
// wp: next line probably not required
//UpdateRowHeights(AGridRow);
end;
procedure TsCustomWorksheetGrid.CreateHandle;
@ -1648,7 +1655,7 @@ var
begin
GetSelectedState(AState, isSelected);
Canvas.Font.Assign(Font);
Canvas.Font.Height := Round(ZoomFactor * Canvas.Font.Height);
//Canvas.Font.Height := Round(ZoomFactor * Canvas.Font.Height);
Canvas.Brush.Bitmap := nil;
Canvas.Brush.Color := Color;
ts := Canvas.TextStyle;
@ -3605,7 +3612,8 @@ begin
// r := AGridRow - FHeaderCount;
Worksheet.InsertRow(r);
UpdateRowHeights(AGridRow);
UpdateRowHeight(AGridRow);
// UpdateRowHeights(AGridRow);
end;
{@@ ----------------------------------------------------------------------------
@ -4572,9 +4580,11 @@ end;
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.TopLeftChanged;
begin
{$IFNDEF CALC_ALL_ROWHEIGHTS}
if FOldTopRow <> TopRow then
UpdateRowHeights;
FOldTopRow := TopRow;
{$ENDIF}
inherited;
end;
@ -4743,6 +4753,23 @@ begin
end;
end;
procedure TsCustomWorksheetGrid.UpdateRowHeight(ARow: Integer);
var
lRow: PRow;
h: Integer;
begin
if Worksheet <> nil then
begin
lRow := Worksheet.FindRow(ARow - FHeaderCount);
if (lRow <> nil) then
h := round(CalcRowHeightFromSheet(lRow^.Height) * ZoomFactor)
else
h := CalcAutoRowHeight(ARow); // ZoomFactor has already been applied to font heights
end else
h := DefaultRowHeight; // Zoom factor is applied by getter function
RowHeights[ARow] := h;
end;
{@@ ----------------------------------------------------------------------------
Updates row heights by using the data from the TRow records or by auto-
calculating the row height from the max of the cell heights
@ -4750,34 +4777,25 @@ end;
this method is called whenever the grid is scrolled and the coordinates of
the top-left cell changes.
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.UpdateRowHeights(AStartIndex: Integer = 0);
procedure TsCustomWorksheetGrid.UpdateRowHeights;
const
DELTA = 10;
var
r, r1, r2: Integer;
lRow: PRow;
h: Integer;
begin
Unused(AStartIndex);
if FRowHeightLock > 0 then
exit;
{$IFDEF CALC_ALL_ROWHEIGHTS}
r1 := FHeaderCount;
r2 := RowCount-1;
{$ELSE}
r1 := Max(FHeaderCount, TopRow - DELTA);
r2 := Min(RowCount-1, TopRow + VisibleRowCount + DELTA);
{$ENDIF}
for r:=r1 to r2 do
begin
if Worksheet <> nil then
begin
lRow := Worksheet.FindRow(r - FHeaderCount);
if (lRow <> nil) then
h := round(CalcRowHeightFromSheet(lRow^.Height) * ZoomFactor)
else
h := CalcAutoRowHeight(r); // ZoomFactor has already been applied to font heights
end else
h := DefaultRowHeight; // Zoom factor is applied by getter function
RowHeights[r] := h;
end;
UpdateRowHeight(r);
end;

3
components/fpspreadsheet/xlscommon.pas
View File

@ -4363,6 +4363,9 @@ procedure TsSpreadBIFFWriter.WriteSCLRecord(AStream: TStream;
var
num, denom: Word;
begin
if not (boWriteZoomFactor in FWorkbook.Options) then
exit;
{ BIFF record header }
WriteBIFFHeader(AStream, INT_EXCEL_ID_SCL, 4);

7
components/fpspreadsheet/xlsxooxml.pas
View File

@ -3052,8 +3052,11 @@ begin
showHeaders := StrUtils.IfThen(soShowHeaders in AWorksheet.Options, '', ' showRowColHeaders="0"');
// Zoom factor
zoomscale := StrUtils.IfThen(SameValue(AWorksheet.ZoomFactor, 1.0, ZOOM_EPS), '',
Format(' zoomScale="%.0f"', [AWorksheet.ZoomFactor*100]));
if boWriteZoomFactor in FWorkbook.Options then
zoomscale := StrUtils.IfThen(SameValue(AWorksheet.ZoomFactor, 1.0, ZOOM_EPS), '',
Format(' zoomScale="%.0f"', [AWorksheet.ZoomFactor*100]))
else
zoomscale := '';
// BiDiMode
case AWorksheet.BiDiMode of