fpspreadsheet: Add zooming support to WorksheetGrid (use SHIFT+CTRL+MouseWheel in fpctrls demo).

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

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

@@ -48,9 +48,9 @@ object MainForm: TMainForm
       TitleFont.Color = clBlack
       TitleFont.Height = -13
       TitleFont.Name = 'Arial'
-      TitleStyle = tsNative
       UseXORFeatures = True
       OnClickHyperlink = WorksheetGridClickHyperlink
+      OnMouseWheel = WorksheetGridMouseWheel
     end
   end
   object InspectorTabControl: TTabControl

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

@@ -8,7 +8,7 @@ uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
   ComCtrls, ActnList, Menus, StdActns, Buttons,
   fpstypes, fpspreadsheet, fpspreadsheetctrls, fpspreadsheetgrid, fpsActions,
-  fpsRegFileFormats, fpsSYLK, xlsxml, Grids;
+  fpsRegFileFormats, fpsSYLK, xlsxml, Grids, Types;
 
 type
 
@@ -383,6 +383,8 @@ type
     procedure InspectorTabControlChange(Sender: TObject);
     procedure WorksheetGridClickHyperlink(Sender: TObject;
       const AHyperlink: TsHyperlink);
+    procedure WorksheetGridMouseWheel(Sender: TObject; Shift: TShiftState;
+      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
   private
     { private declarations }
     FOpenFormats: TsSpreadFormatIDArray;
@@ -845,5 +847,20 @@ begin
   end;
 end;
 
+procedure TMainForm.WorksheetGridMouseWheel(Sender: TObject;
+  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
+  var Handled: Boolean);
+const
+  GROWTH_FACTOR = 1.05;
+begin
+  if ([ssCtrl, ssShift] * Shift = [ssCtrl, ssShift]) then begin
+    if WheelDelta > 0 then
+      WorksheetGrid.ZoomFactor := GROWTH_FACTOR* WorksheetGrid.ZoomFactor
+    else
+      WorksheetGrid.ZoomFactor := WorksheetGrid.ZoomFactor / GROWTH_FACTOR;
+    Handled := true;
+  end;
+end;
+
 end.
 

components/fpspreadsheet/fpspreadsheet.pas

@@ -137,6 +137,7 @@ type
     FPageLayout: TsPageLayout;
     FVirtualColCount: Cardinal;
     FVirtualRowCount: Cardinal;
+    FZoomFactor: Double;
     FOnChangeCell: TsCellEvent;
     FOnChangeFont: TsCellEvent;
     FOnCompareCells: TsCellCompareEvent;
@@ -590,6 +591,8 @@ type
     property  LeftPaneWidth: Integer read FLeftPaneWidth write FLeftPaneWidth;
     {@@ Number of frozen rows which do not scroll }
     property  TopPaneHeight: Integer read FTopPaneHeight write FTopPaneHeight;
+    {@@ Zoom factor }
+    property  ZoomFactor: Double read FZoomFactor write FZoomFactor;
     {@@ 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 }
@@ -1051,6 +1054,7 @@ begin
 
   FDefaultColWidth := ptsToMM(72);   // Excel: about 72 pts
   FDefaultRowHeight := ptsToMM(15);  // Excel: 15pts
+  FZoomFactor := 1.0;
 
   FFirstRowIndex := UNASSIGNED_ROW_COL_INDEX;
   FFirstColIndex := UNASSIGNED_ROW_COL_INDEX;

components/fpspreadsheet/fpspreadsheetgrid.pas

@@ -76,6 +76,9 @@ type
     FSelPen: TsSelPen;
     FHyperlinkTimer: TTimer;
     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;
 //    FSetupDelayed: Boolean;
     FOnClickHyperlink: TsHyperlinkClickEvent;
     function CalcAutoRowHeight(ARow: Integer): Integer;
@@ -128,6 +131,7 @@ type
     function GetWorksheet: TsWorksheet;
     function GetWordwrap(ACol, ARow: Integer): Boolean;
     function GetWordwraps(ALeft, ATop, ARight, ABottom: Integer): Boolean;
+    function GetZoomFactor: Double;
     procedure SetAutoCalc(AValue: Boolean);
     procedure SetBackgroundColor(ACol, ARow: Integer; AValue: TsColor);
     procedure SetBackgroundColors(ALeft, ATop, ARight, ABottom: Integer; AValue: TsColor);
@@ -176,6 +180,7 @@ type
     procedure SetWorkbookSource(AValue: TsWorkbookSource);
     procedure SetWordwrap(ACol, ARow: Integer; AValue: boolean);
     procedure SetWordwraps(ALeft, ATop, ARight, ABottom: Integer; AValue: boolean);
+    procedure SetZoomFactor(AValue: Double);
 
     procedure HyperlinkTimerElapsed(Sender: TObject);
 
@@ -230,7 +235,7 @@ type
     procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
     procedure MoveSelection; override;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
-//    procedure SelectEditor; override;
+    procedure PrepareCanvasFont;
     procedure SelPenChangeHandler(Sender: TObject);
     procedure SetEditText(ACol, ARow: Longint; const AValue: string); override;
     procedure Setup;
@@ -449,6 +454,9 @@ type
         by the rectangle is activated. }
     property Wordwraps[ALeft, ATop, ARight, ABottom: Integer]: Boolean
         read GetWordwraps write SetWordwraps;
