{ fpspreadsheetgrid } {@@ ---------------------------------------------------------------------------- Grid component which can load and write data from/to FPSpreadsheet documents. Can either be used alone or in combination with a TsWorkbookSource component. The latter case requires less written code. AUTHORS: Felipe Monteiro de Carvalho, Werner Pamler LICENSE: See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution, for details about the license. -------------------------------------------------------------------------------} unit fpspreadsheetgrid; {$mode objfpc}{$H+} { To do: - When Lazarus 1.4 comes out remove the workaround for the RGB2HLS bug in FindNearestPaletteIndex. - Arial bold is not shown as such if loaded from ods - Background color of first cell is ignored. } interface uses Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Grids, ExtCtrls, LCLVersion, fpstypes, fpspreadsheet, fpspreadsheetctrls; const {$IF (lcl_fullversion >= 1030000)} ENABLE_MULTI_SELECT = 1; // requires Laz 1.4+ or trunk after r46767 {$ELSE} ENABLE_MULTI_SELECT = 0; {$ENDIF} type { TsCustomWorksheetGrid } TsHyperlinkClickEvent = procedure(Sender: TObject; const AHyperlink: TsHyperlink) of object; {@@ TsCustomWorksheetGrid is the ancestor of TsWorksheetGrid and is able to display spreadsheet data along with their formatting. } TsCustomWorksheetGrid = class(TCustomDrawGrid, IsSpreadsheetControl) private { Private declarations } FWorkbookSource: TsWorkbookSource; FOwnedWorkbook: TsWorkbook; FOwnsWorkbook: Boolean; FOwnedWorksheet: TsWorksheet; FHeaderCount: Integer; FInitColCount: Integer; FInitRowCount: Integer; FFrozenCols: Integer; FFrozenRows: Integer; FEditText: String; FOldEditText: String; FLockCount: Integer; FEditing: Boolean; FCellFont: TFont; FAutoCalc: Boolean; FTextOverflow: Boolean; FReadFormulas: Boolean; FDrawingCell: PCell; FTextOverflowing: Boolean; FEnhEditMode: Boolean; FHyperlinkTimer: TTimer; FHyperlinkCell: PCell; // Selected cell if it stores a hyperlink FOnClickHyperlink: TsHyperlinkClickEvent; function CalcAutoRowHeight(ARow: Integer): Integer; function CalcColWidth(AWidth: Single): Integer; function CalcRowHeight(AHeight: Single): Integer; procedure ChangedCellHandler(ASender: TObject; ARow, ACol: Cardinal); procedure ChangedFontHandler(ASender: TObject; ARow, ACol: Cardinal); procedure FixNeighborCellBorders(ACell: PCell); function GetBorderStyle(ACol, ARow, ADeltaCol, ADeltaRow: Integer; ACell: PCell; out ABorderStyle: TsCellBorderStyle): Boolean; // Setter/Getter function GetBackgroundColor(ACol, ARow: Integer): TsColor; function GetBackgroundColors(ARect: TGridRect): TsColor; function GetCellBorder(ACol, ARow: Integer): TsCellBorders; function GetCellBorders(ARect: TGridRect): TsCellBorders; function GetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder): TsCellBorderStyle; function GetCellBorderStyles(ARect: TGridRect; ABorder: TsCellBorder): TsCellBorderStyle; function GetCellFont(ACol, ARow: Integer): TFont; function GetCellFonts(ARect: TGridRect): TFont; function GetCellFontColor(ACol, ARow: Integer): TsColor; function GetCellFontColors(ARect: TGridRect): TsColor; function GetCellFontName(ACol, ARow: Integer): String; function GetCellFontNames(ARect: TGridRect): String; function GetCellFontSize(ACol, ARow: Integer): Single; function GetCellFontSizes(ARect: TGridRect): Single; function GetCellFontStyle(ACol, ARow: Integer): TsFontStyles; function GetCellFontStyles(ARect: TGridRect): TsFontStyles; function GetHorAlignment(ACol, ARow: Integer): TsHorAlignment; function GetHorAlignments(ARect: TGridRect): TsHorAlignment; function GetShowGridLines: Boolean; function GetShowHeaders: Boolean; function GetTextRotation(ACol, ARow: Integer): TsTextRotation; function GetTextRotations(ARect: TGridRect): TsTextRotation; function GetVertAlignment(ACol, ARow: Integer): TsVertAlignment; function GetVertAlignments(ARect: TGridRect): TsVertAlignment; function GetWorkbook: TsWorkbook; function GetWorksheet: TsWorksheet; function GetWordwrap(ACol, ARow: Integer): Boolean; function GetWordwraps(ARect: TGridRect): Boolean; procedure SetAutoCalc(AValue: Boolean); procedure SetBackgroundColor(ACol, ARow: Integer; AValue: TsColor); procedure SetBackgroundColors(ARect: TGridRect; AValue: TsColor); procedure SetCellBorder(ACol, ARow: Integer; AValue: TsCellBorders); procedure SetCellBorders(ARect: TGridRect; AValue: TsCellBorders); procedure SetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder; AValue: TsCellBorderStyle); procedure SetCellBorderStyles(ARect: TGridRect; ABorder: TsCellBorder; AValue: TsCellBorderStyle); procedure SetCellFont(ACol, ARow: Integer; AValue: TFont); procedure SetCellFonts(ARect: TGridRect; AValue: TFont); procedure SetCellFontColor(ACol, ARow: Integer; AValue: TsColor); procedure SetCellFontColors(ARect: TGridRect; AValue: TsColor); procedure SetCellFontName(ACol, ARow: Integer; AValue: String); procedure SetCellFontNames(ARect: TGridRect; AValue: String); procedure SetCellFontStyle(ACol, ARow: Integer; AValue: TsFontStyles); procedure SetCellFontStyles(ARect: TGridRect; AValue: TsFontStyles); procedure SetCellFontSize(ACol, ARow: Integer; AValue: Single); procedure SetCellFontSizes(ARect: TGridRect; AValue: Single); procedure SetFrozenCols(AValue: Integer); procedure SetFrozenRows(AValue: Integer); procedure SetHorAlignment(ACol, ARow: Integer; AValue: TsHorAlignment); procedure SetHorAlignments(ARect: TGridRect; AValue: TsHorAlignment); procedure SetReadFormulas(AValue: Boolean); procedure SetShowGridLines(AValue: Boolean); procedure SetShowHeaders(AValue: Boolean); procedure SetTextRotation(ACol, ARow: Integer; AValue: TsTextRotation); procedure SetTextRotations(ARect: TGridRect; AValue: TsTextRotation); procedure SetVertAlignment(ACol, ARow: Integer; AValue: TsVertAlignment); procedure SetVertAlignments(ARect: TGridRect; AValue: TsVertAlignment); procedure SetWorkbookSource(AValue: TsWorkbookSource); procedure SetWordwrap(ACol, ARow: Integer; AValue: boolean); procedure SetWordwraps(ARect: TGridRect; AValue: boolean); procedure HyperlinkTimerElapsed(Sender: TObject); protected { Protected declarations } procedure AutoAdjustColumn(ACol: Integer); override; procedure AutoAdjustRow(ARow: Integer); virtual; function CellOverflow(ACol, ARow: Integer; AState: TGridDrawState; out ACol1, ACol2: Integer; var ARect: TRect): Boolean; procedure CreateNewWorkbook; procedure DblClick; override; procedure DefineProperties(Filer: TFiler); override; procedure DoOnResize; override; procedure DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); override; procedure DrawAllRows; override; procedure DrawCellBorders; overload; procedure DrawCellBorders(ACol, ARow: Integer; ARect: TRect; ACell: PCell); overload; procedure DrawCellGrid(ACol,ARow: Integer; ARect: TRect; AState: TGridDrawState); override; procedure DrawCommentMarker(ARect: TRect); procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); override; procedure DrawFrozenPaneBorders(ARect: TRect); procedure DrawRow(aRow: Integer); override; procedure DrawSelection; procedure DrawTextInCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override; procedure ExecuteHyperlink; function GetCellHeight(ACol, ARow: Integer): Integer; function GetCellHintText(ACol, ARow: Integer): String; override; function GetCellText(ACol, ARow: Integer): String; function GetEditText(ACol, ARow: Integer): String; override; function HasBorder(ACell: PCell; ABorder: TsCellBorder): Boolean; procedure HeaderSized(IsColumn: Boolean; AIndex: Integer); override; procedure InternalDrawTextInCell(AText, AMeasureText: String; ARect: TRect; AJustification: Byte; ACellHorAlign: TsHorAlignment; ACellVertAlign: TsVertAlignment; ATextRot: TsTextRotation; ATextWrap, ReplaceTooLong: Boolean); procedure KeyDown(var Key : Word; Shift : TShiftState); override; procedure Loaded; override; procedure LoadFromWorksheet(AWorksheet: TsWorksheet); procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; procedure MoveSelection; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; // function SelectCell(AGridCol, AGridRow: Integer): Boolean; override; procedure SelectEditor; override; procedure SetEditText(ACol, ARow: Longint; const AValue: string); override; procedure Setup; procedure Sort(AColSorting: Boolean; AIndex, AIndxFrom, AIndxTo:Integer); override; function TrimToCell(ACell: PCell): String; procedure UpdateColWidths(AStartIndex: Integer = 0); procedure UpdateRowHeights(AStartIndex: Integer = 0); {@@ Automatically recalculate formulas whenever a cell value changes. } property AutoCalc: Boolean read FAutoCalc write SetAutoCalc default false; {@@ Displays column and row headers in the fixed col/row style of the grid. Deprecated. Use ShowHeaders instead. } property DisplayFixedColRow: Boolean read GetShowHeaders write SetShowHeaders default true; {@@ This number of columns at the left is "frozen", i.e. it is not possible to scroll these columns } property FrozenCols: Integer read FFrozenCols write SetFrozenCols; {@@ This number of rows at the top is "frozen", i.e. it is not possible to scroll these rows. } property FrozenRows: Integer read FFrozenRows write SetFrozenRows; {@@ Activates reading of RPN formulas. Should be turned off when non-implemented formulas crashe reading of the spreadsheet file. } property ReadFormulas: Boolean read FReadFormulas write SetReadFormulas; {@@ Shows/hides vertical and horizontal grid lines } property ShowGridLines: Boolean read GetShowGridLines write SetShowGridLines default true; {@@ Shows/hides column and row headers in the fixed col/row style of the grid. } property ShowHeaders: Boolean read GetShowHeaders write SetShowHeaders default true; {@@ Activates text overflow (cells reaching into neighbors) } property TextOverflow: Boolean read FTextOverflow write FTextOverflow default false; {@@ Event called when an external hyperlink is clicked } property OnClickHyperlink: TsHyperlinkClickEvent read FOnClickHyperlink write FOnClickHyperlink; public { public methods } constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure BeginUpdate; procedure DefaultDrawCell(ACol, ARow: Integer; var ARect: TRect; AState: TGridDrawState); override; procedure DeleteCol(AGridCol: Integer); reintroduce; procedure DeleteRow(AGridRow: Integer); reintroduce; procedure EditingDone; override; procedure EndUpdate; procedure GetSheets(const ASheets: TStrings); function GetGridCol(ASheetCol: Cardinal): Integer; inline; function GetGridRow(ASheetRow: Cardinal): Integer; inline; function GetWorksheetCol(AGridCol: Integer): Cardinal; inline; function GetWorksheetRow(AGridRow: Integer): Cardinal; inline; procedure InsertCol(AGridCol: Integer); procedure InsertRow(AGridRow: Integer); procedure LoadFromSpreadsheetFile(AFileName: string; AFormat: TsSpreadsheetFormat; AWorksheetIndex: Integer = 0); overload; procedure LoadFromSpreadsheetFile(AFileName: string; AWorksheetIndex: Integer = 0); overload; procedure NewWorkbook(AColCount, ARowCount: Integer); procedure SaveToSpreadsheetFile(AFileName: string; AOverwriteExisting: Boolean = true); overload; procedure SaveToSpreadsheetFile(AFileName: string; AFormat: TsSpreadsheetFormat; AOverwriteExisting: Boolean = true); overload; procedure SelectSheetByIndex(AIndex: Integer); procedure MergeCells; procedure UnmergeCells; { Utilities related to Workbooks } procedure Convert_sFont_to_Font(sFont: TsFont; AFont: TFont); procedure Convert_Font_to_sFont(AFont: TFont; sFont: TsFont); function FindNearestPaletteIndex(AColor: TColor): TsColor; { Interfacing with WorkbookSource} procedure ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil); procedure RemoveWorkbookSource; { public properties } {@@ Link to the workbook } property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource; {@@ Currently selected worksheet of the workbook } property Worksheet: TsWorksheet read GetWorksheet; {@@ Workbook displayed in the grid } property Workbook: TsWorkbook read GetWorkbook; {@@ Count of header lines - for conversion between grid- and workbook-based row and column indexes. Either 1 if row and column headers are shown or 0 if not} property HeaderCount: Integer read FHeaderCount; { maybe these should become published ... } {@@ Background color of the cell at the given column and row. Expressed as index into the workbook's color palette. } property BackgroundColor[ACol, ARow: Integer]: TsColor read GetBackgroundColor write SetBackgroundColor; {@@ Common background color of the cells covered by the given rectangle. Expressed as index into the workbook's color palette. } property BackgroundColors[ARect: TGridRect]: TsColor read GetBackgroundColors write SetBackgroundColors; {@@ Set of flags indicating at which cell border a border line is drawn. } property CellBorder[ACol, ARow: Integer]: TsCellBorders read GetCellBorder write SetCellBorder; {@@ Set of flags indicating at which border of a range of cells a border line is drawn } property CellBorders[ARect: TGridRect]: TsCellBorders read GetCellBorders write SetCellBorders; {@@ Style of the border line at the given border of the cell at column ACol and row ARow. Requires the cellborder flag of the border to be set for the border line to be shown } property CellBorderStyle[ACol, ARow: Integer; ABorder: TsCellBorder]: TsCellBorderStyle read GetCellBorderStyle write SetCellBorderStyle; {@@ Style of the border line at the given border of the cells within the range of colum/row indexes defined by the rectangle. Requires the cellborder flag of the border to be set for the border line to be shown } property CellBorderStyles[ARect: TGridRect; ABorder: TsCellBorder]: TsCellBorderStyle read GetCellBorderStyles write SetCellBorderStyles; {@@ Font to be used for text in the cell at column ACol and row ARow. } property CellFont[ACol, ARow: Integer]: TFont read GetCellFont write SetCellFont; {@@ Font to be used for the cells in the column/row index range given by the rectangle } property CellFonts[ARect: TGridRect]: TFont read GetCellFonts write SetCellFonts; {@@ Name of the font used for the cell on column ACol and row ARow } property CellFontName[ACol, ARow: Integer]: String read GetCellFontName write SetCellFontName; {@@ Name of the font used for the cells within the range of column/row indexes defined by the rectangle. } property CellFontNames[ARect: TGridRect]: String read GetCellFontNames write SetCellFontNames; {@@ Style of the font (bold, italic, ...) used for text in the cell at column ACol and row ARow. } property CellFontStyle[ACol, ARow: Integer]: TsFontStyles read GetCellFontStyle write SetCellFontStyle; {@@ Style of the font (bold, italic, ...) used for the cells within the range of column/row indexes defined by the rectangle. } property CellFontStyles[ARect: TGridRect]: TsFontStyles read GetCellFontStyles write SetCellFontStyles; {@@ Size of the font (in points) used for the cell at column ACol and row ARow } property CellFontSize[ACol, ARow: Integer]: Single read GetCellFontSize write SetCellFontSize; {@@ Size of the font (in points) used for the cells within the range of column/row indexes defined by the rectangle. } property CellFontSizes[ARect: TGridRect]: Single read GetCellFontSizes write SetCellFontSizes; {@@ Parameter for horizontal text alignment within the cell at column ACol and row ARow } property HorAlignment[ACol, ARow: Integer]: TsHorAlignment read GetHorAlignment write SetHorAlignment; {@@ Parameter for the horizontal text alignments in all cells within the range cf column/row indexes defined by the rectangle. } property HorAlignments[ARect: TGridRect]: TsHorAlignment read GetHorAlignments write SetHorAlignments; {@@ Rotation of the text in the cell at column ACol and row ARow. } property TextRotation[ACol, ARow: Integer]: TsTextRotation read GetTextRotation write SetTextRotation; {@@ Rotation of the text in the cells within the range of column/row indexes defined by the rectangle. } property TextRotations[ARect: TGridRect]: TsTextRotation read GetTextRotations write SetTextRotations; {@@ Parameter for vertical text alignment in the cell at column ACol and row ARow. } property VertAlignment[ACol, ARow: Integer]: TsVertAlignment read GetVertAlignment write SetVertAlignment; {@@ Parameter for vertical text alignment in the cells having column/row indexes defined by the rectangle. } property VertAlignments[ARect: TGridRect]: TsVertAlignment read GetVertAlignments write SetVertAlignments; {@@ If true, word-wrapping of text within the cell at column ACol and row ARow is activated. } property Wordwrap[ACol, ARow: Integer]: Boolean read GetWordwrap write SetWordwrap; {@@ If true, word-wrapping of text within all cells within the range defined by the rectangle is activated. } property Wordwraps[ARect: TGridRect]: Boolean read GetWordwraps write SetWordwraps; // inherited {$IF (ENABLE_MULTI_SELECT = 1)} {@@ Allow multiple selections} property RangeSelectMode default rsmMulti; {$ENDIF} end; { TsWorksheetGrid } {@@ TsWorksheetGrid is a grid which displays spreadsheet data along with formatting. As it is linked to an instance of TsWorkbook, it provides methods for reading data from or writing to spreadsheet files. It has the same funtionality as TsCustomWorksheetGrid, but has published all properties. } TsWorksheetGrid = class(TsCustomWorksheetGrid) published // inherited from TsCustomWorksheetGrid {@@ Automatically recalculates the worksheet if a cell value changes. } property AutoCalc; {@@ Displays column and row headers in the fixed col/row style of the grid. Deprecated. Use ShowHeaders instead. } property DisplayFixedColRow; deprecated 'Use ShowHeaders'; {@@ This number of columns at the left is "frozen", i.e. it is not possible to scroll these columns. } property FrozenCols; {@@ This number of rows at the top is "frozen", i.e. it is not possible to scroll these rows. } property FrozenRows; {@@ Activates reading of RPN formulas. Should be turned off when non-implemented formulas crashe reading of the spreadsheet file. } property ReadFormulas; {@@ Shows/hides vertical and horizontal grid lines. } property ShowGridLines; {@@ Shows/hides column and row headers in the fixed col/row style of the grid. } property ShowHeaders; {@@ Activates text overflow (cells reaching into neighbors) } property TextOverflow; {@@ Link to the workbook } property WorkbookSource; {@@ inherited from ancestors} property Align; {@@ inherited from ancestors} property AlternateColor; {@@ inherited from ancestors} property Anchors; {@@ inherited from ancestors} property AutoAdvance; {@@ inherited from ancestors} property AutoEdit; {@@ inherited from ancestors} property AutoFillColumns; //property BiDiMode; {@@ inherited from ancestors} property BorderSpacing; {@@ inherited from ancestors} property BorderStyle; {@@ inherited from ancestors} property CellHintPriority; {@@ inherited from ancestors} property Color; {@@ inherited from ancestors} property ColCount; //property Columns; {@@ inherited from ancestors} property Constraints; {@@ inherited from ancestors} property DefaultColWidth; {@@ inherited from ancestors} property DefaultDrawing; {@@ inherited from ancestors} property DefaultRowHeight; {@@ inherited from ancestors} property DragCursor; {@@ inherited from ancestors} property DragKind; {@@ inherited from ancestors} property DragMode; {@@ inherited from ancestors} property Enabled; {@@ inherited from ancestors} property ExtendedSelect default true; {@@ inherited from ancestors} property FixedColor; {@@ inherited from ancestors} property Flat; {@@ inherited from ancestors} property Font; {@@ inherited from ancestors} property GridLineWidth; {@@ inherited from ancestors} property HeaderHotZones; {@@ inherited from ancestors} property HeaderPushZones; {@@ inherited from ancestors} property MouseWheelOption; {@@ inherited from TCustomGrid. Select the option goEditing to make the grid editable! } property Options; //property ParentBiDiMode; {@@ inherited from ancestors} property ParentColor default false; {@@ inherited from ancestors} property ParentFont; {@@ inherited from ancestors} property ParentShowHint; {@@ inherited from ancestors} property PopupMenu; {@@ inherited from ancestors} property RowCount; {@@ inherited from ancestors} property ScrollBars; {@@ inherited from ancestors} property ShowHint; {@@ inherited from ancestors} property TabOrder; {@@ inherited from ancestors} property TabStop; {@@ inherited from ancestors} property TitleFont; {@@ inherited from ancestors} property TitleImageList; {@@ inherited from ancestors} property TitleStyle; {@@ inherited from ancestors} property UseXORFeatures; {@@ inherited from ancestors} property Visible; {@@ inherited from ancestors} property VisibleColCount; {@@ inherited from ancestors} property VisibleRowCount; {@@ inherited from ancestors} property OnBeforeSelection; {@@ inherited from ancestors} property OnChangeBounds; {@@ inherited from ancestors} property OnClick; {@@ inherited from TCustomWorksheetGrid} property OnClickHyperlink; {@@ inherited from ancestors} property OnColRowDeleted; {@@ inherited from ancestors} property OnColRowExchanged; {@@ inherited from ancestors} property OnColRowInserted; {@@ inherited from ancestors} property OnColRowMoved; (* {@@ inherited from ancestors} property OnCompareCells; // apply userdefined sorting to worksheet directly! *) {@@ inherited from ancestors} property OnDragDrop; {@@ inherited from ancestors} property OnDragOver; {@@ inherited from ancestors} property OnDblClick; {@@ inherited from ancestors} property OnDrawCell; {@@ inherited from ancestors} property OnEditButtonClick; {@@ inherited from ancestors} property OnEditingDone; {@@ inherited from ancestors} property OnEndDock; {@@ inherited from ancestors} property OnEndDrag; {@@ inherited from ancestors} property OnEnter; {@@ inherited from ancestors} property OnExit; {@@ inherited from ancestors} property OnGetEditMask; {@@ inherited from ancestors} property OnGetEditText; {@@ inherited from ancestors} property OnHeaderClick; {@@ inherited from ancestors} property OnHeaderSized; {@@ inherited from ancestors} property OnKeyDown; {@@ inherited from ancestors} property OnKeyPress; {@@ inherited from ancestors} property OnKeyUp; {@@ inherited from ancestors} property OnMouseDown; {@@ inherited from ancestors} property OnMouseMove; {@@ inherited from ancestors} property OnMouseUp; {@@ inherited from ancestors} property OnMouseWheel; {@@ inherited from ancestors} property OnMouseWheelDown; {@@ inherited from ancestors} property OnMouseWheelUp; {@@ inherited from ancestors} property OnPickListSelect; {@@ inherited from ancestors} property OnPrepareCanvas; {@@ inherited from ancestors} property OnResize; {@@ inherited from ancestors} property OnSelectEditor; {@@ inherited from ancestors} property OnSelection; {@@ inherited from ancestors} property OnSelectCell; {@@ inherited from ancestors} property OnSetEditText; {@@ inherited from ancestors} property OnShowHint; {@@ inherited from ancestors} property OnStartDock; {@@ inherited from ancestors} property OnStartDrag; {@@ inherited from ancestors} property OnTopLeftChanged; {@@ inherited from ancestors} property OnUTF8KeyPress; {@@ inherited from ancestors} property OnValidateEntry; {@@ inherited from ancestors} property OnContextPopup; end; procedure Register; implementation uses Types, LCLType, LCLIntf, Math, fpCanvas, fpsStrings, fpsUtils, fpsVisualUtils; const {@@ Translation of the fpspreadsheet type of horizontal text alignment to that used in the graphics unit. } HOR_ALIGNMENTS: array[haLeft..haRight] of TAlignment = ( taLeftJustify, taCenter, taRightJustify ); {@@ Translation of the fpspreadsheet type of vertical text alignment to that used in the graphics unit. } VERT_ALIGNMENTS: array[TsVertAlignment] of TTextLayout = ( tlBottom, tlTop, tlCenter, tlBottom ); {@@ Default number of columns prepared for a new empty worksheet } DEFAULT_COL_COUNT = 26; {@@ Default number of rows prepared for a new empty worksheet } DEFAULT_ROW_COUNT = 100; {@@ Interval how long the mouse buttons has to be held down on a hyperlink cell until the associated hyperlink is executed. } HYPERLINK_TIMER_INTERVAL = 500; var {@@ Auxiliary bitmap containing the previously used non-trivial fill pattern } FillPatternBitmap: TBitmap = nil; FillPatternStyle: TsFillStyle; FillPatternFgColor: TColor; FillPatternBgColor: TColor; {@@ ---------------------------------------------------------------------------- Helper procedure which creates bitmaps used for fill patterns in cell backgrounds. The parameters are buffered in FillPatternXXXX variables to avoid unnecessary creation of the same bitmaps again and again. -------------------------------------------------------------------------------} procedure CreateFillPattern(var ABitmap: TBitmap; AStyle: TsFillStyle; AFgColor, ABgColor: TColor); procedure SolidFill(AColor: TColor); begin ABitmap.Canvas.Brush.Color := AColor; ABitmap.Canvas.FillRect(0, 0, ABitmap.Width, ABitmap.Height); end; var x,y: Integer; begin if (FillPatternStyle = AStyle) and (FillPatternBgColor = ABgColor) and (FillPatternFgColor = AFgColor) and (ABitmap <> nil) then exit; FreeAndNil(ABitmap); ABitmap := TBitmap.Create; with ABitmap do begin if AStyle = fsGray6 then SetSize(8, 4) else SetSize(4, 4); case AStyle of fsNoFill: SolidFill(ABgColor); fsSolidFill: SolidFill(AFgColor); fsGray75: begin SolidFill(AFgColor); Canvas.Pixels[0, 0] := ABgColor; Canvas.Pixels[2, 1] := ABgColor; Canvas.Pixels[0, 2] := ABgColor; Canvas.Pixels[2, 3] := ABgColor; end; fsGray50: begin SolidFill(AFgColor); for y := 0 to 3 do for x := 0 to 3 do if odd(x+y) then Canvas.Pixels[x,y] := ABgColor; end; fsGray25: begin SolidFill(ABgColor); Canvas.Pixels[0, 0] := AFgColor; Canvas.Pixels[2, 1] := AFgColor; Canvas.Pixels[0, 2] := AFgColor; Canvas.Pixels[2, 3] := AFgColor; end; fsGray12: begin SolidFill(ABgColor); Canvas.Pixels[0, 0] := AFgColor; Canvas.Pixels[2, 2] := AFgColor; end; fsGray6: begin SolidFill(ABgColor); Canvas.Pixels[0, 0] := AFgColor; Canvas.Pixels[4, 2] := AFgColor; end; fsStripeHor: begin SolidFill(ABgColor); for y := 0 to 1 do for x := 0 to 3 do Canvas.Pixels[x,y] := AFgColor; end; fsStripeVert: begin SolidFill(ABgColor); for y := 0 to 3 do for x := 0 to 1 do Canvas.Pixels[x,y] := AFgColor; end; fsStripeDiagUp: begin SolidFill(ABgColor); for y := 0 to 3 do for x := 0 to 1 do Canvas.Pixels[(x+y) mod 4, 3-y] := AFgColor; end; fsStripeDiagDown: begin SolidFill(ABgColor); for y := 0 to 3 do for x := 0 to 1 do Canvas.Pixels[(x+y) mod 4, y] := AFgColor; end; fsThinStripeHor: begin SolidFill(ABgColor); for x := 0 to 3 do Canvas.Pixels[x, 0] := AFgColor; end; fsThinStripeVert: begin SolidFill(ABgColor); for y := 0 to 3 do Canvas.Pixels[0, y] := AFgColor; end; fsThinStripeDiagUp: begin SolidFill(ABgColor); for x := 0 to 3 do Canvas.Pixels[3-x, x] := AFgColor; end; fsThinStripeDiagDown, fsThinHatchDiag: begin SolidFill(ABgColor); for x := 0 to 3 do Canvas.Pixels[x, x] := AFgColor; if AStyle = fsThinHatchDiag then begin Canvas.Pixels[0, 2] := AFgColor; Canvas.Pixels[2, 0] := AFgColor; end; end; fsHatchDiag: begin SolidFill(ABgColor); for x := 0 to 1 do for y := 0 to 1 do begin Canvas.Pixels[x,y] := AFgColor; Canvas.Pixels[x+2, y+2] := AFgColor; end; end; fsThickHatchDiag: begin SolidFill(AFgColor); for x := 2 to 3 do Canvas.Pixels[x, 0] := ABgColor; for x := 0 to 1 do Canvas.Pixels[x, 2] := ABgColor; end; fsThinHatchHor: begin SolidFill(ABgColor); for x := 0 to 3 do begin Canvas.Pixels[x, 0] := AFgColor; Canvas.Pixels[0, x] := AFgColor; end; end; end; // case end; FillPatternStyle := AStyle; FillPatternBgColor := ABgColor; FillPatternFgColor := AFgColor; end; {@@ ---------------------------------------------------------------------------- Helper procedure which draws a densely dotted horizontal line. In Excel this is called a "hair line". @param x1, x2 x coordinates of the end points of the line @param y y coordinate of the horizontal line -------------------------------------------------------------------------------} procedure DrawHairLineHor(ACanvas: TCanvas; x1, x2, y: Integer); var clr: TColor; x: Integer; begin if odd(x1) then inc(x1); x := x1; clr := ACanvas.Pen.Color; while (x <= x2) do begin ACanvas.Pixels[x, y] := clr; inc(x, 2); end; end; {@@ ---------------------------------------------------------------------------- Helper procedure which draws a densely dotted vertical line. In Excel this is called a "hair line". @param x x coordinate of the vertical line @param y1, y2 y coordinates of the end points of the line -------------------------------------------------------------------------------} procedure DrawHairLineVert(ACanvas: TCanvas; x, y1, y2: Integer); var clr: TColor; y: Integer; begin if odd(y1) then inc(y1); y := y1; clr := ACanvas.Pen.Color; while (y <= y2) do begin ACanvas.Pixels[x, y] := clr; inc(y, 2); end; end; {@@ ---------------------------------------------------------------------------- Calculates a background color for selected cells. The procedures takes the original background color and dims or brightens it by adding the value ADelta to the RGB components. @param c Color to be modified @param ADelta Value to be added to the RGB components of the inpur color @result Modified color. -------------------------------------------------------------------------------} function CalcSelectionColor(c: TColor; ADelta: Byte) : TColor; type TRGBA = record R,G,B,A: Byte end; begin c := ColorToRGB(c); TRGBA(Result).A := 0; if TRGBA(c).R < 128 then TRGBA(Result).R := TRGBA(c).R + ADelta else TRGBA(Result).R := TRGBA(c).R - ADelta; if TRGBA(c).G < 128 then TRGBA(Result).G := TRGBA(c).G + ADelta else TRGBA(Result).G := TRGBA(c).G - ADelta; if TRGBA(c).B < 128 then TRGBA(Result).B := TRGBA(c).B + ADelta else TRGBA(Result).B := TRGBA(c).B - ADelta; end; {******************************************************************************* * TsCustomWorksheetGrid * *******************************************************************************} {@@ ---------------------------------------------------------------------------- Constructor of the grid. Activates the display of column and row headers and creates an internal "CellFont". Creates a pre-defined number of empty rows and columns. @param AOwner Owner of the grid -------------------------------------------------------------------------------} constructor TsCustomWorksheetGrid.Create(AOwner: TComponent); begin inherited Create(AOwner); AutoAdvance := aaDown; ExtendedSelect := true; FHeaderCount := 1; FInitColCount := DEFAULT_COL_COUNT; FInitRowCount := DEFAULT_ROW_COUNT; FCellFont := TFont.Create; FHyperlinkTimer := TTimer.Create(self); FHyperlinkTimer.Interval := HYPERLINK_TIMER_INTERVAL; FHyperlinkTimer.OnTimer := @HyperlinkTimerElapsed; FOwnsWorkbook := true; {$IF (ENABLE_MULTI_SELECT=1)} RangeSelectMode := rsmMulti; {$ENDIF} end; {@@ ---------------------------------------------------------------------------- Destructor of the grid: Destroys the workbook and the internal CellFont. -------------------------------------------------------------------------------} destructor TsCustomWorksheetGrid.Destroy; begin if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); if FOwnsWorkbook then FreeAndNil(FOwnedWorkbook); FreeAndNil(FCellFont); inherited Destroy; end; {@@ ---------------------------------------------------------------------------- Is called when goDblClickAutoSize is in the grid's options and a double click has occured at the border of a column header. Sets optimum column with. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.AutoAdjustColumn(ACol: Integer); var gRow: Integer; // row in grid coordinates r: Cardinal; lastRow: Cardinal; w, maxw: Integer; txt: String; begin if Worksheet = nil then exit; lastRow := Worksheet.GetLastOccupiedRowIndex; maxw := -1; for r := 0 to lastRow do begin gRow := GetGridRow(r); txt := GetCellText(ACol, gRow); PrepareCanvas(ACol, gRow, []); w := Canvas.TextWidth(txt); if (txt <> '') and (w > maxw) then maxw := w; end; if maxw > -1 then maxw := maxw + 2*constCellPadding else maxw := DefaultColWidth; ColWidths[ACol] := maxW; HeaderSized(true, ACol); end; {@@ ---------------------------------------------------------------------------- Is called when goDblClickAutoSize is in the grid's options and a double click has occured at the border of a row header. Sets optimum row height. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.AutoAdjustRow(ARow: Integer); begin if Worksheet <> nil then RowHeights[ARow] := CalcAutoRowHeight(ARow) else RowHeights[ARow] := DefaultRowHeight; HeaderSized(false, ARow); end; {@@ ---------------------------------------------------------------------------- The BeginUpdate/EndUpdate pair suppresses unnecessary painting of the grid. Call BeginUpdate to stop refreshing the grid, and call EndUpdate to release the lock and to repaint the grid again. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.BeginUpdate; begin inc(FLockCount); end; {@@ ---------------------------------------------------------------------------- Converts the column width, given in "characters" of the default font, to pixels. All chars are assumed to have the same width defined by the width of the "0" character. Therefore, this calculation is only approximate. @param AWidth Width of a column given as "character count". @return Column width in pixels. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.CalcColWidth(AWidth: Single): Integer; var w0: Integer; begin Convert_sFont_to_Font(Workbook.GetFont(0), Canvas.Font); w0 := Canvas.TextWidth('0'); Result := Round(AWidth * w0); end; {@@ ---------------------------------------------------------------------------- Finds the maximum cell height per row and uses this to define the RowHeights[]. Returns DefaultRowHeight if the row does not contain any cells, or if the worksheet does not have a TRow record for this particular row. ARow is a grid row index. @param ARow Index of the row, in grid units @return Row height -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.CalcAutoRowHeight(ARow: Integer): Integer; var c: Integer; h: Integer; begin h := 0; for c := FHeaderCount to ColCount-1 do h := Max(h, GetCellHeight(c, ARow)); if h = 0 then Result := DefaultRowHeight else Result := h; end; {@@ ---------------------------------------------------------------------------- Converts the row height (from a worksheet row record), given in lines, to pixels as needed by the grid @param AHeight Row height expressed as default font line count from the worksheet @result Row height in pixels. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.CalcRowHeight(AHeight: Single): Integer; var h_pts: Single; begin h_pts := AHeight * (Workbook.GetFont(0).Size + ROW_HEIGHT_CORRECTION); Result := PtsToPX(h_pts, Screen.PixelsPerInch) + 4; end; {@@ ---------------------------------------------------------------------------- Looks for overflowing cells: if the text of the given cell is longer than the cell width the function calculates the column indexes and the rectangle to show the complete text. Ony for non-wordwrapped label cells and for horizontal orientation. Function returns false if text overflow needs not to be considered. @param ACol, ARow Column and row indexes (in grid coordinates) of the cell to be drawn @param AState GridDrawState of the cell (normal, fixed, selected etc) @param ACol1,ACol2 (output) Index of the first and last column covered by the overflowing text @param ARect (output) Pixel rectangle enclosing the cell and its neighbors affected @return TRUE if text overflow into neighbor cells is to be considered, FALSE if not. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.CellOverflow(ACol, ARow: Integer; AState: TGridDrawState; out ACol1, ACol2: Integer; var ARect: TRect): Boolean; var txt: String; len: Integer; cell: PCell; txtalign: TsHorAlignment; r: Cardinal; w, w0: Integer; fmt: PsCellFormat; begin Result := false; cell := FDrawingCell; // Nothing to do in these cases (like in Excel): if (cell = nil) or not (cell^.ContentType in [cctUTF8String]) then // ... non-label cells exit; fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex); if (uffWordWrap in fmt^.UsedFormattingFields) then // ... word-wrap exit; if (uffTextRotation in fmt^.UsedFormattingFields) and // ... vertical text (fmt^.TextRotation <> trHorizontal) then exit; txt := cell^.UTF8Stringvalue; if (uffHorAlign in fmt^.UsedFormattingFields) then txtalign := fmt^.HorAlignment else txtalign := haDefault; PrepareCanvas(ACol, ARow, AState); len := Canvas.TextWidth(txt) + 2*constCellPadding; ACol1 := ACol; ACol2 := ACol; r := GetWorksheetRow(ARow); case txtalign of haLeft, haDefault: // overflow to the right while (len > ARect.Right - ARect.Left) and (ACol2 < ColCount-1) do begin result := true; inc(ACol2); cell := Worksheet.FindCell(r, GetWorksheetCol(ACol2)); if (cell <> nil) and (cell^.ContentType <> cctEmpty) then begin dec(ACol2); break; end; ARect.Right := ARect.Right + ColWidths[ACol2]; end; haRight: // overflow to the left while (len > ARect.Right - ARect.Left) and (ACol1 > FixedCols) do begin result := true; dec(ACol1); cell := Worksheet.FindCell(r, GetWorksheetCol(ACol1)); if (cell <> nil) and (cell^.ContentType <> cctEmpty) then begin inc(ACol1); break; end; ARect.Left := ARect.Left - ColWidths[ACol1]; end; haCenter: begin len := len div 2; w0 := (ARect.Right - ARect.Left) div 2; w := w0; // right part while (len > w) and (ACol2 < ColCount-1) do begin Result := true; inc(ACol2); cell := Worksheet.FindCell(r, GetWorksheetCol(ACol2)); if (cell <> nil) and (cell^.ContentType <> cctEmpty) then begin dec(ACol2); break; end; ARect.Right := ARect.Right + ColWidths[ACol2]; inc(w, ColWidths[ACol2]); end; // left part w := w0; while (len > w) and (ACol1 > FixedCols) do begin Result := true; dec(ACol1); cell := Worksheet.FindCell(r, GetWorksheetCol(ACol1)); if (cell <> nil) and (cell^.Contenttype <> cctEmpty) then begin inc(ACol1); break; end; ARect.Left := ARect.left - ColWidths[ACol1]; inc(w, ColWidths[ACol1]); end; end; end; end; {@@ ---------------------------------------------------------------------------- Handler for the event OnChangeCell fired by the worksheet when the contents or formatting of a cell have changed. As a consequence, the grid may have to update the cell. Row/Col coordinates are in worksheet units here! @param ASender Sender of the event OnChangeFont (the worksheet) @param ARow Row index of the changed cell, in worksheet units! @param ACol Column index of the changed cell, in worksheet units! -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.ChangedCellHandler(ASender: TObject; ARow, ACol:Cardinal); begin Unused(ASender, ARow, ACol); if FLockCount = 0 then Invalidate; end; {@@ ---------------------------------------------------------------------------- Handler for the event OnChangeFont fired by the worksheet when the font has changed in a cell. As a consequence, the grid may have to update the row height. Row/Col coordinates are in worksheet units here! @param ASender Sender of the event OnChangeFont (the worksheet) @param ARow Row index of the cell with the changed font, in worksheet units! @param ACol Column index of the cell with the changed font, in worksheet units! -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.ChangedFontHandler(ASender: TObject; ARow, ACol: Cardinal); var lRow: PRow; gr: Integer; // row index in grid units begin Unused(ASender, ACol); if (Worksheet <> nil) then begin lRow := Worksheet.FindRow(ARow); if lRow = nil then begin // There is no row record --> row height changes according to font height // Otherwise the row height would be fixed according to the value in the row record. gr := GetGridRow(ARow); // convert row index to grid units RowHeights[gr] := CalcAutoRowHeight(gr); end; Invalidate; end; end; {@@ ---------------------------------------------------------------------------- Converts a spreadsheet font to a font used for painting (TCanvas.Font). @param sFont Font as used by fpspreadsheet (input) @param AFont Font as used by TCanvas for painting (output) -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.Convert_sFont_to_Font(sFont: TsFont; AFont: TFont); begin fpsVisualUtils.Convert_sFont_to_Font(Workbook, sFont, AFont); end; {@@ ---------------------------------------------------------------------------- Converts a font used for painting (TCanvas.Font) to a spreadsheet font. @param AFont Font as used by TCanvas for painting (input) @param sFont Font as used by fpspreadsheet (output) -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.Convert_Font_to_sFont(AFont: TFont; sFont: TsFont); begin fpsVisualUtils.Convert_Font_to_sFont(Workbook, AFont, sFont); end; {@@ ---------------------------------------------------------------------------- This is one of the main painting methods inherited from TsCustomGrid. It is overridden here to achieve the feature of "frozen" cells which should be painted in the same style as normal cells. Internally, "frozen" cells are "fixed" cells of the grid. Therefore, it is not possible to select any cell within the frozen panes - in contrast to the standard spreadsheet applications. @param ACol Column index of the cell being drawn @param ARow Row index of the cell beging drawn @param ARect Rectangle, in grid pixels, covered by the cell @param AState Grid drawing state, as defined by TsCustomGrid -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DefaultDrawCell(aCol, aRow: Integer; var aRect: TRect; AState: TGridDrawState); var wasFixed: Boolean; begin wasFixed := false; if (gdFixed in AState) then if ShowHeaders then begin if ((ARow < FixedRows) and (ARow > 0) and (ACol > 0)) or ((ACol < FixedCols) and (ACol > 0) and (ARow > 0)) then wasFixed := true; end else begin if (ARow < FixedRows) or (ACol < FixedCols) then wasFixed := true; end; if wasFixed then begin AState := AState - [gdFixed]; Canvas.Brush.Color := clWindow; DoPrepareCanvas(ACol, ARow, AState); end; inherited DefaultDrawCell(ACol, ARow, ARect, AState); if wasFixed then begin DrawCellGrid(ACol, ARow, ARect, AState); AState := AState + [gdFixed]; end; end; {@@ ---------------------------------------------------------------------------- Deletes the column specified. @param AGridCol Grid index of the column to be deleted -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DeleteCol(AGridCol: Integer); begin if AGridCol < FHeaderCount then exit; Worksheet.DeleteCol(GetWorksheetCol(AGridCol)); UpdateColWidths(AGridCol); end; {@@ ---------------------------------------------------------------------------- Deletes the row specified. @param AGridRow Grid index of the row to be deleted -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DeleteRow(AGridRow: Integer); begin if AGridRow < FHeaderCount then exit; Worksheet.DeleteRow(GetWorksheetRow(AGridRow)); UpdateRowHeights(AGridRow); end; {@@ ---------------------------------------------------------------------------- Creates a new empty workbook into which a file will be loaded. Destroys the previously used workbook. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.CreateNewWorkbook; begin if FOwnsWorkbook then FreeAndNil(FOwnedWorkbook); if FWorkbookSource <> nil then FWorkbookSource.CreateNewWorkbook else begin FOwnedWorkbook := TsWorkbook.Create; FOwnsWorkbook := true; if FReadFormulas then FOwnedWorkbook.Options := FOwnedWorkbook.Options + [boReadFormulas] else FOwnedWorkbook.Options := FOwnedWorkbook.Options - [boReadFormulas]; SetAutoCalc(FAutoCalc); end; end; {@@ ---------------------------------------------------------------------------- Is called when a Double-click occurs. Overrides the inherited method to react on double click on cell border in row headers to auto-adjust the row heights -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DblClick; var oldHeight: Integer; gRow: Integer; begin SelectActive := False; FGridState := gsNormal; if (goRowSizing in Options) and (Cursor = crVSplit) and (FHeaderCount > 0) then begin if (goDblClickAutoSize in Options) then begin gRow := GCache.MouseCell.y; if CellRect(0, gRow).Bottom - GCache.ClickMouse.y > 0 then dec(gRow); oldHeight := RowHeights[gRow]; AutoAdjustRow(gRow); if oldHeight <> RowHeights[gRow] then Cursor := crDefault; //ChangeCursor; end end else inherited DblClick; end; procedure TsCustomWorksheetGrid.DefineProperties(Filer: TFiler); begin // Don't call inherited, this is where to ColWidths/RwoHeights are stored in // the lfm file - we don't need them, we get them from the workbook! Unused(Filer); end; procedure TsCustomWorksheetGrid.DoOnResize; begin if (csDesigning in ComponentState) and (Worksheet = nil) then NewWorkbook(FInitColCount, FInitRowCount); inherited; end; {@@ ---------------------------------------------------------------------------- Adjusts the grid's canvas before painting a given cell. Considers background color, horizontal alignment, vertical alignment, etc. @param ACol Column index of the cell being painted @param ARow Row index of the cell being painted @param AState Grid drawing state -- see TsCustomGrid. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); var ts: TTextStyle; lCell: PCell; fmt: PsCellFormat; r, c: Integer; fnt: TsFont; style: TFontStyles; isSelected: Boolean; fgcolor, bgcolor: TColor; begin GetSelectedState(AState, isSelected); Canvas.Font.Assign(Font); Canvas.Brush.Bitmap := nil; Canvas.Brush.Color := Color; ts := Canvas.TextStyle; if ShowHeaders then begin // Formatting of row and column headers if ARow = 0 then begin ts.Alignment := taCenter; ts.Layout := tlCenter; end else if ACol = 0 then begin ts.Alignment := taRightJustify; ts.Layout := tlCenter; end; if ShowHeaders and ((ACol = 0) or (ARow = 0)) then Canvas.Brush.Color := FixedColor end; if (Worksheet <> nil) and (ARow >= FHeaderCount) and (ACol >= FHeaderCount) then begin r := ARow - FHeaderCount; c := ACol - FHeaderCount; lCell := Worksheet.FindCell(r, c); if lCell <> nil then begin fmt := Workbook.GetPointerToCellFormat(lCell^.FormatIndex); // Background color if (uffBackground in fmt^.UsedFormattingFields) then begin if Workbook.FileFormat = sfExcel2 then begin CreateFillPattern(FillPatternBitmap, fsGray50, clBlack, Color); Canvas.Brush.Style := bsImage; Canvas.Brush.Bitmap := FillPatternBitmap; end else begin case fmt^.Background.Style of fsNoFill: Canvas.Brush.Style := bsClear; fsSolidFill: begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := Workbook.GetPaletteColor(fmt^.Background.FgColor); end; else if fmt^.Background.BgColor = scTransparent then bgcolor := Color else bgcolor := Workbook.GetPaletteColor(fmt^.Background.BgColor); if fmt^.Background.FgColor = scTransparent then fgcolor := Color else fgcolor := Workbook.GetPaletteColor(fmt^.Background.FgColor); CreateFillPattern(FillPatternBitmap, fmt^.Background.Style, fgColor, bgColor); Canvas.Brush.Style := bsImage; Canvas.Brush.Bitmap := FillPatternBitmap; end; end; end else begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := Color; end; // Font if Worksheet.HasHyperlink(lCell) then fnt := Workbook.GetHyperlinkFont else fnt := Workbook.GetDefaultFont; 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 := Workbook.GetPaletteColor(fnt.Color); 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; if (fmt^.NumberFormat = nfCurrencyRed) and not IsNaN(lCell^.NumberValue) and (lCell^.NumberValue < 0) then Canvas.Font.Color := Workbook.GetPaletteColor(scRed); // Wordwrap, text alignment and text rotation are handled by "DrawTextInCell". end; end; if IsSelected then Canvas.Brush.Color := CalcSelectionColor(Canvas.Brush.Color, 16); Canvas.TextStyle := ts; inherited DoPrepareCanvas(ACol, ARow, AState); end; {@@ ---------------------------------------------------------------------------- This method is inherited from TsCustomGrid, but is overridden here in order to paint the cell borders and the selection rectangle. Both features can extend into the neighboring cells and thus would be clipped at the cell borders by the standard painting mechanism. At the time when DrawAllRows is called, however, clipping at cell borders is no longer active. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawAllRows; var cliprect: TRect; rgn: HRGN; tmp: Integer = 0; begin inherited; Canvas.SaveHandleState; try // Avoid painting into the header cells cliprect := ClientRect; if FixedCols > 0 then ColRowToOffset(True, True, FixedCols-1, tmp, cliprect.Left); if FixedRows > 0 then ColRowToOffset(False, True, FixedRows-1, tmp, cliprect.Top); DrawFrozenPaneBorders(clipRect); rgn := CreateRectRgn(cliprect.Left, cliprect.top, cliprect.Right, cliprect.Bottom); SelectClipRgn(Canvas.Handle, Rgn); DrawCellBorders; DrawSelection; DeleteObject(rgn); finally Canvas.RestoreHandleState; end; end; {@@ ---------------------------------------------------------------------------- Draws the borders of all cells. Calls DrawCellBorder for each individual cell. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawCellBorders; var cell: PCell; c, r: Integer; rect: TRect; begin if Worksheet = nil then exit; for cell in Worksheet.Cells do begin if (uffBorder in Worksheet.ReadUsedFormatting(cell)) then begin c := GetGridCol(cell^.Col); r := GetGridRow(cell^.Row); rect := CellRect(c, r); DrawCellBorders(c, r, rect, cell); end; end; end; {@@ ---------------------------------------------------------------------------- Draws the border lines around a given cell. Note that when this procedure is called the output is clipped by the cell rectangle, but thick and double border styles extend into the neighboring cell. Therefore, these border lines are drawn in parts. @param ACol Column Index @param ARow Row index @param ARect Rectangle in pixels occupied by the cell. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawCellBorders(ACol, ARow: Integer; ARect: TRect; ACell: PCell); const drawHor = 0; drawVert = 1; drawDiagUp = 2; drawDiagDown = 3; procedure DrawBorderLine(ACoord: Integer; ARect: TRect; ADrawDirection: Byte; ABorderStyle: TsCellBorderStyle); const // TsLineStyle = (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble, lsHair); PEN_STYLES: array[TsLineStyle] of TPenStyle = (psSolid, psSolid, psDash, psDot, psSolid, psSolid, psSolid); PEN_WIDTHS: array[TsLineStyle] of Integer = (1, 2, 1, 1, 3, 1, 1); var width3: Boolean; // line is 3 pixels wide deltax, deltay: Integer; angle: Double; begin Canvas.Pen.Style := PEN_STYLES[ABorderStyle.LineStyle]; Canvas.Pen.Width := PEN_WIDTHS[ABorderStyle.LineStyle]; Canvas.Pen.Color := Workbook.GetPaletteColor(ABorderStyle.Color); Canvas.Pen.EndCap := pecSquare; width3 := (ABorderStyle.LineStyle in [lsThick, lsDouble]); // Workaround until efficient drawing procedures for diagonal "hair" lines // is available if (ADrawDirection in [drawDiagUp, drawDiagDown]) and (ABorderStyle.LineStyle = lsHair) then ABorderStyle.LineStyle := lsDotted; // Tuning the rectangle to avoid issues at the grid borders and to get nice corners if (ABorderStyle.LineStyle in [lsMedium, lsThick, lsDouble]) then begin if ACol = ColCount-1 then begin if (ADrawDirection = drawVert) and (ACoord = ARect.Right-1) and width3 then dec(ACoord); dec(ARect.Right); end; if ARow = RowCount-1 then begin if (ADrawDirection = drawHor) and (ACoord = ARect.Bottom-1) and width3 then dec(ACoord); dec(ARect.Bottom); end; end; if ABorderStyle.LineStyle in [lsMedium, lsThick] then begin if (ADrawDirection = drawHor) then dec(ARect.Right, 1) else if (ADrawDirection = drawVert) then dec(ARect.Bottom, 1); end; // Painting case ABorderStyle.LineStyle of lsThin, lsMedium, lsThick, lsDotted, lsDashed: case ADrawDirection of drawHor : Canvas.Line(ARect.Left, ACoord, ARect.Right, ACoord); drawVert : Canvas.Line(ACoord, ARect.Top, ACoord, ARect.Bottom); drawDiagUp : Canvas.Line(ARect.Left, ARect.Bottom, ARect.Right, ARect.Top); drawDiagDown: Canvas.Line(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom); end; lsHair: case ADrawDirection of drawHor : DrawHairLineHor(Canvas, ARect.Left, ARect.Right, ACoord); drawVert : DrawHairLineVert(Canvas, ACoord, ARect.Top, ARect.Bottom); drawDiagUp : ; drawDiagDown: ; end; lsDouble: case ADrawDirection of drawHor: begin Canvas.Line(ARect.Left, ACoord-1, ARect.Right, ACoord-1); Canvas.Line(ARect.Left, ACoord+1, ARect.Right, ACoord+1); Canvas.Pen.Color := Color; Canvas.Line(ARect.Left, ACoord, ARect.Right, ACoord); end; drawVert: begin Canvas.Line(ACoord-1, ARect.Top, ACoord-1, ARect.Bottom); Canvas.Line(ACoord+1, ARect.Top, ACoord+1, ARect.Bottom); Canvas.Pen.Color := Color; Canvas.Line(ACoord, ARect.Top, ACoord, ARect.Bottom); end; drawDiagUp: begin if ARect.Right = ARect.Left then angle := pi/2 else angle := arctan((ARect.Bottom-ARect.Top) / (ARect.Right-ARect.Left)); deltax := Max(1, round(1.0 / sin(angle))); deltay := Max(1, round(1.0 / cos(angle))); Canvas.Line(ARect.Left, ARect.Bottom-deltay-1, ARect.Right-deltax, ARect.Top-1); Canvas.Line(ARect.Left+deltax, ARect.Bottom-1, ARect.Right, ARect.Top+deltay-1); end; drawDiagDown: begin if ARect.Right = ARect.Left then angle := pi/2 else angle := arctan((ARect.Bottom-ARect.Top) / (ARect.Right-ARect.Left)); deltax := Max(1, round(1.0 / sin(angle))); deltay := Max(1, round(1.0 / cos(angle))); Canvas.Line(ARect.Left, ARect.Top+deltay-1, ARect.Right-deltax, ARect.Bottom-1); Canvas.Line(ARect.Left+deltax, ARect.Top-1, ARect.Right, ARect.Bottom-deltay-1); end; end; end; end; var bs: TsCellBorderStyle; fmt: PsCellFormat; begin if Assigned(Worksheet) then begin // Left border if GetBorderStyle(ACol, ARow, -1, 0, ACell, bs) then DrawBorderLine(ARect.Left-1, ARect, drawVert, bs); // Right border if GetBorderStyle(ACol, ARow, +1, 0, ACell, bs) then DrawBorderLine(ARect.Right-1, ARect, drawVert, bs); // Top border if GetBorderstyle(ACol, ARow, 0, -1, ACell, bs) then DrawBorderLine(ARect.Top-1, ARect, drawHor, bs); // Bottom border if GetBorderStyle(ACol, ARow, 0, +1, ACell, bs) then DrawBorderLine(ARect.Bottom-1, ARect, drawHor, bs); if ACell <> nil then begin fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); // Diagonal up if cbDiagUp in fmt^.Border then begin bs := fmt^.Borderstyles[cbDiagUp]; DrawBorderLine(0, ARect, drawDiagUp, bs); end; // Diagonal down if cbDiagDown in fmt^.Border then begin bs := fmt^.BorderStyles[cbDiagDown]; DrawborderLine(0, ARect, drawDiagDown, bs); end; end; end; end; {@@ ---------------------------------------------------------------------------- Method inherited method from TCustomGrid. Is overridden here to avoid painting of the border of frozen cells in black under some circumstances. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawCellGrid(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); begin if (TitleStyle <> tsNative) and (gdFixed in AState) and {DisplayFixedColRow and} ((FFrozenCols > 0) or (FFrozenRows > 0)) then begin // Draw default cell borders only in the header cols/rows. // If there are frozen cells they would get a black border, so we don't // draw their borders here - they are drawn by "DrawRow" anyway. if ((ACol=0) or (ARow = 0)) and DisplayFixedColRow then inherited; end else inherited; end; {@@ ---------------------------------------------------------------------------- Draws the red rectangle in the upper right corner of a cell to indicate that this cell contains a popup comment -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawCommentMarker(ARect: TRect); const COMMENT_SIZE = 7; var P: Array[0..3] of TPoint; begin Canvas.Brush.Color := clRed; Canvas.Brush.Style := bsSolid; Canvas.Pen.Style := psClear; P[0] := Point(ARect.Right, ARect.Top); P[1] := Point(ARect.Right - COMMENT_SIZE, ARect.Top); P[2] := Point(ARect.Right, ARect.Top + COMMENT_SIZE); P[3] := P[0]; Canvas.Polygon(P); end; {@@ ---------------------------------------------------------------------------- This procedure is responsible for painting the focus rectangle. We don't want the red dashed rectangle here, but prefer the thick Excel-like black border line. This new focus rectangle is drawn by the method DrawSelection because the thick Excel border reaches into adjacent cells. @param ACol Grid column index of the focused cell @param ARow Grid row index of the focused cell @param ARect Rectangle in pixels covered by the focused cell -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawFocusRect(aCol, aRow: Integer; ARect: TRect); begin Unused(ACol, ARow, ARect); // Nothing do to end; {@@ ---------------------------------------------------------------------------- Draws a solid line along the borders of frozen panes. @param ARect This rectangle indicates the area containing scrollable cells. If the grid has frozen panes, a black line is drawn along the upper and/or left edge of this rectangle (depending on the value of FrozenRows and FrozenCols). -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawFrozenPaneBorders(ARect: TRect); begin if WorkSheet = nil then exit; if (soHasFrozenPanes in Worksheet.Options) then begin Canvas.Pen.Style := psSolid; Canvas.Pen.Color := clBlack; Canvas.Pen.Width := 1; if FFrozenRows > 0 then Canvas.Line(ARect.Left, ARect.Top, ARect.Right, ARect.Top); if FFrozenCols > 0 then Canvas.Line(ARect.Left, ARect.Top, ARect.Left, ARect.Bottom); end; end; {@@ ---------------------------------------------------------------------------- Draws a complete row of cells. Is mostly duplicated from Grids.pas, but adds code for merged cells and overflow text, the section on drawing the default focus rectangle is removed. @param ARow Index of the row to be drawn (index in grid coordinates) -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawRow(ARow: Integer); var gds: TGridDrawState; sr, sr1,sc1,sr2,sc2: Cardinal; // sheet row/column gr, gc, gcNext, gcLast, gc1, gc2, gcLastUsed: Integer; // grid row/column i: Integer; rct, saved_rct, temp_rct, commentcell_rct: TRect; clipArea: Trect; cell: PCell; fmt: PsCellFormat; tmp: Integer = 0; function IsPushCellActive: boolean; begin with GCache do result := (PushedCell.X <> -1) and (PushedCell.Y <> -1); end; function VerticalIntersect(const aRect,bRect: TRect): boolean; begin result := (aRect.Top < bRect.Bottom) and (aRect.Bottom > bRect.Top); end; function HorizontalIntersect(const aRect,bRect: TRect): boolean; begin result := (aRect.Left < bRect.Right) and (aRect.Right > bRect.Left); end; procedure DoDrawCell(_col, _row: Integer; _clipRect, _cellRect: TRect); var Rgn: HRGN; begin with GCache do begin if (_col = HotCell.x) and (_row = HotCell.y) and not IsPushCellActive() then begin Include(gds, gdHot); HotCellPainted := True; end; if ClickCellPushed and (_col = PushedCell.x) and (_row = PushedCell.y) then begin Include(gds, gdPushed); end; end; Canvas.SaveHandleState; try Rgn := CreateRectRgn(_clipRect.Left, _clipRect.Top, _clipRect.Right, _clipRect.Bottom); SelectClipRgn(Canvas.Handle, Rgn); DrawCell(_col, _row, _cellRect, gds); DeleteObject(Rgn); finally Canvas.RestoreHandleState; end; end; begin // Upper and Lower bounds for this row rct := Rect(0, 0, 0, 0); ColRowToOffSet(False, True, ARow, rct.Top, rct.Bottom); saved_rct := rct; // is this row within the ClipRect? clipArea := Canvas.ClipRect; if (rct.Top >= rct.Bottom) or not VerticalIntersect(rct, clipArea) then begin {$IFDEF DbgVisualChange} DebugLn('Drawrow: Skipped row: ', IntToStr(aRow)); {$ENDIF} exit; end; sr := GetWorksheetRow(ARow); // Draw columns in this row with GCache.VisibleGrid do begin gc := Left; // Because of possible cell overflow from cells left of the visible range // we have to seek to the left for the first occupied text cell // and start painting from here. if FTextOverflow and (sr <> Cardinal(-1)) and Assigned(Worksheet) then while (gc > FixedCols) do begin dec(gc); cell := Worksheet.FindCell(sr, GetWorksheetCol(gc)); // Empty cell --> proceed with next cell to the left if (cell = nil) or (cell^.ContentType = cctEmpty) or ((cell^.ContentType = cctUTF8String) and (cell^.UTF8StringValue = '')) then Continue; // Overflow possible from non-merged, non-right-aligned, horizontal label cells fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex); if (not Worksheet.IsMerged(cell)) and (cell^.ContentType = cctUTF8String) and not (uffTextRotation in fmt^.UsedFormattingFields) and (uffHorAlign in fmt^.UsedFormattingFields) and (fmt^.HorAlignment <> haRight) then Break; // All other cases --> no overflow --> return to initial left cell gc := Left; break; end; // Now find the last column. Again text can overflow into the visible area // from cells to the right. gcLast := Right; if FTextOverflow and (sr <> Cardinal(-1)) and Assigned(Worksheet) then begin gcLastUsed := GetGridCol(Worksheet.GetLastOccupiedColIndex); while (gcLast < ColCount-1) and (gcLast < gcLastUsed) do begin inc(gcLast); cell := Worksheet.FindCell(sr, GetWorksheetCol(gcLast)); // Empty cell --> proceed with next cell to the right if (cell = nil) or (cell^.ContentType = cctEmpty) or ((cell^.ContentType = cctUTF8String) and (cell^.UTF8StringValue = '')) then continue; // Overflow possible from non-merged, horizontal, non-left-aligned label cells fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex); if (not Worksheet.IsMerged(cell)) and (cell^.ContentType = cctUTF8String) and not (uffTextRotation in fmt^.UsedFormattingFields) and (uffHorAlign in fmt^.UsedFormattingFields) and (fmt^.HorAlignment <> haLeft) then Break; // All other cases --> no overflow --> return to initial right column gcLast := Right; Break; end; end; // Here begins the drawing loop of all cells in the row while (gc <= gcLast) do begin gr := ARow; rct := saved_rct; // FDrawingCell is the cell which is currently being painted. We store // it to avoid excessive calls to "FindCell". FDrawingCell := nil; gcNext := gc + 1; if Assigned(Worksheet) and (gr >= FixedRows) and (gc >= FixedCols) then begin cell := Worksheet.FindCell(GetWorksheetRow(gr), GetWorksheetCol(gc)); if (cell = nil) or (not Worksheet.IsMerged(cell)) then begin // single cell FDrawingCell := cell; if Worksheet.HasComment(cell) then commentcell_rct := CellRect(gc, gr) else commentcell_rct := Rect(0,0,0,0); // Special treatment of overflowing cells if FTextOverflow then begin gds := GetGridDrawState(gc, gr); ColRowToOffset(true, true, gc, rct.Left, rct.Right); if CellOverflow(gc, gr, gds, gc1, gc2, rct) then begin // Draw individual cells of the overflown range ColRowToOffset(true, true, gc1, rct.Left, tmp); // rct is the clip rect ColRowToOffset(true, true, gc2, tmp, rct.Right); FDrawingCell := nil; temp_rct := rct; for i := gc1 to gc2 do begin ColRowToOffset(true, true, i, temp_rct.Left, temp_rct.Right); if HorizontalIntersect(temp_rct, clipArea) and (i <> gc) then begin gds := GetGridDrawState(i, gr); DoDrawCell(i, gr, rct, temp_rct); end; end; // Repaint the base cell text (it was partly overwritten before) FDrawingCell := cell; FTextOverflowing := true; ColRowToOffset(true, true, gc, temp_rct.Left, temp_rct.Right); if HorizontalIntersect(temp_rct, clipArea) then begin gds := GetGridDrawState(gc, gr); DoDrawCell(gc, gr, rct, temp_rct); if Worksheet.HasComment(FDrawingCell) then DrawCommentMarker(temp_rct); end; FTextOverflowing := false; gcNext := gc2 + 1; gc := gcNext; continue; end; end; end else begin // merged cells FDrawingCell := Worksheet.FindMergeBase(cell); Worksheet.FindMergedRange(FDrawingCell, sr1, sc1, sr2, sc2); gr := GetGridRow(sr1); if Worksheet.HasComment(FDrawingCell) then commentcell_rct := CellRect(GetGridCol(sc2), gr) else commentcell_rct := Rect(0,0,0,0); ColRowToOffSet(False, True, gr, rct.Top, tmp); ColRowToOffSet(False, True, gr + integer(sr2) - integer(sr1), tmp, rct.Bottom); gc := GetGridCol(sc1); gcNext := gc + (sc2 - sc1) + 1; end; end; ColRowToOffset(true, true, gc, rct.Left, tmp); ColRowToOffset(true, true, gcNext-1, tmp, rct.Right); if (rct.Left < rct.Right) and HorizontalIntersect(rct, clipArea) then begin gds := GetGridDrawState(gc, gr); DoDrawCell(gc, gr, rct, rct); // Draw comment marker if (commentcell_rct.Left <> 0) and (commentcell_rct.Right <> 0) and (commentcell_rct.Top <> 0) and (commentcell_rct.Bottom <> 0) then DrawCommentMarker(commentcell_rct); end; gc := gcNext; end; end; // with GCache.VisibleGrid ... // Draw fixed columns gr := ARow; for gc := 0 to FixedCols-1 do begin gds := [gdFixed]; ColRowToOffset(True, True, gc, rct.Left, rct.Right); // is this column within the ClipRect? if (rct.Left < rct.Right) and HorizontalIntersect(rct, clipArea) then begin if Assigned(Worksheet) then FDrawingCell := Worksheet.FindCell(GetWorksheetRow(gr), GetWorksheetCol(gc)) else FDrawingCell := nil; DoDrawCell(gc, gr, rct, rct); end; end; end; {@@ ---------------------------------------------------------------------------- Draws the selection rectangle around selected cells, 3 pixels wide as in Excel. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawSelection; var P1, P2: TPoint; cell: PCell; r1,c1,r2,c2: Cardinal; begin // Selected cell cell := Worksheet.FindCell(GetWorksheetRow(Selection.Top), GetWorksheetCol(Selection.Left)); if Worksheet.IsMerged(cell) then begin Worksheet.FindMergedRange(cell, r1,c1,r2,c2); P1 := CellRect(GetGridCol(c1), GetGridRow(r1)).TopLeft; P2 := CellRect(GetGridCol(c2), GetGridRow(r2)).BottomRight; end else begin P1 := CellRect(Selection.Left, Selection.Top).TopLeft; P2 := CellRect(Selection.Right, Selection.Bottom).BottomRight; end; // Cosmetics at the edges of the grid to avoid spurious rests if Selection.Top > TopRow then dec(P1.Y) else inc(P1.Y); if Selection.Left > LeftCol then dec(P1.X) else inc(P1.X); if Selection.Right = ColCount-1 then dec(P2.X); if Selection.Bottom = RowCount-1 then dec(P2.Y); // Set up the canvas Canvas.Pen.Style := psSolid; Canvas.Pen.Width := 3; Canvas.Pen.JoinStyle := pjsMiter; if UseXORFeatures then begin Canvas.Pen.Color := clWhite; Canvas.Pen.Mode := pmXOR; end else Canvas.Pen.Color := clBlack; Canvas.Brush.Style := bsClear; // Paint Canvas.Rectangle(P1.X, P1.Y, P2.X, P2.Y); end; {@@ ---------------------------------------------------------------------------- Draws the cell text. Calls "GetCellText" to determine the text for the cell. Takes care of horizontal and vertical text alignment, text rotation and text wrapping. @param ACol Grid column index of the cell @param ARow Grid row index of the cell @param ARect Rectangle in pixels occupied by the cell @param AState Drawing state of the grid -- see TCustomGrid -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.DrawTextInCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); var ts: TTextStyle; txt: String; wrapped: Boolean; horAlign: TsHorAlignment; vertAlign: TsVertAlignment; txtRot: TsTextRotation; lCell: PCell; justif: Byte; fmt: PsCellFormat; begin if (Worksheet = nil) then exit; if (ACol < FHeaderCount) or (ARow < FHeaderCount) then lCell := nil else lCell := FDrawingCell; // Header if lCell = nil then begin if ShowHeaders and ((ACol = 0) or (ARow = 0)) then begin ts.Alignment := taCenter; ts.Layout := tlCenter; ts.Opaque := false; Canvas.TextStyle := ts; end; inherited DrawCellText(aCol, aRow, aRect, aState, GetCellText(ACol,ARow)); exit; end; // Cells fmt := Workbook.GetPointerToCellFormat(lCell^.FormatIndex); wrapped := (uffWordWrap in fmt^.UsedFormattingFields) or (fmt^.TextRotation = rtStacked); txtRot := fmt^.TextRotation; vertAlign := fmt^.VertAlignment; if vertAlign = vaDefault then vertAlign := vaBottom; if fmt^.HorAlignment <> haDefault then horAlign := fmt^.HorAlignment else begin if (lCell^.ContentType in [cctNumber, cctDateTime]) then horAlign := haRight else horAlign := haLeft; end; InflateRect(ARect, -constCellPadding, -constCellPadding); // txt := GetCellText(ACol, ARow); txt := GetCellText(GetGridRow(lCell^.Col), GetGridCol(lCell^.Row)); if txt = '' then exit; case txtRot of trHorizontal: case horAlign of haLeft : justif := 0; haCenter : justif := 1; haRight : justif := 2; end; rtStacked, rt90DegreeClockwiseRotation: case vertAlign of vaTop : justif := 0; vaCenter: justif := 1; vaBottom: justif := 2; end; rt90DegreeCounterClockwiseRotation: case vertAlign of vaTop : justif := 2; vaCenter: justif := 1; vaBottom: justif := 0; end; end; InternalDrawTextInCell(txt, txt, ARect, justif, horAlign, vertAlign, txtRot, wrapped, false); end; {@@ ---------------------------------------------------------------------------- This procedure is called when editing of a cell is completed. It determines the worksheet cell and writes the text into the worksheet. Tries to keep the format of the cell, but if it is a new cell, or the content type has changed, tries to figure out the content type (number, date/time, text). -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.EditingDone; var oldText: String; cell: PCell; begin if (not EditorShowing) and FEditing then begin oldText := GetCellText(Col, Row); if oldText <> FEditText then begin cell := Worksheet.GetCell(GetWorksheetRow(Row), GetWorksheetCol(Col)); if Worksheet.IsMerged(cell) then cell := Worksheet.FindMergeBase(cell); if (FEditText <> '') and (FEditText[1] = '=') then Worksheet.WriteFormula(cell, Copy(FEditText, 2, Length(FEditText)), true) else Worksheet.WriteCellValueAsString(cell, FEditText); FEditText := ''; end; inherited EditingDone; end; FEditing := false; FEnhEditMode := false; end; {@@ ---------------------------------------------------------------------------- The BeginUpdate/EndUpdate pair suppresses unnecessary painting of the grid. Call BeginUpdate to stop refreshing the grid, and call EndUpdate to release the lock and to repaint the grid again. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.EndUpdate; begin dec(FLockCount); if FLockCount = 0 then Invalidate; end; {@@ ---------------------------------------------------------------------------- Executes a hyperlink stored in the FHyperlinkCell -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.ExecuteHyperlink; var hyperlink: TsHyperlink; target, bookmark: String; sheetname: String; sheet: TsWorksheet; r, c: Cardinal; begin if FHyperlinkCell = nil then exit; hyperlink := Worksheet.ReadHyperlink(FHyperlinkCell); SplitHyperlink(hyperlink.Target, target, bookmark); if target = '' then begin // Goes to a cell within the current workbook if ParseSheetCellString(bookmark, sheetname, r, c) then begin if sheetname <> '' then begin sheet := Workbook.GetWorksheetByName(sheetname); if sheet = nil then raise Exception.CreateFmt(rsWorksheetNotFound, [sheetname]); Workbook.SelectWorksheet(sheet); end; Worksheet.SelectCell(r, c); end else raise Exception.CreateFmt(rsNoValidHyperlinkInternal, [hyperlink.Target]); end else // Fires the OnClickHyperlink event which should open a file or a URL if Assigned(FOnClickHyperlink) then FOnClickHyperlink(self, hyperlink); end; {@@ ---------------------------------------------------------------------------- Copies the borders of a cell to its neighbors. This avoids the nightmare of changing borders due to border conflicts of adjacent cells. @param ACell Pointer to the cell -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.FixNeighborCellBorders(ACell: PCell); //Col, ARow: Integer); procedure SetNeighborBorder(NewRow, NewCol: Cardinal; ANewBorder: TsCellBorder; const ANewBorderStyle: TsCellBorderStyle; AInclude: Boolean); var neighbor: PCell; border: TsCellBorders; begin neighbor := Worksheet.FindCell(NewRow, NewCol); if neighbor <> nil then begin border := Worksheet.ReadCelLBorders(neighbor); if AInclude then begin Include(border, ANewBorder); Worksheet.WriteBorderStyle(NewRow, NewCol, ANewBorder, ANewBorderStyle); end else Exclude(border, ANewBorder); Worksheet.WriteBorders(NewRow, NewCol, border); end; end; var fmt: PsCellFormat; begin if Worksheet = nil then exit; // cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); if (Worksheet <> nil) and (ACell <> nil) then with ACell^ do begin fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); SetNeighborBorder(Row, Col-1, cbEast, fmt^.BorderStyles[cbWest], cbWest in fmt^.Border); SetNeighborBorder(Row, Col+1, cbWest, fmt^.BorderStyles[cbEast], cbEast in fmt^.Border); SetNeighborBorder(Row-1, Col, cbSouth, fmt^.BorderStyles[cbNorth], cbNorth in fmt^.Border); SetNeighborBorder(Row+1, Col, cbNorth, fmt^.BorderStyles[cbSouth], cbSouth in fmt^.Border); end; end; {@@ ---------------------------------------------------------------------------- The "colors" used by the spreadsheet are indexes into the workbook's color palette. If the user wants to set a color to a particular RGB value this is not possible in general. The method FindNearestPaletteIndex finds the bast matching color in the palette. @param AColor Color index into the workbook's palette -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.FindNearestPaletteIndex(AColor: TColor): TsColor; begin Result := fpsVisualUtils.FindNearestPaletteIndex(Workbook, AColor); end; (* {@@ ---------------------------------------------------------------------------- Notification by the workbook link that a cell has been modified. --> Repaint. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.CellChanged(ACell: PCell); begin Unused(ACell); Invalidate; end; {@@ ---------------------------------------------------------------------------- Notification by the workbook link that another cell has been selected --> select the cell in the grid -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.CellSelected(ASheetRow, ASheetCol: Cardinal); var grow, gcol: Integer; begin if (FWorkbookLink <> nil) then begin grow := GetGridRow(ASheetRow); gcol := GetGridCol(ASheetCol); if (grow <> Row) or (gcol <> Col) then begin Row := grow; Col := gcol; end; end; end; {@@ ---------------------------------------------------------------------------- Notification by the workbook link that a new workbook is available. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.WorkbookChanged; begin WorksheetChanged; end; {@@ ---------------------------------------------------------------------------- Notification by the workbook link that a new worksheet has been selected from the current workbook. Is also called internally from WorkbookChanged. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.WorksheetChanged; begin if Worksheet <> nil then begin //Worksheet.OnChangeCell := @ChangedCellHandler; //Worksheet.OnChangeFont := @ChangedFontHandler; ShowHeaders := (soShowHeaders in Worksheet.Options); ShowGridLines := (soShowGridLines in Worksheet.Options); if (soHasFrozenPanes in Worksheet.Options) then begin FrozenCols := Worksheet.LeftPaneWidth; FrozenRows := Worksheet.TopPaneHeight; end else begin FrozenCols := 0; FrozenRows := 0; end; Row := FrozenRows; Col := FrozenCols; end; Setup; end; *) {@@ ---------------------------------------------------------------------------- Returns the background color of a cell. The color is given as an index into the workbook's color palette. @param ACol Grid column index of the cell @param ARow Grid row index of the cell @result Color index of the cell's background color. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetBackgroundColor(ACol, ARow: Integer): TsColor; var cell: PCell; begin Result := scNotDefined; if Assigned(Worksheet) then begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Result := Worksheet.ReadBackgroundColor(cell); end; end; {@@ ---------------------------------------------------------------------------- Returns the background color of a cell range defined by a rectangle. The color is given as an index into the workbook's color palette. If the colors are different from cell to cell the value scUndefined is returned. @param ARect Cell range defined as a rectangle: Left/Top refers to the cell in the left/top corner of the selection, Right/Bottom to the right/bottom corner. @return Color index common to all cells within the selection. If the cells' background colors are different the value scUndefined is returned. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetBackgroundColors(ARect: TGridRect): TsColor; var c, r: Integer; clr: TsColor; begin Result := GetBackgroundColor(ARect.Left, ARect.Top); clr := Result; for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin Result := GetBackgroundColor(c, r); if Result <> clr then begin Result := scNotDefined; exit; end; end; end; {@@ ---------------------------------------------------------------------------- Returns the cell borders which are drawn around a given cell. @param ACol Grid column index of the cell @param ARow Grid row index of the cell @return Set with flags indicating where borders are drawn (top/left/right/bottom) -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellBorder(ACol, ARow: Integer): TsCellBorders; var cell: PCell; begin Result := []; if Assigned(Worksheet) then begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Result := Worksheet.ReadCellBorders(cell); end; end; {@@ ---------------------------------------------------------------------------- Returns the cell borders which are drawn around a given rectangular cell range. @param ARect Rectangle defining the range of cell. @return Set with flags indicating where borders are drawn (top/left/right/bottom) If the individual cells within the range have different borders an empty set is returned. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellBorders(ARect: TGridRect): TsCellBorders; var c, r: Integer; b: TsCellBorders; begin Result := GetCellBorder(ARect.Left, ARect.Top); b := Result; for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin Result := GetCellBorder(c, r); if Result <> b then begin Result := []; exit; end; end; end; {@@ ---------------------------------------------------------------------------- Returns the style of the cell border line drawn along the edge specified by the parameter ABorder of a cell. The style is defined by line style and line color. @param ACol Grid column index of the cell @param ARow Grid row index of the cell @param ABorder Identifier of the border at which the line will be drawn (see TsCellBorder) @return CellBorderStyle record containing information on line style and line color. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder): TsCellBorderStyle; var cell: PCell; begin Result := DEFAULT_BORDERSTYLES[ABorder]; if Assigned(Worksheet) then begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Result := Worksheet.ReadCellBorderStyle(cell, ABorder); end; end; {@@ ---------------------------------------------------------------------------- Returns the style of the cell border line drawn along the edge specified by the parameter ABorder of a range of cells defined by the rectangle of column and row indexes. The style is defined by linestyle and line color. @param ARect Rectangle whose edges define the limits of the grid row and column indexes of the cells. @param ABorder Identifier of the border where the line will be drawn (see TsCellBorder) @return CellBorderStyle record containing information on line style and line color. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellBorderStyles(ARect: TGridRect; ABorder: TsCellBorder): TsCellBorderStyle; var c, r: Integer; bs: TsCellBorderStyle; begin Result := GetCellBorderStyle(ARect.Left, ARect.Top, ABorder); bs := Result; for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin Result := GetCellBorderStyle(c, r, ABorder); if (Result.LineStyle <> bs.LineStyle) or (Result.Color <> bs.Color) then begin Result := DEFAULT_BORDERSTYLES[ABorder]; exit; end; end; end; {@@ ---------------------------------------------------------------------------- Returns the font to be used when painting text in a cell. @param ACol Grid column index of the cell @param ARow Grid row index of the cell @return Font usable when painting on a canvas. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellFont(ACol, ARow: Integer): TFont; var cell: PCell; fnt: TsFont; begin Result := nil; if (Workbook <> nil) then begin fnt := Workbook.GetDefaultFont; if (Worksheet <> nil) then begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); fnt := Worksheet.ReadCellFont(cell); end; Convert_sFont_to_Font(fnt, FCellFont); Result := FCellFont; end; { if (Workbook <> nil) and (Worksheet <> nil) then begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); if (cell <> nil) then begin if (uffBold in cell^.UsedFormattingFields) then fnt := Workbook.GetFont(1) else if (uffFont in cell^.UsedFormattingFields) then fnt := Workbook.GetFont(cell^.FontIndex) else fnt := Workbook.GetDefaultFont; Convert_sFont_to_Font(fnt, FCellFont); Result := FCellFont; end; end; if Result = nil then begin fnt := Workbook.GetDefaultFont; Convert_sFont_to_Font(fnt, FCellFont); Result := FCellFont; end; } end; {@@ ---------------------------------------------------------------------------- Returns the font to be used when painting text in the cells defined by the rectangle of row/column indexes. @param ARect Rectangle whose edges define the limits of the grid row and column indexes of the cells. @return Font usable when painting on a canvas. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellFonts(ARect: TGridRect): TFont; var // c, r: Integer; r1,c1,r2,c2: Cardinal; sFont, sDefFont: TsFont; cell: PCell; begin Result := GetCellFont(ARect.Left, ARect.Top); sDefFont := Workbook.GetDefaultFont; // Default font r1 := GetWorksheetRow(ARect.Top); c1 := GetWorksheetCol(ARect.Left); r2 := GetWorksheetRow(ARect.Bottom); c2 := GetWorksheetRow(ARect.Right); for cell in Worksheet.Cells.GetRangeEnumerator(r1, c1, r2, c2) do begin sFont := Worksheet.ReadCellFont(cell); if (sFont.FontName <> sDefFont.FontName) and (sFont.Size <> sDefFont.Size) and (sFont.Style <> sDefFont.Style) and (sFont.Color <> sDefFont.Color) then begin Convert_sFont_to_Font(sDefFont, FCellFont); Result := FCellFont; exit; end; end; { for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin cell := Worksheet.FindCell(GetWorksheetRow(r), GetWorksheetCol(c)); if cell <> nil then begin sFont := Worksheet.ReadCellFont(cell); if (sFont.FontName <> sDefFont.FontName) and (sFont.Size <> sDefFont.Size) and (sFont.Style <> sDefFont.Style) and (sFont.Color <> sDefFont.Color) then begin Convert_sFont_to_Font(sDefFont, FCellFont); Result := FCellFont; exit; end; end; end; } end; {@@ ---------------------------------------------------------------------------- Returns the height (in pixels) of the cell at ACol/ARow (of the grid). @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. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellHeight(ACol, ARow: Integer): Integer; var lCell: PCell; s: String; wrapped: Boolean; txtR: TRect; cellR: TRect; flags: Cardinal; r1,c1,r2,c2: Cardinal; fmt: PsCellFormat; begin Result := 0; if ShowHeaders and ((ACol = 0) or (ARow = 0)) then exit; if Worksheet = nil then exit; lCell := Worksheet.FindCell(ARow-FHeaderCount, ACol-FHeaderCount); if lCell <> nil then begin if Worksheet.IsMerged(lCell) then begin Worksheet.FindMergedRange(lCell, r1, c1, r2, c2); if r1 <> r2 then // If the merged range encloses several rows we skip automatic row height // determination since only the height of the first row of the block // (containing the merge base cell) would change which is very confusing. exit; end; s := GetCellText(ACol, ARow); if s = '' then exit; DoPrepareCanvas(ACol, ARow, []); fmt := Workbook.GetPointerToCellFormat(lCell^.FormatIndex); wrapped := (uffWordWrap in fmt^.UsedFormattingFields) or (fmt^.TextRotation = rtStacked); // *** multi-line text *** if wrapped then begin // horizontal if ( (uffTextRotation in fmt^.UsedFormattingFields) and (fmt^.TextRotation in [trHorizontal, rtStacked])) or not (uffTextRotation in fmt^.UsedFormattingFields) then begin cellR := CellRect(ACol, ARow); InflateRect(cellR, -constCellPadding, -constCellPadding); txtR := Bounds(cellR.Left, cellR.Top, cellR.Right-cellR.Left, cellR.Bottom-cellR.Top); flags := DT_WORDBREAK and not DT_SINGLELINE; LCLIntf.DrawText(Canvas.Handle, PChar(s), Length(s), txtR, DT_CALCRECT or flags); Result := txtR.Bottom - txtR.Top + 2*constCellPadding; end; // rotated wrapped text: // do not consider this because wrapping affects cell height. end else // *** single-line text *** begin // not rotated if ( not (uffTextRotation in fmt^.UsedFormattingFields) or (fmt^.TextRotation = trHorizontal) ) then Result := Canvas.TextHeight(s) + 2*constCellPadding else // rotated by +/- 90° if (uffTextRotation in fmt^.UsedFormattingFields) and (fmt^.TextRotation in [rt90DegreeClockwiseRotation, rt90DegreeCounterClockwiseRotation]) then Result := Canvas.TextWidth(s) + 2*constCellPadding; end; end; end; {@@ ---------------------------------------------------------------------------- This function defines the text to be displayed as a cell hint. By default, it is the comment and/or the hyperlink attached to a cell; it can further be modified by using the OnGetCellHint event. Option goCellHints must be active for the cell hint feature to work. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellHintText(ACol, ARow: Integer): String; var cell: PCell; hyperlink: PsHyperlink; comment: String; begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); if cell = nil then Result := '' else begin // Read comment comment := Worksheet.ReadComment(cell); // Read hyperlink info if Worksheet.HasHyperlink(cell) then begin hyperlink := Worksheet.FindHyperlink(cell); if hyperlink <> nil then begin if hyperlink^.ToolTip <> '' then Result := hyperlink^.ToolTip else Result := Format('Hyperlink: %s' + LineEnding + rsStdHyperlinkTooltip, [hyperlink^.Target] ); end; end; // Combine comment and hyperlink if (Result <> '') and (comment <> '') then Result := comment + LineEnding + LineEnding + Result else if (Result = '') and (comment <> '') then Result := comment; end; if Assigned(OnGetCellHint) then OnGetCellHint(self, ACol, ARow, Result); end; {@@ ---------------------------------------------------------------------------- This function returns the text to be shown in a grid cell. The text is looked up in the corresponding cell of the worksheet by calling its ReadAsUTF8Text method. In case of "stacked" text rotation, line endings are inserted after each character. @param ACol Grid column index of the cell @param ARow Grid row index of the cell @return Text to be displayed in the cell. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetCellText(ACol, ARow: Integer): String; var cell: PCell; r, c, i: Integer; s: String; begin Result := ''; if ShowHeaders then begin // Headers if (ARow = 0) and (ACol = 0) then exit; if (ARow = 0) then begin Result := GetColString(ACol - FHeaderCount); exit; end else if (ACol = 0) then begin Result := IntToStr(ARow); exit; end; end; if Worksheet <> nil then begin r := ARow - FHeaderCount; c := ACol - FHeaderCount; cell := Worksheet.FindCell(r, c); if cell <> nil then begin Result := TrimToCell(cell); if Worksheet.ReadTextRotation(cell) = rtStacked then begin s := Result; Result := ''; for i:=1 to Length(s) do begin Result := Result + s[i]; if i < Length(s) then Result := Result + LineEnding; end; end; end; end; end; {@@ ---------------------------------------------------------------------------- Determines the text to be passed to the cell editor. The text is determined from the underlying worksheet cell, but it is possible to intercept this by adding a handler for the OnGetEditText event. @param ACol Grid column index of the cell being edited @param ARow Grid row index of the grid cell being edited @return Text to be passed to the cell editor. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetEditText(ACol, ARow: Integer): string; var cell: PCell; begin if FEnhEditMode then // Initiated by "F2" begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); if Worksheet.IsMerged(cell) then cell := Worksheet.FindMergeBase(cell); Result := Worksheet.ReadFormulaAsString(cell, true); if Result <> '' then begin if Result[1] <> '=' then Result := '=' + Result; end else if cell <> nil then case cell^.ContentType of cctNumber: Result := FloatToStr(cell^.NumberValue); cctDateTime: if cell^.DateTimeValue < 1.0 then Result := FormatDateTime('tt', cell^.DateTimeValue) else Result := FormatDateTime('c', cell^.DateTimeValue); else Result := Worksheet.ReadAsUTF8Text(cell); end else Result := ''; end else Result := GetCellText(aCol, aRow); if Assigned(OnGetEditText) then OnGetEditText(Self, aCol, aRow, Result); end; {@@ ---------------------------------------------------------------------------- Determines the style of the border between a cell and its neighbor given by ADeltaCol and ADeltaRow (one of them must be 0, the other one can only be +/-1). ACol and ARow are in grid units. Result is FALSE if there is no border line. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetBorderStyle(ACol, ARow, ADeltaCol, ADeltaRow: Integer; ACell: PCell; out ABorderStyle: TsCellBorderStyle): Boolean; var //cell, neighborcell: PCell; border, neighborborder: TsCellBorder; // r, c: Cardinal; begin Result := true; if (ADeltaCol = -1) and (ADeltaRow = 0) then begin border := cbWest; neighborborder := cbEast; end else if (ADeltaCol = +1) and (ADeltaRow = 0) then begin border := cbEast; neighborborder := cbWest; end else if (ADeltaCol = 0) and (ADeltaRow = -1) then begin border := cbNorth; neighborborder := cbSouth; end else if (ADeltaCol = 0) and (ADeltaRow = +1) then begin border := cbSouth; neighborBorder := cbNorth; end else raise Exception.Create('[TsCustomWorksheetGrid] Incorrect col/row for GetBorderStyle.'); // r := GetWorksheetRow(ARow); // c := GetWorksheetCol(ACol); //cell := Worksheet.FindCell(r, c); if (ARow - FHeaderCount + ADeltaRow < 0) or (ACol - FHeaderCount + ADeltaCol < 0) then neighborcell := nil else neighborcell := Worksheet.FindCell(ARow - FHeaderCount + ADeltaRow, ACol - FHeaderCount + ADeltaCol); // Only cell has border, but neighbor has not if HasBorder(ACell, border) and not HasBorder(neighborCell, neighborBorder) then begin if Worksheet.InSameMergedRange(ACell, neighborcell) then result := false else ABorderStyle := Worksheet.ReadCellBorderStyle(ACell, border) end else // Only neighbor has border, cell has not if not HasBorder(ACell, border) and HasBorder(neighborCell, neighborBorder) then begin if Worksheet.InSameMergedRange(ACell, neighborcell) then result := false else ABorderStyle := Worksheet.ReadCellBorderStyle(neighborcell, neighborborder); end else // Both cells have shared border -> use top or left border if HasBorder(ACell, border) and HasBorder(neighborCell, neighborBorder) then begin if Worksheet.InSameMergedRange(ACell, neighborcell) then result := false else if (border in [cbNorth, cbWest]) then ABorderStyle := Worksheet.ReadCellBorderStyle(neighborcell, neighborborder) else ABorderStyle := Worksheet.ReadCellBorderStyle(ACell, border); end else Result := false; end; {@@ ---------------------------------------------------------------------------- Converts a column index of the worksheet to a column index usable in the grid. This is required because worksheet indexes always start at zero while grid indexes also have to account for the column/row headers. @param ASheetCol Worksheet column index @return Grid column index -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetGridCol(ASheetCol: Cardinal): Integer; begin Result := Integer(ASheetCol) + FHeaderCount end; {@@ ---------------------------------------------------------------------------- Converts a row index of the worksheet to a row index usable in the grid. This is required because worksheet indexes always start at zero while grid indexes also have to account for the column/row headers. @param ASheetRow Worksheet row index @return Grid row index -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetGridRow(ASheetRow: Cardinal): Integer; begin Result := Integer(ASheetRow) + FHeaderCount; end; {@@ ---------------------------------------------------------------------------- Returns a list of worksheets contained in the file. Useful for assigning to user controls like TabControl, Combobox etc. in order to select a sheet. @param ASheets List of strings containing the names of the worksheets of the workbook -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.GetSheets(const ASheets: TStrings); var i: Integer; begin ASheets.Clear; if Assigned(Workbook) then for i:=0 to Workbook.GetWorksheetCount-1 do ASheets.Add(Workbook.GetWorksheetByIndex(i).Name); end; {@@ ---------------------------------------------------------------------------- Calculates the index of the worksheet column that is displayed in the given column of the grid. If the sheet headers are turned on, both numbers differ by 1, otherwise they are equal. Saves an "if" in cases. @param AGridCol Index of a grid column @return Index of a the corresponding worksheet column -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetWorksheetCol(AGridCol: Integer): cardinal; begin if (FHeaderCount > 0) and (AGridCol = 0) then Result := Cardinal(-1) else Result := AGridCol - FHeaderCount; end; {@@ ---------------------------------------------------------------------------- Calculates the index of the worksheet row that is displayed in the given row of the grid. If the sheet headers are turned on, both numbers differ by 1, otherwise they are equal. Saves an "if" in some cases. @param AGridRow Index of a grid row @resturn Index of the corresponding worksheet row. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.GetWorksheetRow(AGridRow: Integer): Cardinal; begin if (FHeaderCount > 0) and (AGridRow = 0) then Result := Cardinal(-1) else Result := AGridRow - FHeaderCount; end; {@@ ---------------------------------------------------------------------------- Returns true if the cell has the given border. @param ACell Pointer to cell considered @param ABorder Indicator for border to be checked for visibility -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.HasBorder(ACell: PCell; ABorder: TsCellBorder): Boolean; begin if Worksheet = nil then result := false else Result := ABorder in Worksheet.ReadCellBorders(ACell); end; {@@ ---------------------------------------------------------------------------- Inherited from TCustomGrid. Is called when column widths or row heights have changed. Stores the new column width or row height in the worksheet. @param IsColumn Specifies whether the changed parameter is a column width (true) or a row height (false) @param Index Index of the changed column or row -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.HeaderSized(IsColumn: Boolean; AIndex: Integer); var w0: Integer; h, h_pts: Single; begin if Worksheet = nil then exit; Convert_sFont_to_Font(Workbook.GetDefaultFont, Canvas.Font); if IsColumn then begin // The grid's column width is in "pixels", the worksheet's column width is // in "characters". w0 := Canvas.TextWidth('0'); Worksheet.WriteColWidth(GetWorksheetCol(AIndex), ColWidths[AIndex] / w0); end else begin // The grid's row heights are in "pixels", the worksheet's row heights are // in "lines" h_pts := PxToPts(RowHeights[AIndex] - 4, Screen.PixelsPerInch); // in points h := h_pts / (Workbook.GetFont(0).Size + ROW_HEIGHT_CORRECTION); Worksheet.WriteRowHeight(GetWorksheetRow(AIndex), h); end; end; {@@ ---------------------------------------------------------------------------- Clicking into cells with hyperlinks poses a user-interface problem: normally the cell should go into edit mode. But with hyperlinks a click should also execute the hyperlink. How to distinguish both cases? In order to keep both features for hyperlinks we follow a strategy similar to Excel: a short click selects the cell for editing as usual; a longer click opens the hyperlink by means of a timer ("FHyperlinkTimer") (in Excel, in fact, the behavior is opposite, but this one here is easier to implement.) -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.HyperlinkTimerElapsed(Sender: TObject); begin if FHyperlinkTimer.Enabled then begin FHyperlinkTimer.Enabled := false; FGridState := gsNormal; // this prevents selecting a cell block EditorMode := false; // this prevents editing the clicked cell ExecuteHyperlink; // Execute the hyperlink FHyperlinkCell := nil; end; end; {@@ ---------------------------------------------------------------------------- Inserts an empty column before the column specified -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.InsertCol(AGridCol: Integer); var c: Cardinal; begin if AGridCol < FHeaderCount then exit; if LongInt(Worksheet.GetLastColIndex) + 1 + FHeaderCount >= FInitColCount then ColCount := ColCount + 1; c := AGridCol - FHeaderCount; Worksheet.InsertCol(c); UpdateColWidths(AGridCol); end; {@@ ---------------------------------------------------------------------------- Inserts an empty row before the row specified -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.InsertRow(AGridRow: Integer); var r: Cardinal; begin if AGridRow < FHeaderCount then exit; if LongInt(Worksheet.GetlastRowIndex) + 1 + FHeaderCount >= FInitRowCount then RowCount := RowCount + 1; r := AGridRow - FHeaderCount; Worksheet.InsertRow(r); UpdateRowHeights(AGridRow); end; {@@ ---------------------------------------------------------------------------- Internal general text drawing method. @param AText Text to be drawn @param AMeasureText Text used for checking if the text fits into the text rectangle. If too large and ReplaceTooLong = true, a series of # is drawn. @param ARect Rectangle in which the text is drawn @param AJustification Determines whether the text is drawn at the "start" (0), "center" (1) or "end" (2) of the drawing rectangle. Start/center/end are seen along the text drawing direction. @param ACellHorAlign Is the HorAlignment property stored in the cell @param ACellVertAlign Is the VertAlignment property stored in the cell @param ATextRot Determines the rotation angle of the text. @param ATextWrap Determines if the text can wrap into multiple lines @param ReplaceTooLang If true too-long texts are replaced by a series of # chars filling the cell. @Note The reason to separate AJustification from ACellHorAlign and ACelVertAlign is the output of nfAccounting formatted numbers where the numbers are always right-aligned, and the currency symbol is left-aligned. THIS FEATURE IS CURRENTLY NO LONGER SUPPORTED. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.InternalDrawTextInCell(AText, AMeasureText: String; ARect: TRect; AJustification: Byte; ACellHorAlign: TsHorAlignment; ACellVertAlign: TsVertAlignment; ATextRot: TsTextRotation; ATextWrap, ReplaceTooLong: Boolean); var ts: TTextStyle; flags: Cardinal; txt: String; txtRect: TRect; P: TPoint; w, h, h0, hline: Integer; i: Integer; L: TStrings; wrapped: Boolean; pLeft: Integer = 0; pRight: Integer = 0; begin wrapped := ATextWrap or (ATextRot = rtStacked); if AMeasureText = '' then txt := AText else txt := AMeasureText; flags := DT_WORDBREAK and not DT_SINGLELINE or DT_CALCRECT; txtRect := ARect; if (ATextRot in [trHorizontal, rtStacked]) then begin // HORIZONAL TEXT DRAWING DIRECTION Canvas.Font.Orientation := 0; ts := Canvas.TextStyle; ts.Opaque := false; ts.Clipping := not FTextOverflowing; if wrapped then begin ts.Wordbreak := true; ts.SingleLine := false; LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags); w := txtRect.Right - txtRect.Left; h := txtRect.Bottom - txtRect.Top; end else begin ts.WordBreak := false; ts.SingleLine := false; w := Canvas.TextWidth(AMeasureText); h := Canvas.TextHeight('Tg'); end; if ATextRot = rtStacked then begin // Stacked ts.Alignment := HOR_ALIGNMENTS[ACellHorAlign]; if h > ARect.Bottom - ARect.Top then begin if ReplaceTooLong then begin txt := '#'; repeat txt := txt + '#'; LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags); until txtRect.Bottom - txtRect.Top > ARect.Bottom - ARect.Top; AText := copy(txt, 1, Length(txt)-1); end; ts.Layout := tlTop; end else case AJustification of 0: ts.Layout := tlTop; 1: ts.Layout := tlCenter; 2: ts.Layout := tlBottom; end; Canvas.TextStyle := ts; Canvas.TextRect(ARect, ARect.Left, ARect.Top, AText); end else begin // Horizontal if h > ARect.Bottom - ARect.Top then ts.Layout := tlTop else ts.Layout := VERT_ALIGNMENTS[ACellVertAlign]; // too long text if w > ARect.Right - ARect.Left then if ReplaceTooLong then begin txt := ''; repeat txt := txt + '#'; LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags); until txtRect.Right - txtRect.Left > ARect.Right - ARect.Left; AText := Copy(txt, 1, Length(txt)-1); w := Canvas.TextWidth(AText); end; P := ARect.TopLeft; case AJustification of 0: ts.Alignment := taLeftJustify; 1: if (FDrawingCell <> nil) and not Worksheet.IsMerged(FDrawingCell) then begin // Special treatment for overflowing cells: they must be centered // at their original column, not in the total enclosing rectangle. ColRowToOffset(true, true, integer(FDrawingCell^.Col) + FHeaderCount, pLeft, pRight); P.X := (pLeft + pRight - w) div 2; P.y := ARect.Top; ts.Alignment := taLeftJustify; end else ts.Alignment := taCenter; 2: ts.Alignment := taRightJustify; end; Canvas.TextStyle := ts; Canvas.TextRect(ARect, P.X, P.Y, AText); end; end else begin // ROTATED TEXT DRAWING DIRECTION // Since there is no good API for multiline rotated text, we draw the text // line by line. L := TStringList.Create; try txtRect := Bounds(ARect.Left, ARect.Top, ARect.Bottom - ARect.Top, ARect.Right - ARect.Left); hline := Canvas.TextHeight('Tg'); if wrapped then begin // Extract wrapped lines L.Text := WrapText(Canvas, txt, txtRect.Right - txtRect.Left); // Calculate size of wrapped text flags := DT_WORDBREAK and not DT_SINGLELINE or DT_CALCRECT; LCLIntf.DrawText(Canvas.Handle, PChar(L.Text), Length(L.Text), txtRect, flags); w := txtRect.Right - txtRect.Left; h := txtRect.Bottom - txtRect.Top; h0 := hline; end else begin L.Text := txt; w := Canvas.TextWidth(txt); h := hline; h0 := 0; end; // w and h are seen along the text direction, not x/y! if w > ARect.Bottom - ARect.Top then begin if ReplaceTooLong then begin txt := '#'; repeat txt := txt + '#'; until Canvas.TextWidth(txt) > ARect.Bottom - ARect.Top; L.Text := Copy(txt, 1, Length(txt)-1); end; end; ts := Canvas.TextStyle; ts.SingleLine := true; // Draw text line by line ts.Clipping := false; ts.Layout := tlTop; ts.Alignment := taLeftJustify; ts.Opaque := false; if ATextRot = rt90DegreeClockwiseRotation then begin // Clockwise Canvas.Font.Orientation := -900; case ACellHorAlign of haLeft : P.X := Min(ARect.Right-1, ARect.Left + h - h0); haCenter : P.X := Min(ARect.Right-1, (ARect.Left + ARect.Right + h) div 2); haRight : P.X := ARect.Right - 1; end; for i:= 0 to L.Count-1 do begin w := Canvas.TextWidth(L[i]); case AJustification of 0: P.Y := ARect.Top; // corresponds to "top" 1: P.Y := Max(ARect.Top, (Arect.Top + ARect.Bottom - w) div 2); // "center" 2: P.Y := Max(ARect.Top, ARect.Bottom - w); // "bottom" end; Canvas.TextRect(ARect, P.X, P.Y, L[i], ts); dec(P.X, hline); end end else begin // Counter-clockwise Canvas.Font.Orientation := +900; case ACellHorAlign of haLeft : P.X := ARect.Left; haCenter : P.X := Max(ARect.Left, (ARect.Left + ARect.Right - h + h0) div 2); haRight : P.X := MAx(ARect.Left, ARect.Right - h + h0); end; for i:= 0 to L.Count-1 do begin w := Canvas.TextWidth(L[i]); case AJustification of 0: P.Y := ARect.Bottom; // like "Bottom" 1: P.Y := Min(ARect.Bottom, (ARect.Top + ARect.Bottom + w) div 2); // "Center" 2: P.Y := Min(ARect.Bottom, ARect.Top + w); // like "top" end; Canvas.TextRect(ARect, P.X, P.Y, L[i], ts); inc(P.X, hline); end; end; finally L.Free; end; end; end; {@@ ---------------------------------------------------------------------------- Standard key handling method inherited from TCustomGrid. Is overridden to catch the ESC key during editing in order to restore the old cell text @param Key Key which has been pressed @param Shift Additional shift keys which are pressed -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.KeyDown(var Key : Word; Shift : TShiftState); begin if (Key = VK_F2) then FEnhEditMode := true else if (Key = VK_ESCAPE) and FEditing then begin SetEditText(Col, Row, FOldEditText); EditorHide; exit; end; inherited; end; {@@ ---------------------------------------------------------------------------- Standard method inherited from TCustomGrid. Is overridden to create an empty workbook -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.Loaded; begin inherited; if FWorkbookSource = nil then // CreateNewWorkbook; NewWorkbook(FInitColCount, FInitRowCount); end; {@@ ---------------------------------------------------------------------------- Loads the worksheet into the grid and displays its contents. @param AWorksheet Worksheet to be displayed in the grid -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.LoadFromWorksheet(AWorksheet: TsWorksheet); begin if FWorkbookSource <> nil then exit; FOwnedWorksheet := AWorksheet; if FOwnedWorksheet <> nil then begin FOwnedWorksheet.OnChangeCell := @ChangedCellHandler; FOwnedWorksheet.OnChangeFont := @ChangedFontHandler; ShowHeaders := (soShowHeaders in Worksheet.Options); ShowGridLines := (soShowGridLines in Worksheet.Options); if (soHasFrozenPanes in Worksheet.Options) then begin FrozenCols := FOwnedWorksheet.LeftPaneWidth; FrozenRows := FOwnedWorksheet.TopPaneHeight; end else begin FrozenCols := 0; FrozenRows := 0; end; Row := FrozenRows; Col := FrozenCols; end; Setup; end; {@@ ---------------------------------------------------------------------------- Creates a new workbook and loads the given file into it. The file is assumed to have the given file format. Shows the sheet with the given sheet index. @param AFileName Name of the file to be loaded @param AFormat Spreadsheet file format assumed for the file @param AWorksheetIndex Index of the worksheet to be displayed in the grid -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.LoadFromSpreadsheetFile(AFileName: string; AFormat: TsSpreadsheetFormat; AWorksheetIndex: Integer); begin if FOwnsWorkbook then FreeAndNil(FOwnedWorkbook); if FWorkbookSource <> nil then FWorkbookSource.LoadFromSpreadsheetFile(AFileName, AFormat, AWorksheetIndex) else begin BeginUpdate; try CreateNewWorkbook; Workbook.ReadFromFile(AFileName, AFormat); LoadFromWorksheet(Workbook.GetWorksheetByIndex(AWorksheetIndex)); finally EndUpdate; end; end; end; {@@ ---------------------------------------------------------------------------- Creates a new workbook and loads the given file into it. The file format is determined automatically. Shows the sheet with the given sheet index. @param AFileName Name of the file to be loaded @param AWorksheetIndex Index of the worksheet to be shown in the grid -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.LoadFromSpreadsheetFile(AFileName: string; AWorksheetIndex: Integer); begin if FOwnsWorkbook then FreeAndNil(FOwnedWorkbook); if FWorkbookSource <> nil then FWorkbookSource.LoadFromSpreadsheetFile(AFileName, AWorksheetIndex) else begin BeginUpdate; try CreateNewWorkbook; Workbook.ReadFromFile(AFilename); LoadFromWorksheet(Workbook.GetWorksheetByIndex(AWorksheetIndex)); finally EndUpdate; end; end; end; {@@ ---------------------------------------------------------------------------- Notification message received from the WorkbookLink telling which item of the spreadsheet has changed. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil); var grow, gcol: Integer; begin Unused(AData); // Nothing to do for "workbook changed" because this is always combined with // "worksheet changed". // Worksheet changed if (lniWorksheet in AChangedItems) then begin if (Worksheet <> nil) then begin ShowHeaders := (soShowHeaders in Worksheet.Options); ShowGridLines := (soShowGridLines in Worksheet.Options); if (soHasFrozenPanes in Worksheet.Options) then begin FrozenCols := Worksheet.LeftPaneWidth; FrozenRows := Worksheet.TopPaneHeight; end else begin FrozenCols := 0; FrozenRows := 0; end; end; Setup; end; // Cell value or format changed if (lniCell in AChangedItems) then Invalidate; // Selection changed if (lniSelection in AChangedItems) and (Worksheet <> nil) then begin grow := GetGridRow(Worksheet.ActiveCellRow); gcol := GetGridCol(Worksheet.ActiveCellCol); if (grow <> Row) or (gcol <> Col) then MoveExtend(false, gcol, grow); end; // Abort selection because of an error if (lniAbortSelection in AChangedItems) and (Worksheet <> nil) then begin MouseUp(mbLeft, [], GCache.ClickMouse.X, GCache.ClickMouse.Y); // HOW TO DO THIS???? SelectActive not working... end; // Row height (after font change). if (lniRow in AChangedItems) and (Worksheet <> nil) then begin grow := GetGridRow({%H-}PtrInt(AData)); RowHeights[grow] := CalcAutoRowHeight(grow); end; end; {@@ ---------------------------------------------------------------------------- Merges the selected cells to a single large cell Only the upper left cell can have content and formatting (which is extended into the other cells). -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.MergeCells; begin Worksheet.MergeCells( GetWorksheetRow(Selection.Top), GetWorksheetCol(Selection.Left), GetWorksheetRow(Selection.Bottom), GetWorksheetCol(Selection.Right) ); end; {@@ ---------------------------------------------------------------------------- Standard mouse down handler. Is overridden here to handle hyperlinks and to enter "enhanced edit mode" which removes formatting from the values and presents formulas for editing. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); {todo: extend such that the hyperlink is handled only when the text is clicked (tough because of overflow cells!) } var mouseCell: TPoint; cell: PCell; r, c: Cardinal; begin inherited; { Prepare processing of the hyperlink: triggers a timer, the hyperlink is executed when the timer has expired (see HyperlinkTimerElapsed). } if (ssLeft in Shift) then begin mouseCell := MouseToCell(Point(X, Y)); r := GetWorksheetRow(mouseCell.Y); c := GetWorksheetCol(mouseCell.X); cell := Worksheet.FindCell(r, c); if Worksheet.IsMerged(cell) then cell := Worksheet.FindMergeBase(cell); if Worksheet.HasHyperlink(cell) then begin FHyperlinkCell := cell; FHyperlinkTimer.Enabled := true; end else begin FHyperlinkCell := nil; FHyperlinkTimer.Enabled := false; end; end; FEnhEditMode := true; end; {@@ ---------------------------------------------------------------------------- Standard mouse move handler. Is overridden because, if TextOverflow is active, overflown cell may be erased when the mouse leaves them; repaints entire grid instead. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.MouseMove(Shift: TShiftState; X, Y: Integer); var prevMouseCell: TPoint; begin prevMouseCell := GCache.MouseCell; inherited; if FTextOverflow and ((prevMouseCell.X <> GCache.MouseCell.X) or (prevMouseCell.Y <> GCache.MouseCell.Y)) then InvalidateGrid; if FHyperlinkTimer.Enabled and (ssLeft in Shift) then FHyperlinkTimer.Enabled := false; end; procedure TsCustomWorksheetGrid.MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); begin if FHyperlinkTimer.Enabled then begin FHyperlinkTimer.Enabled := false; FHyperlinkCell := nil; end; inherited; end; {@@ ---------------------------------------------------------------------------- Standard method inherited from TCustomGrid. Notifies the WorkbookSource of the changed selected cell. Repaints the grid after moving selection to avoid spurious rests of the old thick selection border. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.MoveSelection; var sel: TsCellRangeArray; {$IF (ENABLE_MULTI_SELECT=1)} i: Integer; {$ENDIF} begin if Worksheet <> nil then begin {$IF (ENABLE_MULTI_SELECT=1)} if HasMultiSelection then begin SetLength(sel, SelectedRangeCount); for i:=0 to High(sel) do with SelectedRange[i] do begin sel[i].Row1 := GetWorksheetRow(Top); sel[i].Col1 := GetWorksheetCol(Left); sel[i].Row2 := GetWorksheetRow(Bottom); sel[i].Col2 := GetWorksheetCol(Right); end; end else begin SetLength(sel, 1); sel[0].Row1 := GetWorksheetRow(Selection.Top); sel[0].Col1 := GetWorksheetCol(Selection.Left); sel[0].Row2 := GetWorksheetRow(Selection.Bottom); sel[0].Col2 := GetWorksheetRow(Selection.Right); end; {$ELSE} SetLength(sel, 1); sel[0].Row1 := GetWorksheetRow(Selection.Top); sel[0].Col1 := GetWorksheetCol(Selection.Left); sel[0].Row2 := GetWorksheetRow(Selection.Bottom); sel[0].Col2 := GetWorksheetRow(Selection.Right); {$ENDIF} Worksheet.SetSelection(sel); Worksheet.SelectCell(GetWorksheetRow(Row), GetWorksheetCol(Col)); end; //Refresh; inherited; Refresh; end; {@@ ---------------------------------------------------------------------------- Creates a new empty workbook with the specified number of columns and rows. @param AColCount Number of columns @param ARowCount Number of rows -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.NewWorkbook(AColCount, ARowCount: Integer); begin if FOwnsWorkbook then FreeAndNil(FOwnedWorkbook); if FWorkbookSource <> nil then FWorkbookSource.CreateNewWorkbook else begin BeginUpdate; try CreateNewWorkbook; FOwnedWorksheet := FOwnedWorkbook.AddWorksheet('Sheet1'); FOwnedWorksheet.OnChangeCell := @ChangedCellHandler; FOwnedWorksheet.OnChangeFont := @ChangedFontHandler; FInitColCount := AColCount; FInitRowCount := ARowCount; Setup; finally EndUpdate; end; end; end; {@@ ---------------------------------------------------------------------------- Standard component notification: The grid is notified that the WorkbookLink is being removed. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if (Operation = opRemove) and (AComponent = FWorkbookSource) then SetWorkbookSource(nil); end; {@@ ---------------------------------------------------------------------------- Removes the link of the WorksheetGrid to the WorkbookSource. Required before destruction. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.RemoveWorkbookSource; begin SetWorkbookSource(nil); end; {@@ ---------------------------------------------------------------------------- Writes the workbook represented by the grid to a spreadsheet file. @param AFileName Name of the file to which the workbook is to be saved. @param AFormat Spreadsheet file format in which the file is to be saved. @param AOverwriteExisting If the file already exists, it is overwritten in the case of AOverwriteExisting = true, or an exception is raised if AOverwriteExisting = false -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.SaveToSpreadsheetFile(AFileName: String; AFormat: TsSpreadsheetFormat; AOverwriteExisting: Boolean = true); begin if Workbook <> nil then Workbook.WriteToFile(AFileName, AFormat, AOverwriteExisting); end; {@@ ---------------------------------------------------------------------------- Saves the workbook into a file with the specified file name. If this file name already exists the file is overwritten if AOverwriteExisting is true. @param AFileName Name of the file to which the workbook is to be saved If the file format is not known is is written as BIFF8/XLS. @param AOverwriteExisting If this file already exists it is overwritten if AOverwriteExisting = true, or an exception is raised if AOverwriteExisting = false. } procedure TsCustomWorksheetGrid.SaveToSpreadsheetFile(AFileName: String; AOverwriteExisting: Boolean = true); begin if Workbook <> nil then Workbook.WriteToFile(AFileName, AOverwriteExisting); end; {@@ ---------------------------------------------------------------------------- Standard method inherited from TCustomGrid: Is called when editing starts. Is overridden here to store the old text just in case that the user presses ESC to cancel editing. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.SelectEditor; begin FOldEditText := GetCellText(Col, Row); inherited; end; {@@ ---------------------------------------------------------------------------- Loads the workbook into the grid and selects the sheet with the given index. "Selected" means here that the sheet is loaded into the grid. @param AIndex Index of the worksheet to be shown in the grid -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.SelectSheetByIndex(AIndex: Integer); begin if Workbook <> nil then LoadFromWorksheet(Workbook.GetWorksheetByIndex(AIndex)); end; {@@ ---------------------------------------------------------------------------- Standard method inherited from TCustomGrid. Fetches the text that is currently in the editor. It is not yet transferred to the worksheet because input will be checked only at the end of editing. @param ACol Grid column index of the cell being edited @param ARow Grid row index of the cell being edited @param AValue String which is currently in the cell editor -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.SetEditText(ACol, ARow: Longint; const AValue: string); begin FEditText := AValue; FEditing := true; inherited SetEditText(aCol, aRow, aValue); end; {@@ ---------------------------------------------------------------------------- Helper method for setting up the rows and columns after a new workbook is loaded or created. Sets up the grid's column and row count, as well as the initial column widths and row heights. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.Setup; begin if csLoading in ComponentState then exit; if (Worksheet = nil) or (Worksheet.GetCellCount = 0) then begin if ShowHeaders then begin ColCount := FInitColCount + 1; //2; RowCount := FInitRowCount + 1; //2; FixedCols := 1; FixedRows := 1; ColWidths[0] := Canvas.TextWidth(' 999999 '); end else begin FixedCols := 0; FixedRows := 0; ColCount := FInitColCount; //0; RowCount := FInitRowCount; //0; end; end else if Worksheet <> nil then begin Convert_sFont_to_Font(Workbook.GetDefaultFont, Font); Canvas.Font.Assign(Font); ColCount := Max(integer(Worksheet.GetLastColIndex) + 1 + FHeaderCount, FInitColCount); RowCount := Max(integer(Worksheet.GetLastRowIndex) + 1 + FHeaderCount, FInitRowCount); FixedCols := FFrozenCols + FHeaderCount; FixedRows := FFrozenRows + FHeaderCount; if ShowHeaders then begin ColWidths[0] := Canvas.TextWidth(' 999999 '); RowHeights[0] := DefaultRowHeight; end; end; UpdateColWidths; UpdateRowHeights; Invalidate; end; {@@ ---------------------------------------------------------------------------- Setter to define the link to the workbook. -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.SetWorkbookSource(AValue: TsWorkbookSource); begin if AValue = FWorkbookSource then exit; if FOwnsWorkbook then FreeAndNil(FOwnedWorkbook); if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self); FWorkbookSource := AValue; if FWorkbookSource <> nil then FWorkbookSource.AddListener(self); FOwnsWorkbook := (FWorkbookSource = nil); ListenerNotification([lniWorksheet, lniSelection]); end; {@@ ---------------------------------------------------------------------------- Sorts the grid by calling the corresponding method of the worksheet. Sorting extends across the entire worksheet. Sort direction is determined by the property "SortOrder". Other sorting criteria are "case-sensitive" and "numbers first". @param AColSorting If true the grid is sorted from top to bottom and the next parameter, "Index", refers to a column. Otherweise sorting goes from left to right and "Index" refers to a row. @param AIndex Index of the column (if ColSorting=true) or row (ColSorting = false) which is sorted. @param AIndxFrom Sorting starts at this row (ColSorting=true) / column (ColSorting=false) @param AIndxTo Sorting ends at this row (ColSorting=true) / column (ColSorting=false) -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.Sort(AColSorting: Boolean; AIndex, AIndxFrom, AIndxTo:Integer); var sortParams: TsSortParams; begin sortParams := InitSortParams(AColSorting, 1); sortParams.Keys[0].ColRowIndex := AIndex - HeaderCount; if SortOrder = soDescending then sortParams.Keys[0].Options := [ssoDescending]; if AColSorting then Worksheet.Sort( sortParams, AIndxFrom-HeaderCount, 0, AIndxTo-HeaderCount, Worksheet.GetLastColIndex ) else Worksheet.Sort( sortParams, 0, AIndxFrom-HeaderCount, Worksheet.GetLastRowIndex, AIndxTo-HeaderCount ); end; {@@ ---------------------------------------------------------------------------- Modifies the text that is show for cells which are too narrow to hold the entire text. The method follows the behavior of Excel and Open/LibreOffice: If the specified cell contains a non-formatted number, then it is formatted such that the text fits into the cell. If the text is still too long or the cell does not contain a label then the cell is filled by '#' characters. Label cell texts are not modified, they can overflow into the adjacent cells. -------------------------------------------------------------------------------} function TsCustomWorksheetGrid.TrimToCell(ACell: PCell): String; var cellSize, txtSize: Integer; decs: Integer; p: Integer; isRotated: Boolean; isStacked: Boolean; tr: TsTextRotation; fmt: PsCellFormat; begin Result := Worksheet.ReadAsUTF8Text(ACell); if (Result = '') or ((ACell <> nil) and (ACell^.ContentType = cctUTF8String)) then exit; fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); tr := fmt^.TextRotation; isRotated := (tr <> trHorizontal); isStacked := (tr = rtStacked); // isRotated := (uffTextRotation in ACell^.UsedFormattingFields) and (ACell^.TextRotation <> trHorizontal); // isStacked := (uffTextRotation in ACell^.UsedFormattingFields) and (ACell^.TextRotation = rtStacked); // Determine space available in cell if isRotated then cellSize := RowHeights[GetGridRow(ACell^.Row)] else cellSize := ColWidths[GetGridCol(ACell^.Col)] - 2*ConstCellPadding; // Determine space needed for text if isStacked then txtSize := Length(Result) * Canvas.TextHeight('A') else txtSize := Canvas.TextWidth(Result); // Nothing to do if text fits into cell if txtSize <= cellSize then exit; if (ACell^.ContentType = cctNumber) and (fmt^.NumberFormat = nfGeneral) then begin // Determine number of decimal places p := pos(Workbook.FormatSettings.DecimalSeparator, Result); if p = 0 then decs := 0 else decs := Length(Result) - p; // Use floating point format, but reduce number of decimal places until // text fits in while decs > 0 do begin dec(decs); Result := Format('%.*f', [decs, ACell^.NumberValue], Workbook.FormatSettings); if isStacked then txtSize := Length(Result) * Canvas.TextHeight('A') else txtSize := Canvas.TextWidth(Result); if txtSize <= cellSize then exit; end; // There seem to be too many integer digits. Switch to exponential format. decs := 13; while decs > 0 do begin dec(decs); Result := Format('%.*e', [decs, ACell^.NumberValue], Workbook.FormatSettings); if isStacked then txtSize := Length(Result) * Canvas.TextHeight('A') else txtSize := Canvas.TextWidth(Result); if txtSize <= cellSize then exit; end; end; // Still text too long or non-number --> Fill with # characters. Result := ''; txtSize := 0; while txtSize < cellSize do begin Result := Result + '#'; if isStacked then txtSize := Length(Result) * Canvas.TextHeight('#') else txtSize := Canvas.TextWidth(Result); end; // We added one character too many Delete(Result, Length(Result), 1); end; {@@ ---------------------------------------------------------------------------- Splits a merged cell block into single cells -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.UnmergeCells; begin Worksheet.UnmergeCells( GetWorksheetRow(Selection.Top), GetWorksheetCol(Selection.Left) ); end; {@@ ---------------------------------------------------------------------------- Updates column widths according to the data in the TCol records -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.UpdateColWidths(AStartIndex: Integer = 0); var i: Integer; lCol: PCol; w: Integer; begin 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 := CalcColWidth(lCol^.Width) else w := CalcColWidth(Worksheet.DefaultColWidth); end; ColWidths[i] := w; end; 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 -------------------------------------------------------------------------------} procedure TsCustomWorksheetGrid.UpdateRowHeights(AStartIndex: Integer = 0); var i: Integer; lRow: PRow; h: Integer; begin if AStartIndex <= 0 then AStartIndex := FHeaderCount; for i := AStartIndex to RowCount-1 do begin h := CalcAutoRowHeight(i); if Worksheet <> nil then begin lRow := Worksheet.FindRow(i - FHeaderCount); if (lRow <> nil) then h := CalcRowHeight(lRow^.Height); end; RowHeights[i] := h; end; end; {******************************************************************************* * Setter / getter methods * *******************************************************************************} function TsCustomWorksheetGrid.GetCellFontColor(ACol, ARow: Integer): TsColor; var cell: PCell; fnt: TsFont; begin Result := scNotDefined; if (Workbook <> nil) and (Worksheet <> nil) then begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); fnt := Worksheet.ReadCellFont(cell); Result := fnt.Color; end; end; function TsCustomWorksheetGrid.GetCellFontColors(ARect: TGridRect): TsColor; var c, r: Integer; clr: TsColor; begin Result := GetCellFontColor(ARect.Left, ARect.Top); clr := Result; for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin Result := GetCellFontColor(c, r); if (Result <> clr) then begin Result := scNotDefined; exit; end; end; end; function TsCustomWorksheetGrid.GetCellFontName(ACol, ARow: Integer): String; var cell: PCell; fnt: TsFont; begin Result := ''; if (Workbook <> nil) and (Worksheet <> nil) then begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); fnt := Worksheet.ReadCellFont(cell); if fnt <> nil then Result := fnt.FontName; end; end; function TsCustomWorksheetGrid.GetCellFontNames(ARect: TGridRect): String; var c, r: Integer; s: String; begin Result := GetCellFontName(ARect.Left, ARect.Top); s := Result; for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin Result := GetCellFontName(c, r); if (Result <> '') and (Result <> s) then begin Result := ''; exit; end; end; end; function TsCustomWorksheetGrid.GetCellFontSize(ACol, ARow: Integer): Single; var cell: PCell; fnt: TsFont; begin Result := -1.0; if (Workbook <> nil) and (Worksheet <> nil) then begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); fnt := Worksheet.ReadCellFont(cell); Result := fnt.Size; end; end; function TsCustomWorksheetGrid.GetCellFontSizes(ARect: TGridRect): Single; var c, r: Integer; sz: Single; begin Result := GetCellFontSize(ARect.Left, ARect.Top); sz := Result; for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin Result := GetCellFontSize(c, r); if (Result <> -1) and not SameValue(Result, sz, 1E-3) then begin Result := -1.0; exit; end; end; end; function TsCustomWorksheetGrid.GetCellFontStyle(ACol, ARow: Integer): TsFontStyles; var cell: PCell; fnt: TsFont; begin Result := []; if (Workbook <> nil) and (Worksheet <> nil) then begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); fnt := Worksheet.ReadCellFont(cell); Result := fnt.Style; end; end; function TsCustomWorksheetGrid.GetCellFontStyles(ARect: TGridRect): TsFontStyles; var c, r: Integer; style: TsFontStyles; begin Result := GetCellFontStyle(ARect.Left, ARect.Top); style := Result; for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin Result := GetCellFontStyle(c, r); if Result <> style then begin Result := []; exit; end; end; end; function TsCustomWorksheetGrid.GetHorAlignment(ACol, ARow: Integer): TsHorAlignment; var cell: PCell; begin Result := haDefault; if Assigned(Worksheet) then begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Result := Worksheet.ReadHorAlignment(cell); end; end; function TsCustomWorksheetGrid.GetHorAlignments(ARect: TGridRect): TsHorAlignment; var c, r: Integer; horalign: TsHorAlignment; begin Result := GetHorAlignment(ARect.Left, ARect.Top); horalign := Result; for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin Result := GetHorAlignment(c, r); if Result <> horalign then begin Result := haDefault; exit; end; end; end; function TsCustomWorksheetGrid.GetShowGridLines: Boolean; begin Result := (Options * [goHorzLine, goVertLine] <> []); end; function TsCustomWorksheetGrid.GetShowHeaders: Boolean; begin Result := FHeaderCount <> 0; end; function TsCustomWorksheetGrid.GetTextRotation(ACol, ARow: Integer): TsTextRotation; var cell: PCell; begin Result := trHorizontal; if Assigned(Worksheet) then begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Result := Worksheet.ReadTextRotation(cell); end; end; function TsCustomWorksheetGrid.GetTextRotations(ARect: TGridRect): TsTextRotation; var c, r: Integer; textrot: TsTextRotation; begin Result := GetTextRotation(ARect.Left, ARect.Top); textrot := Result; for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin Result := GetTextRotation(c, r); if Result <> textrot then begin Result := trHorizontal; exit; end; end; end; function TsCustomWorksheetGrid.GetVertAlignment(ACol, ARow: Integer): TsVertAlignment; var cell: PCell; begin Result := vaDefault; if Assigned(Worksheet) then begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Result := Worksheet.ReadVertAlignment(cell); end; end; function TsCustomWorksheetGrid.GetVertAlignments(ARect: TGridRect): TsVertAlignment; var c, r: Integer; vertalign: TsVertAlignment; begin Result := GetVertalignment(ARect.Left, ARect.Top); vertalign := Result; for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin Result := GetVertAlignment(c, r); if Result <> vertalign then begin Result := vaDefault; exit; end; end; end; function TsCustomWorksheetGrid.GetWorkbook: TsWorkbook; begin if FWorkbookSource <> nil then Result := FWorkbookSource.Workbook else Result := FOwnedWorkbook; end; function TsCustomWorksheetGrid.GetWorksheet: TsWorksheet; begin if FWorkbookSource <> nil then Result := FWorkbooksource.Worksheet else Result := FOwnedWorksheet; end; function TsCustomWorksheetGrid.GetWordwrap(ACol, ARow: Integer): Boolean; var cell: PCell; begin Result := false; if Assigned(Worksheet) then begin cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Result := Worksheet.ReadWordwrap(cell); end; end; function TsCustomWorksheetGrid.GetWordwraps(ARect: TGridRect): Boolean; var c, r: Integer; wrapped: Boolean; begin Result := GetWordwrap(ARect.Left, ARect.Top); wrapped := Result; for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do begin Result := GetWordwrap(c, r); if Result <> wrapped then begin Result := false; exit; end; end; end; procedure TsCustomWorksheetGrid.SetAutoCalc(AValue: Boolean); begin FAutoCalc := AValue; if Assigned(FWorkbookSource) then begin if FAutoCalc then FWorkbookSource.Options := FWorkbookSource.Options + [boAutoCalc] else FWorkbookSource.Options := FWorkbookSource.Options - [boAutoCalc]; end; if Assigned(Workbook) then begin if FAutoCalc then Workbook.Options := Workbook.Options + [boAutoCalc] else Workbook.Options := Workbook.Options - [boAutoCalc]; end; end; procedure TsCustomWorksheetGrid.SetBackgroundColor(ACol, ARow: Integer; AValue: TsColor); var cell: PCell; begin if Assigned(Worksheet) then begin BeginUpdate; try cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteBackgroundColor(cell, AValue); finally EndUpdate; end; end; end; procedure TsCustomWorksheetGrid.SetBackgroundColors(ARect: TGridRect; AValue: TsColor); var c,r: Integer; begin BeginUpdate; try for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do SetBackgroundColor(c, r, AValue); finally EndUpdate; end; end; procedure TsCustomWorksheetGrid.SetCellBorder(ACol, ARow: Integer; AValue: TsCellBorders); var cell: PCell; begin if Assigned(Worksheet) then begin BeginUpdate; try cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteBorders(cell, AValue); FixNeighborCellBorders(cell); finally EndUpdate; end; end; end; procedure TsCustomWorksheetGrid.SetCellBorders(ARect: TGridRect; AValue: TsCellBorders); var c,r: Integer; begin BeginUpdate; try for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do SetCellBorder(c, r, AValue); finally EndUpdate; end; end; procedure TsCustomWorksheetGrid.SetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder; AValue: TsCellBorderStyle); var cell: PCell; begin if Assigned(Worksheet) then begin BeginUpdate; try cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteBorderStyle(cell, ABorder, AValue); FixNeighborCellBorders(cell); finally EndUpdate; end; end; end; procedure TsCustomWorksheetGrid.SetCellBorderStyles(ARect: TGridRect; ABorder: TsCellBorder; AValue: TsCellBorderStyle); var c,r: Integer; begin BeginUpdate; try for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do SetCellBorderStyle(c, r, ABorder, AValue); finally EndUpdate; end; end; procedure TsCustomWorksheetGrid.SetCellFont(ACol, ARow: Integer; AValue: TFont); var fnt: TsFont; cell: PCell; begin FCellFont.Assign(AValue); if Assigned(Worksheet) then begin fnt := TsFont.Create; try Convert_Font_To_sFont(FCellFont, fnt); cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteFont(cell, fnt.FontName, fnt.Size, fnt.Style, fnt.Color); finally fnt.Free; end; end; end; procedure TsCustomWorksheetGrid.SetCellFonts(ARect: TGridRect; AValue: TFont); var c,r: Integer; begin BeginUpdate; try for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do SetCellFont(c, r, AValue); finally EndUpdate; end; end; procedure TsCustomWorksheetGrid.SetCellFontColor(ACol, ARow: Integer; AValue: TsColor); var cell: PCell; begin if Assigned(Worksheet) then begin cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteFontColor(cell, AValue); end; end; procedure TsCustomWorksheetGrid.SetCellFontColors(ARect: TGridRect; AValue: TsColor); var c,r: Integer; begin BeginUpdate; try for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do SetCellFontColor(c, r, AValue); finally EndUpdate; end; end; procedure TsCustomWorksheetGrid.SetCellFontName(ACol, ARow: Integer; AValue: String); var cell: PCell; begin if Assigned(Worksheet) then begin cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteFontName(cell, AValue); end; end; procedure TsCustomWorksheetGrid.SetCellFontNames(ARect: TGridRect; AValue: String); var c,r: Integer; begin BeginUpdate; try for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do SetCellFontName(c, r, AValue); finally EndUpdate; end; end; procedure TsCustomWorksheetGrid.SetCellFontSize(ACol, ARow: Integer; AValue: Single); var cell: PCell; begin if Assigned(Worksheet) then begin cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteFontSize(cell, AValue); end; end; procedure TsCustomWorksheetGrid.SetCellFontSizes(ARect: TGridRect; AValue: Single); var c,r: Integer; begin BeginUpdate; try for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do SetCellFontSize(c, r, AValue); finally EndUpdate; end; end; procedure TsCustomWorksheetGrid.SetCellFontStyle(ACol, ARow: Integer; AValue: TsFontStyles); var cell: PCell; begin if Assigned(Worksheet) then begin cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteFontStyle(cell, AValue); end; end; procedure TsCustomWorksheetGrid.SetCellFontStyles(ARect: TGridRect; AValue: TsFontStyles); var c,r: Integer; begin BeginUpdate; try for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do SetCellFontStyle(c, r, AValue); finally EndUpdate; end; end; procedure TsCustomWorksheetGrid.SetFrozenCols(AValue: Integer); begin FFrozenCols := AValue; if Worksheet <> nil then begin Worksheet.LeftPaneWidth := FFrozenCols; if (FFrozenCols > 0) or (FFrozenRows > 0) then Worksheet.Options := Worksheet.Options + [soHasFrozenPanes] else Worksheet.Options := Worksheet.Options - [soHasFrozenPanes]; end; Setup; end; procedure TsCustomWorksheetGrid.SetFrozenRows(AValue: Integer); begin FFrozenRows := AValue; if Worksheet <> nil then begin Worksheet.TopPaneHeight := FFrozenRows; if (FFrozenCols > 0) or (FFrozenRows > 0) then Worksheet.Options := Worksheet.Options + [soHasFrozenPanes] else Worksheet.Options := Worksheet.Options - [soHasFrozenPanes]; end; Setup; end; procedure TsCustomWorksheetGrid.SetHorAlignment(ACol, ARow: Integer; AValue: TsHorAlignment); var cell: PCell; begin if Assigned(Worksheet) then begin cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteHorAlignment(cell, AValue); end; end; procedure TsCustomWorksheetGrid.SetHorAlignments(ARect: TGridRect; AValue: TsHorAlignment); var c,r: Integer; begin BeginUpdate; try for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do SetHorAlignment(c, r, AValue); finally EndUpdate; end; end; procedure TsCustomWorksheetGrid.SetReadFormulas(AValue: Boolean); begin FReadFormulas := AValue; if Assigned(FWorkbookSource) then begin if FReadFormulas then FWorkbookSource.Options := FWorkbookSource.Options + [boReadFormulas] else FWorkbookSource.Options := FWorkbookSource.Options - [boReadFormulas]; end; if Assigned(Workbook) then begin if FReadFormulas then Workbook.Options := Workbook.Options + [boReadFormulas] else Workbook.Options := Workbook.Options - [boReadFormulas]; end; end; { Shows / hides the worksheet's grid lines } procedure TsCustomWorksheetGrid.SetShowGridLines(AValue: Boolean); begin if AValue = GetShowGridLines then Exit; if AValue then Options := Options + [goHorzLine, goVertLine] else Options := Options - [goHorzLine, goVertLine]; if Worksheet <> nil then if AValue then Worksheet.Options := Worksheet.Options + [soShowGridLines] else Worksheet.Options := Worksheet.Options - [soShowGridLines]; end; { Shows / hides the worksheet's row and column headers. } procedure TsCustomWorksheetGrid.SetShowHeaders(AValue: Boolean); begin if AValue = GetShowHeaders then Exit; FHeaderCount := ord(AValue); if Worksheet <> nil then if AValue then Worksheet.Options := Worksheet.Options + [soShowHeaders] else Worksheet.Options := Worksheet.Options - [soShowHeaders]; Setup; end; procedure TsCustomWorksheetGrid.SetTextRotation(ACol, ARow: Integer; AValue: TsTextRotation); var cell: PCell; begin if Assigned(Worksheet) then begin cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteTextRotation(cell, AValue); end; end; procedure TsCustomWorksheetGrid.SetTextRotations(ARect: TGridRect; AValue: TsTextRotation); var c,r: Integer; begin BeginUpdate; try for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do SetTextRotation(c, r, AValue); finally EndUpdate; end; end; procedure TsCustomWorksheetGrid.SetVertAlignment(ACol, ARow: Integer; AValue: TsVertAlignment); var cell: PCell; begin if Assigned(Worksheet) then begin cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteVertAlignment(cell, AValue); end; end; procedure TsCustomWorksheetGrid.SetVertAlignments(ARect: TGridRect; AValue: TsVertAlignment); var c,r: Integer; begin BeginUpdate; try for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do SetVertAlignment(c, r, AValue); finally EndUpdate; end; end; procedure TsCustomWorksheetGrid.SetWordwrap(ACol, ARow: Integer; AValue: Boolean); var cell: PCell; begin if Assigned(Worksheet) then begin cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); Worksheet.WriteWordwrap(cell, AValue); end; end; procedure TsCustomWorksheetGrid.SetWordwraps(ARect: TGridRect; AValue: Boolean); var c,r: Integer; begin BeginUpdate; try for c := ARect.Left to ARect.Right do for r := ARect.Top to ARect.Bottom do SetWordwrap(c, r, AValue); finally EndUpdate; end; end; {@@ ---------------------------------------------------------------------------- Registers the worksheet grid in the Lazarus component palette, page "FPSpreadsheet". -------------------------------------------------------------------------------} procedure Register; begin RegisterComponents('FPSpreadsheet', [TsWorksheetGrid]); end; initialization fpsutils.ScreenPixelsPerInch := Screen.PixelsPerInch; FillPatternStyle := fsNoFill; RegisterPropertyToSkip(TsCustomWorksheetGrid, 'ColWidths', 'taken from worksheet', ''); RegisterPropertyToSkip(TsCustomWorksheetGrid, 'RowHeights', 'taken from worksheet', ''); finalization FreeAndNil(FillPatternBitmap); end.