diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm index f88d073a4..88d1ae14a 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm +++ b/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 diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas index 1ff0e8047..16a523d31 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas +++ b/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. diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 01e725273..d0ee078f2 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index fd0bf597b..abfda355d 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/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 - begin - 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; - } + Convert_sFont_to_Font(fnt, Canvas.Font); + Canvas.Font.Height := Round(ZoomFactor * Canvas.Font.Height); // 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]); - Worksheet.WriteColWidth(GetWorksheetCol(AIndex), w, Workbook.Units); + w := CalcWorksheetColWidth(ColWidths[AIndex]); // w and wdef are at 100% zoom + 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)); - end; + w100 := CalcColWidthFromSheet(Worksheet.ReadDefaultColWidth(Workbook.Units)); + 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 - Worksheet.WriteDefaultColWidth(CalcWorksheetColWidth(AValue), Workbook.Units); + end; + 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 - Worksheet.WriteDefaultRowHeight(CalcWorksheetRowHeight(AValue), Workbook.Units); + if (FZoomLock = 0) and (Worksheet <> nil) then + 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, diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 40a43781d..c642336f5 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/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 diff --git a/components/fpspreadsheet/fpsvisualutils.pas b/components/fpspreadsheet/fpsvisualutils.pas index 94467c25e..493b6bdb5 100644 --- a/components/fpspreadsheet/fpsvisualutils.pas +++ b/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; diff --git a/components/fpspreadsheet/laz_fpspreadsheet_visual.pas b/components/fpspreadsheet/laz_fpspreadsheet_visual.pas index 5e5319bd2..91d790a75 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet_visual.pas +++ b/components/fpspreadsheet/laz_fpspreadsheet_visual.pas @@ -4,7 +4,6 @@ unit laz_fpspreadsheet_visual; -{$warn 5023 off : no warning about unused units} interface uses