+    {@@ Zoomfactor of the grid }
+    property ZoomFactor: Double
+        read GetZoomFactor write SetZoomFactor;
 
     // inherited, but modified
 
@@ -1050,7 +1058,7 @@ begin
     end;
     w := RichTextWidth(Canvas, Workbook, Rect(0, 0, MaxInt, MaxInt),
       txt, cell^.RichTextParams, Worksheet.ReadCellFontIndex(cell),
-      Worksheet.ReadTextRotation(cell), false, RTL);
+      Worksheet.ReadTextRotation(cell), false, RTL, ZoomFactor);
     if w > maxw then maxw := w;
   end;
   if maxw > -1 then
@@ -1067,11 +1075,13 @@ end;
 -------------------------------------------------------------------------------}
 procedure TsCustomWorksheetGrid.AutoAdjustRow(ARow: Integer);
 begin
+  inc(FZoomLock);
   if Worksheet <> nil then
     RowHeights[ARow] := CalcAutoRowHeight(ARow)
   else
     RowHeights[ARow] := DefaultRowHeight;
   HeaderSized(false, ARow);
+  dec(FZoomLock);
 end;
 
 {@@ ----------------------------------------------------------------------------
@@ -1144,9 +1154,9 @@ var
 begin
   h := 0;
   for c := FHeaderCount to ColCount-1 do
-    h := Max(h, GetCellHeight(c, ARow));
+    h := Max(h, GetCellHeight(c, ARow));  // Zoom factor is applied to font size
   if h = 0 then
-    Result := DefaultRowHeight
+    Result := DefaultRowHeight            // Zoom factor applied by getter function
   else
     Result := h;
 end;
@@ -1182,7 +1192,7 @@ begin
   begin
     // The grid's column width is in "pixels", the worksheet's column width
     // has the units defined by the workbook.
-    w_pts := PxToPts(AValue, Screen.PixelsPerInch);
+    w_pts := PxToPts(AValue/ZoomFactor, Screen.PixelsPerInch);
     Result := Workbook.ConvertUnits(w_pts, suPoints, Workbook.Units);
   end;
 end;
@@ -1203,7 +1213,7 @@ begin
   begin
     // The grid's row heights are in "pixels", the worksheet's row height
     // has the units defined by the workbook.
-    h_pts := PxToPts(AValue, Screen.PixelsPerInch);
+    h_pts := PxToPts(AValue/ZoomFactor, Screen.PixelsPerInch);
     Result := Workbook.ConvertUnits(h_pts, suPoints, Workbook.Units);
   end;
 end;
@@ -1587,6 +1597,7 @@ begin
     InflateRect(Rct, -delta, -delta);
     inc(Rct.Top);
     if not odd(FSelPen.Width) then dec(Rct.Left);
+    Editor.Font.Height := Round(Font.Height * ZoomFactor);
     Editor.SetBounds(Rct.Left, Rct.Top, Rct.Right-Rct.Left-1, Rct.Bottom-Rct.Top-1);
   end;
 end;
@@ -1622,6 +1633,7 @@ var
 begin
   GetSelectedState(AState, isSelected);
   Canvas.Font.Assign(Font);
+  Canvas.Font.Height := Round(ZoomFactor * Canvas.Font.Height);
   Canvas.Brush.Bitmap := nil;
   Canvas.Brush.Color := Color;
   ts := Canvas.TextStyle;
@@ -1698,37 +1710,8 @@ begin
       if (uffFont in fmt^.UsedFormattingFields) then
         fnt := Workbook.GetFont(fmt^.FontIndex);
 
-      if fnt <> nil then
+      Convert_sFont_to_Font(fnt, Canvas.Font);
-      begin
+      Canvas.Font.Height := Round(ZoomFactor * Canvas.Font.Height);
-        Canvas.Font.Name := fnt.FontName;
-        Canvas.Font.Size := round(fnt.Size);
-        Canvas.Font.Color := fnt.Color and $00FFFFFF;
-        style := [];
-        if fssBold in fnt.Style then Include(style, fsBold);
-        if fssItalic in fnt.Style then Include(style, fsItalic);
-        if fssUnderline in fnt.Style then Include(style, fsUnderline);
-        if fssStrikeout in fnt.Style then Include(style, fsStrikeout);
-        Canvas.Font.Style := style;
-      end;
-
-      // Text color is handled by "InternalDrawRichText"
-      {
-      // Read text color from number format if available
-      if not IsNaN(lCell^.NumberValue) and (numFmt <> nil) then
-      begin
-        sidx := 0;
-        if (Length(numFmt.Sections) > 1) and (lCell^.NumberValue < 0) then
-          sidx := 1
-        else
-        if (Length(numFmt.Sections) > 2) and (lCell^.NumberValue = 0) then
-          sidx := 2;
-        if (nfkHasColor in numFmt.Sections[sidx].Kind) then
-        begin
-          clr := numFmt.Sections[sidx].Color;
-          Canvas.Font.Color := clr and $00FFFFFF;
-        end;
-      end;
-      }
 
       // Wordwrap, text alignment and text rotation are handled by "DrawTextInCell".
     end;
@@ -2456,7 +2439,15 @@ begin
     ts.Layout := tlCenter;
     ts.Opaque := false;
     Canvas.TextStyle := ts;
+                  {
+    writeLn('HEADER');
+    writeln(Format('1 - col=%d, row=%d, font size=%d', [acol, arow, canvas.font.size]));
+                   }
     inherited DrawCellText(aCol, aRow, aRect, aState, GetCellText(ACol,ARow));
+    {
+    writeln(GetCellText(ACol, ARow));
+    writeln(Format('2 - col=%d, row=%d, font size=%d', [acol, arow, canvas.font.size]));
+    }
     exit;
   end;
 
@@ -3030,6 +3021,7 @@ end;
   @param   ACol  Grid column index of the cell
   @param   ARow  Grid row index of the cell
   @result  Height of the cell in pixels. Wrapped text is handled correctly.
+           Value contains the zoom factor.
 -------------------------------------------------------------------------------}
 function TsCustomWorksheetGrid.GetCellHeight(ACol, ARow: Integer): Integer;
 var
@@ -3096,7 +3088,7 @@ begin
     end;
 
     Result := RichTextHeight(Canvas, Workbook, cellR, s, lCell^.RichTextParams,
-                fntIndex, txtRot, wrapped, RTL)
+                fntIndex, txtRot, wrapped, RTL, ZoomFactor)
             + 2 * constCellPadding;
   end;
 end;
@@ -3511,20 +3503,26 @@ end;
   @param   Index      Index of the changed column or row
 -------------------------------------------------------------------------------}
 procedure TsCustomWorksheetGrid.HeaderSized(IsColumn: Boolean; AIndex: Integer);
+const
+  EPS = 0.1;
 var
-  w, h: Single;
+  w, h, wdef, hdef: Single;
 begin
-  if Worksheet = nil then
+  if (Worksheet = nil) or (FZoomLock <> 0) then
     exit;
 
   if IsColumn then
   begin
-    w := CalcWorksheetColWidth(ColWidths[AIndex]);
+    w := CalcWorksheetColWidth(ColWidths[AIndex]);   // w and wdef are at 100% zoom
-    Worksheet.WriteColWidth(GetWorksheetCol(AIndex), w, Workbook.Units);
+    wdef := Worksheet.ReadDefaultColWidth(Workbook.Units);
+    if not SameValue(w, wdef, EPS) then
+      Worksheet.WriteColWidth(GetWorksheetCol(AIndex), w, Workbook.Units);
   end else
   begin
     h := CalcWorksheetRowHeight(RowHeights[AIndex]);
-    Worksheet.WriteRowHeight(GetWorksheetRow(AIndex), h, Workbook.Units);
+    hdef := Worksheet.ReadDefaultRowHeight(Workbook.Units);
+    if not SameValue(h, hdef, EPS) then
+      Worksheet.WriteRowHeight(GetWorksheetRow(AIndex), h, Workbook.Units);
   end;
 end;
 
@@ -3628,7 +3626,7 @@ begin
   // Work horse for text drawing, both standard text and rich-text
   DrawRichText(Canvas, Workbook, ARect, AText, ARichTextParams, AFontIndex,
     ATextWrap, ACellHorAlign, ACellVertAlign, ATextRot, AOverrideTextColor,
-    AIsRightToLeft
+    AIsRightToLeft, ZoomFactor
   );
 end;
 (*
@@ -4237,6 +4235,21 @@ begin
     SetWorkbookSource(nil);
 end;
 
+{@@ Prepares the Canvas default font for methods determining text size }
+procedure TsCustomWorksheetGrid.PrepareCanvasFont;
+var
+  fnt: TsFont;
+begin
+  if Worksheet = nil then
+    Canvas.Font.Assign(Font)
+  else
+  begin
+    fnt := Workbook.GetDefaultFont;
+    Convert_sFont_to_Font(fnt, Canvas.Font);
+  end;
+  Canvas.Font.Height := Round(ZoomFactor * Canvas.Font.Height);
+end;
+
 {@@ ----------------------------------------------------------------------------
   Removes the link of the WorksheetGrid to the WorkbookSource.
   Required before destruction.
@@ -4359,13 +4372,12 @@ begin
     FixedCols := FFrozenCols + FHeaderCount;
     FixedRows := FFrozenRows + FHeaderCount;
     if ShowHeaders then begin
+      PrepareCanvasFont;  // Applies the zoom factor
       ColWidths[0] := GetDefaultHeaderColWidth;
       RowHeights[0] := GetDefaultRowHeight;
     end;
   end else
   if Worksheet <> nil then begin
-    Convert_sFont_to_Font(Workbook.GetDefaultFont, Font);
-    Canvas.Font.Assign(Font);
     if FHeaderCount = 0 then
     begin
       ColCount := Max(GetGridCol(Worksheet.GetLastColIndex), ColCount-1);
@@ -4378,6 +4390,7 @@ begin
     FixedCols := FFrozenCols + FHeaderCount;
     FixedRows := FFrozenRows + FHeaderCount;
     if ShowHeaders then begin
+      PrepareCanvasFont;
       ColWidths[0] := GetDefaultHeaderColWidth;
       RowHeights[0] := GetDefaultRowHeight;
     end;
@@ -4682,19 +4695,22 @@ procedure TsCustomWorksheetGrid.UpdateColWidths(AStartIndex: Integer = 0);
 var
   i: Integer;
   lCol: PCol;
-  w: Integer;
+  w: Integer;       // Col width at current zoom level
+  w100: Integer;    // Col width at 100% zoom level
 begin
-  if AStartIndex = 0 then AStartIndex := FHeaderCount;
+  if AStartIndex = 0 then
+    AStartIndex := FHeaderCount;
   for i := AStartIndex to ColCount-1 do begin
-    w := DefaultColWidth;
     if Worksheet <> nil then
     begin
       lCol := Worksheet.FindCol(i - FHeaderCount);
       if lCol <> nil then
-        w := CalcColWidthFromSheet(lCol^.Width)
+        w100 := CalcColWidthFromSheet(lCol^.Width)
       else
-        w := CalcColWidthFromSheet(Worksheet.ReadDefaultColWidth(Workbook.Units));
+        w100 := CalcColWidthFromSheet(Worksheet.ReadDefaultColWidth(Workbook.Units));
-    end;
+      w := round(w100 * ZoomFactor);
+    end else
+      w := DefaultColWidth;  // Zoom factor is already applied by getter
     ColWidths[i] := w;
   end;
 end;
@@ -4736,11 +4752,11 @@ begin
     begin
       lRow := Worksheet.FindRow(r - FHeaderCount);
       if (lRow <> nil) then
-        h := CalcRowHeightFromSheet(lRow^.Height)
+        h := round(CalcRowHeightFromSheet(lRow^.Height) * ZoomFactor)
       else
-        h := CalcAutoRowHeight(r);
+        h := CalcAutoRowHeight(r); // ZoomFactor has already been applied to font heights
     end else
-      h := DefaultRowHeight;
+      h := DefaultRowHeight;       // Zoom factor is applied by getter function
     RowHeights[r] := h;
   end;
 end;
@@ -4907,12 +4923,12 @@ end;
 
 function TsCustomWorksheetGrid.GetDefColWidth: Integer;
 begin
-  Result := inherited DefaultColWidth;
+  Result := round(FDefColWidth100 * ZoomFactor);
 end;
 
 function TsCustomWorksheetGrid.GetDefRowHeight: Integer;
 begin
-  Result := inherited DefaultRowHeight;
+  Result := round(FDefRowHeight100 * Zoomfactor);
 end;
 
 function TsCustomWorksheetGrid.GetHorAlignment(ACol, ARow: Integer): TsHorAlignment;
@@ -5118,6 +5134,14 @@ begin
     end;
 end;
 
+function TsCustomWorksheetGrid.GetZoomFactor: Double;
+begin
+  if Worksheet <> nil then
+    Result := Worksheet.Zoomfactor
+  else
+    Result := 1.0;
+end;
+
 procedure TsCustomWorksheetGrid.SetAutoCalc(AValue: Boolean);
 var
   optns: TsWorkbookOptions;
@@ -5509,22 +5533,30 @@ procedure TsCustomWorksheetGrid.SetDefColWidth(AValue: Integer);
 begin
   if AValue = GetDefColWidth then
     exit;
+  // AValue contains the zoom factor
+  // FDefColWidth1000 is the col width at zoom factor 1.0
+  FDefColWidth100 := round(AValue / ZoomFactor);
   inherited DefaultColWidth := AValue;
-  if FHeaderCount > 0 then
+  if FHeaderCount > 0 then begin
+    PrepareCanvasFont;
     ColWidths[0] := GetDefaultHeaderColWidth;
-  if Worksheet <> nil then
+  end;
-    Worksheet.WriteDefaultColWidth(CalcWorksheetColWidth(AValue), Workbook.Units);
+  if (FZoomLock = 0) and (Worksheet <> nil) then
+    Worksheet.WriteDefaultColWidth(CalcWorksheetColWidth(GetDefColWidth), Workbook.Units);
 end;
 
 procedure TsCustomWorksheetGrid.SetDefRowHeight(AValue: Integer);
 begin
   if AValue = GetDefRowHeight then
     exit;
+  // AValue contains the zoom factor
+  // FDefRowHeight100 is the row height with zoom factor 1.0
+  FDefRowHeight100 := round(AValue / ZoomFactor);
   inherited DefaultRowHeight := AValue;
   if FHeaderCount > 0 then
     RowHeights[0] := GetDefaultRowHeight;
-  if Worksheet <> nil then
+  if (FZoomLock = 0) and (Worksheet <> nil) then
-    Worksheet.WriteDefaultRowHeight(CalcWorksheetRowHeight(AValue), Workbook.Units);
+    Worksheet.WriteDefaultRowHeight(CalcWorksheetRowHeight(GetDefaultRowHeight), Workbook.Units);
 end;
 
 procedure TsCustomWorksheetGrid.SetFrozenCols(AValue: Integer);
@@ -5794,6 +5826,19 @@ begin
   end;
 end;
 
+procedure TsCustomWorksheetGrid.SetZoomFactor(AValue: Double);
+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);
+    Invalidate;
+  end;
+end;
 
 {@@ ----------------------------------------------------------------------------
   Registers the worksheet grid in the Lazarus component palette,

components/fpspreadsheet/fpsutils.pas

@@ -140,7 +140,8 @@ function PtsToIn(AValue: Double): Double; inline;
 function PtsToTwips(AValue: Single): Integer; inline;
 function PtsToMM(AValue: Double): Double; inline;
 function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer; inline;
-function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double; inline;
+function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double; inline; overload;
+function pxToPts(AValue: Double; AScreenPixelsPerInch: Integer): Double; inline; overload;
 function TwipsToPts(AValue: Integer): Single; inline;
 function HTMLLengthStrToPts(AValue: String; DefaultUnits: String = 'pt'): Double;
 
@@ -1701,6 +1702,11 @@ begin
   Result := (AValue / AScreenPixelsPerInch) * 72;
 end;
 
+function pxToPts(AValue: Double; AScreenPixelsPerInch: Integer): Double;
+begin
+  Result := AValue / AScreenPixelsPerInch * 72.0;
+end;
+
 {@@ ----------------------------------------------------------------------------
   Converts points to pixels
   @param   AValue                Length value given in points

components/fpspreadsheet/fpsvisualutils.pas

@@ -19,15 +19,18 @@ function WrapText(ACanvas: TCanvas; const AText: string; AMaxWidth: integer): st
 procedure DrawRichText(ACanvas: TCanvas; AWorkbook: TsWorkbook; const ARect: TRect;
   const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer;
   AWordwrap: Boolean; AHorAlignment: TsHorAlignment; AVertAlignment: TsVertAlignment;
-  ARotation: TsTextRotation; AOverrideTextColor: TColor; ARightToLeft: Boolean);
+  ARotation: TsTextRotation; AOverrideTextColor: TColor; ARightToLeft: Boolean;
+  AZoomFactor: Double);
 
 function RichTextWidth(ACanvas: TCanvas; AWorkbook: TsWorkbook; ARect: TRect;
   const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer;
-  ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean): Integer;
+  ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean;
+  AZoomFactor: Double): Integer;
 
 function RichTextHeight(ACanvas: TCanvas; AWorkbook: TsWorkbook; ARect: TRect;
   const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer;
-  ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean): Integer;
+  ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean;
+  AZoomFactor: Double): Integer;
 
 type
   TsLineInfo = class
@@ -65,6 +68,7 @@ type
     FCharIndexOfNextFont: Integer;
     FFontHeight: Integer;
     FFontPos: TsFontPosition;
+    FZoomFactor: Double;
 
   private
     function GetHeight: Integer;
@@ -91,7 +95,8 @@ type
     constructor Create(ACanvas: TCanvas; AWorkbook: TsWorkbook; ARect: TRect;
       AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer;
       ATextRotation: TsTextRotation; AHorAlignment: TsHorAlignment;
-      AVertAlignment: TsVertAlignment; AWordWrap, ARightToLeft: Boolean);
+      AVertAlignment: TsVertAlignment; AWordWrap, ARightToLeft: Boolean;
+      AZoomFactor: Double);
     destructor Destroy; override;
     procedure Draw(AOverrideTextColor: TColor);
     property Height: Integer read GetHeight;
@@ -244,7 +249,8 @@ end;
 procedure DrawRichText(ACanvas: TCanvas; AWorkbook: TsWorkbook; const ARect: TRect;
   const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer;
   AWordwrap: Boolean; AHorAlignment: TsHorAlignment; AVertAlignment: TsVertAlignment;
-  ARotation: TsTextRotation; AOverrideTextColor: TColor; ARightToLeft: Boolean);
+  ARotation: TsTextRotation; AOverrideTextColor: TColor; ARightToLeft: Boolean;
+  AZoomFactor: Double);
 var
   painter: TsTextPainter;
 begin
@@ -252,7 +258,8 @@ begin
     exit;
 
   painter := TsTextPainter.Create(ACanvas, AWorkbook, ARect, AText, ARichTextParams,
-    AFontIndex, ARotation, AHorAlignment, AVertAlignment, AWordWrap, ARightToLeft);
+    AFontIndex, ARotation, AHorAlignment, AVertAlignment, AWordWrap, ARightToLeft,
+    AZoomFactor);
   try
     painter.Draw(AOverrideTextColor);
   finally
@@ -262,7 +269,8 @@ end;
 
 function RichTextWidth(ACanvas: TCanvas; AWorkbook: TsWorkbook; ARect: TRect;
   const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer;
-  ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean): Integer;
+  ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean;
+  AZoomFactor: Double): Integer;
 var
   painter: TsTextPainter;
 begin
@@ -270,7 +278,7 @@ begin
     exit(0);
 
   painter := TsTextPainter.Create(ACanvas, AWorkbook, ARect, AText, ARichTextParams,
-    AFontIndex, ATextRotation, haLeft, vaTop, AWordWrap, ARightToLeft);
+    AFontIndex, ATextRotation, haLeft, vaTop, AWordWrap, ARightToLeft, AZoomFactor);
   try
     Result := painter.Width;
   finally
@@ -280,7 +288,8 @@ end;
 
 function RichTextHeight(ACanvas: TCanvas; AWorkbook: TsWorkbook; ARect: TRect;
   const AText: String; ARichTextParams: TsRichTextParams; AFontIndex: Integer;
-  ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean): Integer;
+  ATextRotation: TsTextRotation; AWordWrap, ARightToLeft: Boolean;
+  AZoomFactor: Double): Integer;
 var
   painter: TsTextPainter;
 begin
@@ -288,7 +297,7 @@ begin
     exit(0);
 
   painter := TsTextPainter.Create(ACanvas, AWorkbook, ARect, AText, ARichTextParams,
-    AFontIndex, ATextRotation, haLeft, vaTop, AWordWrap, ARightToLeft);
+    AFontIndex, ATextRotation, haLeft, vaTop, AWordWrap, ARightToLeft, AZoomFactor);
   try
     Result := painter.Height;
   finally
@@ -325,7 +334,8 @@ end;
 constructor TsTextPainter.Create(ACanvas: TCanvas; AWorkbook: TsWorkbook;
   ARect: TRect; AText: String; ARichTextParams: TsRichTextParams;
   AFontIndex: Integer; ATextRotation: TsTextRotation; AHorAlignment: TsHorAlignment;
-  AVertAlignment: TsVertAlignment; AWordWrap, ARightToLeft: Boolean);
+  AVertAlignment: TsVertAlignment; AWordWrap, ARightToLeft: Boolean;
+  AZoomFactor: Double);
 begin
   FLines := TFPList.Create;
   FCanvas := ACanvas;
@@ -339,6 +349,7 @@ begin
   FVertAlignment := AVertAlignment;
   FWordwrap := AWordwrap;
   FRightToLeft := ARightToLeft;
+  FZoomfactor := AZoomFactor;
   Prepare;
 end;
 
@@ -705,9 +716,10 @@ begin
     ACharIndexOfNextFont := FRtParams[0].FirstIndex;
   end;
   Convert_sFont_to_Font(fnt, FCanvas.Font);
+  FCanvas.Font.Height := round(FZoomFactor * FCanvas.Font.Height);
   ACurrFontHeight := FCanvas.TextHeight('Tg');
   if (fnt <> nil) and (fnt.Position <> fpNormal) then
-    FCanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR);
+    FCanvas.Font.Size := round(fnt.Size * SUBSCRIPT_SUPERSCRIPT_FACTOR * FZoomFactor);
   ACurrFontPos := fnt.Position;
 end;
 

components/fpspreadsheet/laz_fpspreadsheet_visual.pas

@@ -4,7 +4,6 @@
 
 unit laz_fpspreadsheet_visual;
 
-{$warn 5023 off : no warning about unused units}
 interface
 
 uses