paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
cae258705a
lazarus-ccr/components/fpspreadsheet/source/visual/fpspreadsheetgrid.pas

7363 lines
247 KiB
ObjectPascal
Raw Blame History

{@@ ----------------------------------------------------------------------------
Unit fpSpreadsheetGrid implements a **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 method 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+}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
{$I fps.inc}
{.$DEFINE GRID_DEBUG}
{ 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
LCLType, LCLIntf, LCLVersion, Classes, SysUtils, LMessages, LResources, Variants,
Forms, Controls, Graphics, Dialogs, Grids, StdCtrls, ExtCtrls,
fpstypes, fpspreadsheet, fpspreadsheetctrls;
type
{ TsCustomWorksheetGrid }
TsCustomWorksheetGrid = class;
TsAutoExpandMode = (
{@@ Expands grid dimensions if a cell is written outside current grid dimensions }
aeData,
{@@ Expands grid dimensions if navigation goes outside current grid dimensions }
aeNavigation,
{@@ Expands grid dimensions to DEFAULT_ROW_COUNT and DEFAULT_COL_COUNT }
aeDefault
);
TsAutoExpandModes = set of TsAutoExpandMode;
TsEditorLineMode = (elmSingleLine, elmMultiLine);
TsHyperlinkClickEvent = procedure(Sender: TObject;
const AHyperlink: TsHyperlink) of object;
TsGetCellTextEvent = procedure(Sender: TObject; AIndex: Integer;
var AText: String) of object;
TsSelPen = class(TPen)
public
constructor Create; override;
published
property Width stored true default 3;
property JoinStyle default pjsMiter;
end;
TsMultilineStringCellEditor = class(TMemo)
private
FGrid: TsCustomWorksheetGrid;
FCol, FRow: Integer;
protected
procedure Change; override;
procedure KeyDown(var AKey: Word; AShift: TShiftState); override;
procedure msg_SetValue(var AMsg: TGridMessage); message GM_SETVALUE;
procedure msg_GetValue(var AMsg: TGridMessage); message GM_GETVALUE;
procedure msg_SetGrid(var AMsg: TGridMessage); message GM_SETGRID;
procedure msg_SelectAll(var AMsg: TGridMessage); message GM_SELECTALL;
procedure msg_SetPos(var AMsg: TGridMessage); message GM_SETPOS;
procedure msg_GetGrid(var AMsg: TGridMessage); message GM_GETGRID;
procedure WndProc(var AMsg: TLMessage); override;
public
constructor Create(AOwner: TComponent); override;
procedure EditingDone; override;
property OnEditingDone;
end;
// TsSelectionRectMode = (srmDThickXOR, srmThick, srmDottedXOR,
{@@ 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;
FInternalWorkbookSource: TsWorkbookSource;
FHeaderCount: Integer;
FFrozenCols: Integer;
FFrozenRows: Integer;
FEditText: String;
FLockCount: Integer;
FLockSetup: Integer;
FEditing: Boolean;
FCellFont: TFont;
FAutoCalc: Boolean;
FAutoDetectCellType: Boolean;
FTextOverflow: Boolean;
FReadFormulas: Boolean;
FDrawingCell: PCell;
FTextOverflowing: Boolean;
FAutoExpand: TsAutoExpandModes;
FEnhEditMode: Boolean;
FSelPen: TsSelPen;
FPageBreakPen: TPen;
FFrozenBorderPen: TPen;
FHyperlinkTimer: TTimer;
FHyperlinkCell: PCell; // Selected cell if it stores a hyperlink
FDefRowHeight100: Integer; // Default row height for 100% zoom factor, in pixels
FDefColWidth100: Integer; // Default col width for 100% zoom factor, in pixels
FZoomLock: Integer;
FRowHeightLock: Integer;
FActiveCellLock: Integer;
FTopLeft: TPoint;
FReadOnly: Boolean;
FOnClickHyperlink: TsHyperlinkClickEvent;
FOldEditorText: String;
// FSingleLineStringEditor: TsSingleLineStringCellEditor;
FMultiLineStringEditor: TsMultilineStringCellEditor;
FLineMode: TsEditorLineMode;
FAllowDragAndDrop: Boolean;
FDragStartCol, FDragStartRow: Integer;
FOldDragStartCol, FOldDragStartRow: Integer;
FDragSelection: TGridRect;
FDragTimer: TTimer;
FGetRowHeaderText: TsGetCellTextEvent;
FGetColHeaderText: TsGetCellTextEvent;
FRefocusing: TObject;
FRefocusingSelStart: Integer;
FFormulaError: Boolean;
FFixedColWidth: Integer;
FShowFormulas: Boolean;
FShowPageBreaks: Boolean;
function CalcAutoRowHeight(ARow: Integer): Integer;
function CalcColWidthFromSheet(AWidth: Single): Integer;
function CalcRowHeightFromSheet(AHeight: Single): Integer;
function CalcRowHeightToSheet(AHeight: Integer): Single;
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(ALeft, ATop, ARight, ABottom: Integer): TsColor;
function GetCellBiDiMode(ACol, ARow: Integer): TsBiDiMode;
function GetCellBorder(ACol, ARow: Integer): TsCellBorders;
function GetCellBorders(ALeft, ATop, ARight, ABottom: Integer): TsCellBorders;
function GetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder): TsCellBorderStyle;
function GetCellBorderStyles(ALeft, ATop, ARight, ABottom: Integer;
ABorder: TsCellBorder): TsCellBorderStyle;
function GetCellComment(ACol, ARow: Integer): string;
function GetCellFont(ACol, ARow: Integer): TFont;
function GetCellFonts(ALeft, ATop, ARight, ABottom: Integer): TFont;
function GetCellFontColor(ACol, ARow: Integer): TsColor;
function GetCellFontColors(ALeft, ATop, ARight, ABottom: Integer): TsColor;
function GetCellFontName(ACol, ARow: Integer): String;
function GetCellFontNames(ALeft, ATop, ARight, ABottom: Integer): String;
function GetCellFontSize(ACol, ARow: Integer): Single;
function GetCellFontSizes(ALeft, ATop, ARight, ABottom: Integer): Single;
function GetCellFontStyle(ACol, ARow: Integer): TsFontStyles;
function GetCellFontStyles(ALeft, ATop, ARight, ABottom: Integer): TsFontStyles;
function GetCellFormula(ACol, ARow: Integer): String;
function GetCellProtection(ACol, ARow: Integer): TsCellProtections;
function GetCellProtections(ALeft, ATop, ARight, ABottom: Integer): TsCellProtections;
function GetCellValue(ACol, ARow: Integer): variant;
function GetColWidths(ACol: Integer): Integer;
function GetDefColWidth: Integer;
function GetDefRowHeight: Integer;
function GetFixedColWidth: Integer;
function GetHorAlignment(ACol, ARow: Integer): TsHorAlignment;
function GetHorAlignments(ALeft, ATop, ARight, ABottom: Integer): TsHorAlignment;
function GetHyperlink(ACol, ARow: Integer): String;
function GetNumberFormat(ACol, ARow: Integer): String;
function GetNumberFormats(ALeft, ATop, ARight, ABottom: Integer): String;
function GetRowHeights(ARow: Integer): Integer;
function GetShowGridLines: Boolean;
function GetShowHeaders: Boolean; inline;
function GetTextRotation(ACol, ARow: Integer): TsTextRotation;
function GetTextRotations(ALeft, ATop, ARight, ABottom: Integer): TsTextRotation;
function GetVertAlignment(ACol, ARow: Integer): TsVertAlignment;
function GetVertAlignments(ALeft, ATop, ARight, ABottom: Integer): TsVertAlignment;
function GetWorkbook: TsWorkbook;
function GetWorkbookSource: TsWorkbookSource;
function GetWorksheet: TsWorksheet;
function GetWordwrap(ACol, ARow: Integer): Boolean;
function GetWordwraps(ALeft, ATop, ARight, ABottom: Integer): Boolean;
function GetZoomFactor: Double;
procedure SetAutoCalc(AValue: Boolean);
procedure SetAutoDetectCellType(AValue: Boolean);
procedure SetBackgroundColor(ACol, ARow: Integer; AValue: TsColor);
procedure SetBackgroundColors(ALeft, ATop, ARight, ABottom: Integer; AValue: TsColor);
procedure SetCellBiDiMode(ACol, ARow: Integer; AValue: TsBiDiMode);
procedure SetCellBorder(ACol, ARow: Integer; AValue: TsCellBorders);
procedure SetCellBorders(ALeft, ATop, ARight, ABottom: Integer; AValue: TsCellBorders);
procedure SetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder;
AValue: TsCellBorderStyle);
procedure SetCellBorderStyles(ALeft, ATop, ARight, ABottom: Integer;
ABorder: TsCellBorder; AValue: TsCellBorderStyle);
procedure SetCellComment(ACol, ARow: Integer; AValue: String);
procedure SetCellFont(ACol, ARow: Integer; AValue: TFont);
procedure SetCellFonts(ALeft, ATop, ARight, ABottom: Integer; AValue: TFont);
procedure SetCellFontColor(ACol, ARow: Integer; AValue: TsColor);
procedure SetCellFontColors(ALeft, ATop, ARight, ABottom: Integer; AValue: TsColor);
procedure SetCellFontName(ACol, ARow: Integer; AValue: String);
procedure SetCellFontNames(ALeft, ATop, ARight, ABottom: Integer; AValue: String);
procedure SetCellFontSize(ACol, ARow: Integer; AValue: Single);
procedure SetCellFontSizes(ALeft, ATop, ARight, ABottom: Integer; AValue: Single);
procedure SetCellFontStyle(ACol, ARow: Integer; AValue: TsFontStyles);
procedure SetCellFontStyles(ALeft, ATop, ARight, ABottom: Integer;
AValue: TsFontStyles);
procedure SetCellFormula(ACol, ARow: Integer; AValue: String);
procedure SetCellProtection(ACol, ARow: Integer; AValue: TsCellProtections);
procedure SetCellProtections(ALeft, ATop, ARight, ABottom: Integer;
AValue: TsCellProtections);
procedure SetCellValue(ACol, ARow: Integer; AValue: variant);
procedure SetColWidths(ACol: Integer; AValue: Integer);
procedure SetDefColWidth(AValue: Integer);
procedure SetDefRowHeight(AValue: Integer);
procedure SetEditorLineMode(AValue: TsEditorLineMode);
procedure SetFixedColWidth(AValue: Integer);
procedure SetFrozenCols(AValue: Integer);
procedure SetFrozenBorderPen(AValue: TPen);
procedure SetFrozenRows(AValue: Integer);
procedure SetHorAlignment(ACol, ARow: Integer; AValue: TsHorAlignment);
procedure SetHorAlignments(ALeft, ATop, ARight, ABottom: Integer;
AValue: TsHorAlignment);
procedure SetHyperlink(ACol, ARow: Integer; AValue: String);
procedure SetNumberFormat(ACol, ARow: Integer; AValue: String);
procedure SetNumberFormats(ALeft, ATop, ARight, ABottom: Integer; AValue: String);
procedure SetPageBreakPen(AValue: TPen);
procedure SetReadFormulas(AValue: Boolean);
procedure SetRowHeights(ARow: Integer; AValue: Integer);
procedure SetSelPen(AValue: TsSelPen);
procedure SetShowFormulas(AValue: Boolean);
procedure SetShowGridLines(AValue: Boolean);
procedure SetShowHeaders(AValue: Boolean);
procedure SetShowPageBreaks(AValue: Boolean);
procedure SetTextRotation(ACol, ARow: Integer; AValue: TsTextRotation);
procedure SetTextRotations(ALeft, ATop, ARight, ABottom: Integer;
AValue: TsTextRotation);
procedure SetVertAlignment(ACol, ARow: Integer; AValue: TsVertAlignment);
procedure SetVertAlignments(ALeft, ATop, ARight, ABottom: Integer;
AValue: TsVertAlignment);
procedure SetWorkbookSource(AValue: TsWorkbookSource);
procedure SetWordwrap(ACol, ARow: Integer; AValue: boolean);
procedure SetWordwraps(ALeft, ATop, ARight, ABottom: Integer; AValue: boolean);
procedure SetZoomFactor(AValue: Double);
procedure DragTimerElapsed(Sender: TObject);
procedure HyperlinkTimerElapsed(Sender: TObject);
protected
{ Protected declarations }
procedure AdaptToZoomFactor;
procedure AutoAdjustColumn(ACol: Integer); override;
procedure AutoAdjustRow(ARow: Integer); virtual;
procedure AutoExpandToCol(ACol: Integer; AMode: TsAutoExpandMode);
procedure AutoExpandToRow(ARow: Integer; AMode: TsAutoExpandMode);
function CalcTopLeft(AHeaderOnly: Boolean): TPoint;
function CalcWorksheetColWidth(AValue: Integer): Single;
function CalcWorksheetRowHeight(AValue: Integer): Single;
function CanEditShow: boolean; override;
function CellOverflow(ACol, ARow: Integer; AState: TGridDrawState;
out ACol1, ACol2: Integer; var ARect: TRect): Boolean;
procedure ColRowMoved(IsColumn: Boolean; FromIndex,ToIndex: Integer); override;
procedure CreateHandle; override;
procedure CreateNewWorkbook;
procedure DblClick; override;
procedure DefineProperties(Filer: TFiler); override;
procedure DoCopyToClipboard; override;
procedure DoCutToClipboard; override;
procedure DoEditorShow; override;
procedure DoEnter; override;
procedure DoExit; override;
procedure DoPasteFromClipboard; override;
procedure DoOnResize; override;
procedure DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); override;
procedure DragOver(ASource: TObject; X, Y: Integer; AState: TDragState;
var Accept: Boolean); override;
procedure DrawAllRows; override;
procedure DrawCellBorders(AGridPart: Integer = 0); 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 DrawDragSelection;
procedure DrawFocusRect(aCol,aRow:Integer; ARect:TRect); override;
procedure DrawFrozenPaneBorder(AStart, AEnd, ACoord: Integer; IsHor: Boolean);
procedure DrawFrozenPanes;
procedure DrawImages(AGridPart: Integer = 0);
procedure DrawPageBreaks(AClipRect: TRect); virtual;
procedure DrawRow(aRow: Integer); override;
procedure DrawSelection;
procedure DrawTextInCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override;
procedure EditorDoGetValue; override;
procedure ExecuteHyperlink;
procedure GenericPenChangeHandler(Sender: TObject);
function GetCellHeight(ACol, ARow: Integer): Integer;
function GetCellHintText(ACol, ARow: Integer): String; override;
function GetCells(ACol, ARow: Integer): String; override;
function GetCellText(ACol, ARow: Integer; ATrim: Boolean = true): String;
function GetEditText(ACol, ARow: Integer): String; override;
function GetDefaultColumnTitle(Column: Integer): string; override;
function GetIsCellTitle({%H-}ACol, ARow: Integer): boolean; override;
function HasBorder(ACell: PCell; ABorder: TsCellBorder): Boolean;
procedure HeaderSizing(const IsColumn:boolean; const AIndex,ASize:Integer); override;
procedure HeaderSized(IsColumn: Boolean; AIndex: Integer); override;
procedure InternalDrawCell(ACol, ARow: Integer; AClipRect, ACellRect: TRect;
AState: TGridDrawState);
procedure InternalDrawRow(ARow, AFirstCol, ALastCol: Integer;
AClipRect: TRect);
procedure InternalDrawSelection(ASel: TGridRect; IsNormalSelection: boolean);
procedure InternalDrawTextInCell(AText: String; ARect: TRect;
ACellHorAlign: TsHorAlignment; ACellVertAlign: TsVertAlignment;
ATextRot: TsTextRotation; ATextWrap: Boolean; AFontIndex: Integer;
AOverrideTextColor: TColor; ARichTextParams: TsRichTextParams;
AIsRightToLeft: Boolean);
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
procedure KeyUp(var Key : Word; Shift : TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
function MouseOnCellBorder(const APoint: TPoint;
const ACellRect: TGridRect): Boolean;
function MouseOnHeader(X, Y: Integer): Boolean;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
{$IFNDEF LCL_FullVersion_LT_190000}
function MoveNextSelectable(Relative: Boolean; DCol, DRow: Integer): Boolean; override;
{$ENDIF}
procedure MoveSelection; override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure PrepareCanvasFont;
function RelaxAutoExpand: TsAutoExpandModes;
procedure RestoreAutoExpand(AValue: TsAutoExpandModes);
function SelectCell(ACol, ARow: Integer): Boolean; override;
procedure SetEditText(ACol, ARow: Longint; const AValue: string); override;
procedure Setup;
function ToPixels(AValue: Double): Integer;
procedure TopLeftChanged; override;
function TrimToCell(ACell: PCell): String;
procedure ValidateInput(var Msg: TLMessage); message UM_VALIDATEINPUT;
function ValidFormula(AExpression: String; out AErrMsg: String): Boolean;
procedure WMHScroll(var message: TLMHScroll); message LM_HSCROLL;
procedure WMVScroll(var message: TLMVScroll); message LM_VSCROLL;
{@@ Allow built-in drag and drop }
property AllowDragAndDrop: Boolean read FAllowDragAndDrop
write FAllowDragAndDrop default true;
{@@ Automatically recalculate formulas whenever a cell value changes. }
property AutoCalc: Boolean read FAutoCalc write SetAutoCalc default false;
{@@ Automatically detect the cell's content type }
property AutoDetectCellType: Boolean read FAutoDetectCellType
write SetAutoDetectCellType default true;
{@@ Automatically expand grid dimensions }
property AutoExpand: TsAutoExpandModes read FAutoExpand write FAutoExpand
default [aeData, aeNavigation, aeDefault];
{@@ 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;
{@@ Determines whether a single- or multi-line cell editor is used }
property EditorLineMode: TsEditorLineMode read FLineMode write SetEditorLineMode
default elmSingleLine;
{@@ Width of the fixed row header column. 0 = auto width detection }
property FixedColWidth: Integer read FFixedColWidth
write SetFixedColWidth default 0;
{@@ 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;
{@@ Pen for the line separating the frozen cols/rows from the regular grid }
property FrozenBorderPen: TPen read FFrozenBorderPen write SetFrozenBorderPen;
{@@ 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;
{@@ Defines the pen used for the line drawn at the position of page breaks }
property PageBreakPen: TPen read FPageBreakPen write SetPageBreakPen;
{@@ 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;
{@@ Pen used for drawing the selection rectangle }
property SelectionPen: TsSelPen read FSelPen write SetSelPen;
{@@ Shows/hides formulas in grid when AutoCalc is off}
property ShowFormulas: Boolean read FShowFormulas write SetShowFormulas default false;
{@@ 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;
{@@ Shows/hides lines at the position of page breaks }
property ShowPageBreaks: Boolean read FShowPageBreaks write SetShowPageBreaks 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;
{@@ Event allowing to modifiy the text displayed in a column header}
property OnGetColHeaderText: TsGetCellTextEvent read FGetColHeaderText write FGetColHeaderText;
{@@ Event allowing to modifiy the text displayed in a row header }
property OnGetRowHeaderText: TsGetCellTextEvent read FGetRowHeaderText write FGetRowHeaderText;
public
{ public methods }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AutoColWidth(ACol: Integer);
procedure AutoRowHeight(ARow: Integer);
procedure BeginUpdate;
function CellRect(ACol1, ARow1, ACol2, ARow2: Integer): TRect; overload;
procedure Clear;
procedure DefaultDrawCell(ACol, ARow: Integer; var ARect: TRect;
AState: TGridDrawState); override;
procedure DeleteCol(AGridCol: Integer); reintroduce;
procedure DeleteRow(AGridRow: Integer); reintroduce;
procedure DragDrop(Source: TObject; X, Y: Integer); override;
function EditorByStyle(Style: TColumnButtonStyle): TWinControl; override;
procedure EndUpdate(ARefresh: Boolean = true);
function GetGridCol(ASheetCol: Cardinal): Integer; inline;
function GetGridRow(ASheetRow: Cardinal): Integer; inline;
procedure GetSheets(const ASheets: TStrings);
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 = -1); overload;
procedure LoadFromSpreadsheetFile(AFileName: string;
AFormatID: TsSpreadFormatID = sfidUnknown; AWorksheetIndex: Integer = -1); overload;
procedure LoadSheetFromSpreadsheetFile(AFileName: String;
AWorksheetIndex: Integer = -1; AFormatID: TsSpreadFormatID = sfidUnknown);
procedure LoadFromWorkbook(AWorkbook: TsWorkbook; AWorksheetIndex: Integer = -1);
procedure NewWorkbook(AColCount, ARowCount: Integer);
procedure SaveToSpreadsheetFile(AFileName: string;
AOverwriteExisting: Boolean = true); overload;
procedure SaveToSpreadsheetFile(AFileName: string; AFormat: TsSpreadsheetFormat;
AOverwriteExisting: Boolean = true); overload; deprecated;
procedure SaveToSpreadsheetFile(AFileName: string; AFormatID: TsSpreadFormatID;
AOverwriteExisting: Boolean = true); overload;
procedure SelectSheetByIndex(AIndex: Integer);
procedure MergeCells; overload;
procedure MergeCells(ARect: TGridRect); overload;
procedure MergeCells(ALeft, ATop, ARight, ABottom: Integer); overload;
procedure UnmergeCells; overload;
procedure UnmergeCells(ACol, ARow: Integer); overload;
procedure ShowCellBorders(ALeft, ATop, ARight, ABottom: Integer;
const ALeftOuterStyle, ATopOuterStyle, ARightOuterStyle, ABottomOuterStyle,
AHorInnerStyle, AVertInnerStyle: TsCellBorderStyle);
procedure ShowCol(ACol: Integer);
procedure HideCol(ACol: Integer);
procedure ShowRow(ARow: Integer);
procedure HideRow(ARow: Integer);
procedure Sort(AColSorting: Boolean; AIndex, AIndxFrom, AIndxTo:Integer); override;
{ Row height / col width calculation }
procedure UpdateColWidth(ACol: Integer);
procedure UpdateColWidths(AStartIndex: Integer = 0);
procedure UpdateRowHeight(ARow: Integer; AEnforceCalcRowHeight: Boolean = false);
procedure UpdateRowHeights(AStartRow: Integer = -1; AEnforceCalcRowHeight: Boolean = false);
{ Utilities related to Workbooks }
procedure Convert_sFont_to_Font(sFont: TsFont; AFont: TFont);
procedure Convert_Font_to_sFont(AFont: TFont; sFont: TsFont);
{ Interfacing with WorkbookSource}
procedure ListenerNotification(AChangedItems: TsNotificationItems;
AData: Pointer = nil);
procedure RemoveWorkbookSource;
{ public properties }
{@@ Link to the workbook }
property WorkbookSource: TsWorkbookSource read GetWorkbookSource 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;
{@@ 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[ALeft, ATop, ARight, ABottom: Integer]: TsColor
read GetBackgroundColors write SetBackgroundColors;
{@@ Override system or sheet right-to-left mode for cell }
property CellBiDiMode[ACol,ARow: Integer]: TsBiDiMode
read GetCellBiDiMode write SetCellBiDiMode;
{@@ 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[ALeft, ATop, ARight, ABottom: Integer]: 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[ALeft, ATop, ARight, ABottom: Integer;
ABorder: TsCellBorder]: TsCellBorderStyle
read GetCellBorderStyles write SetCellBorderStyles;
{@@ Comment assigned to the cell at column ACol and row ARow }
property CellComment[ACol, ARow: Integer]: String
read GetCellComment write SetCellComment;
{@@ 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[ALeft, ATop, ARight, ABottom: Integer]: TFont
read GetCellFonts write SetCellFonts;
{@@ Color of the font used for the cell in column ACol and row ARow }
property CellFontColor[ACol, ARow: Integer]: TsColor
read GetCellFontColor write SetCellFontColor;
{@@ Color of the font used for the cells within the range
of column/row indexes defined by the rectangle, scUndefined if not constant. }
property CellFontColors[ALeft, ATop, ARight, ABottom: Integer]: TsColor
read GetCellFontColors write SetCellFontColors;
{@@ Name of the font used for the cell in 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[ALeft, ATop, ARight, ABottom: Integer]: 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[ALeft, ATop, ARight, ABottom: Integer]: 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[ALeft, ATop, ARight, ABottom: Integer]: Single
read GetCellFontSizes write SetCellFontSizes;
{@@ Formula in the given cell, empty if there is no formula }
property CellFormula[ACol, ARow: Integer]: String
read GetCellFormula write SetCellFormula;
{@@ Cell protection elements assigned to the given cell }
property CellProtection[ACol, ARow: Integer]: TsCellProtections
read GetCellProtection write SetCellProtection;
{@@ Cell protection elements assigned to the given cell range. Empty if not
consistent with all cells. }
property CellProtections[ALeft, ATop, ARight, ABottom: Integer]: TsCellProtections
read GetCellProtections write SetCellProtections;
{@@ Cell values }
property Cells[ACol, ARow: Integer]: Variant
read GetCellValue write SetCellValue;
{@@ 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[ALeft, ATop, ARight, ABottom: Integer]: TsHorAlignment
read GetHorAlignments write SetHorAlignments;
{@@ Hyperlink assigned to the cell in row ARow and column ACol }
property Hyperlink[ACol, ARow: Integer]: String
read GetHyperlink write SetHyperlink;
{@@ Number format (as Excel string) to be applied to cell at column ACol and row ARow. }
property NumberFormat[ACol, ARow: Integer]: String
read GetNumberFormat write SetNumberFormat;
{@@ Number format (as Excel string) to be applied to all cells within the
range of column/row indexes defined by the rectangle. }
property NumberFormats[ALeft, ATop, ARight, ABottom: Integer]: String
read GetNumberFormats write SetNumberFormats;
{@@ 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[ALeft, ATop, ARight, ABottom: Integer]: TsTextRotation
read GetTextRotations write SetTextRotations;
{$IFNDEF LCL_FullVersion_LT_180}
{@@ Pixel coordinates of the top-left corner of the grid's cell area}
property TopLeftPx: TPoint read GetPxTopLeft;
{$ENDIF}
{@@ 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[ALeft, ATop, ARight, ABottom: Integer]: 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[ALeft, ATop, ARight, ABottom: Integer]: Boolean
read GetWordwraps write SetWordwraps;
{@@ Zoomfactor of the grid }
property ZoomFactor: Double
read GetZoomFactor write SetZoomFactor;
// inherited, but modified
{@@ Column width, in pixels }
property ColWidths[ACol: Integer]: Integer
read GetColWidths write SetColWidths;
{@@ Default column width, in pixels }
property DefaultColWidth: Integer
read GetDefColWidth write SetDefColWidth;
{@@ Default row height, in pixels }
property DefaultRowHeight: Integer
read GetDefRowHeight write SetDefRowHeight;
{@@ Row height in pixels }
property RowHeights[ARow: Integer]: Integer
read GetRowHeights write SetRowHeights;
// inherited
{$IFNDEF FPS_NO_GRID_MULTISELECT}
{@@ 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
{@@ Allow built-in drag and drop }
property AllowDragAndDrop;
{@@ Automatically recalculates the worksheet formulas if a cell value changes. }
property AutoCalc;
{@@ Automatically detect the cell's content type }
property AutoDetectCellType;
{@@ Automatically expand grid dimensions }
property AutoExpand;
{@@ Displays column and row headers in the fixed col/row style of the grid.
Deprecated. Use ShowHeaders instead. }
property DisplayFixedColRow; deprecated 'Use ShowHeaders';
{@@ Determines whether a single- or multiline cell editor is used }
property EditorLineMode;
{@@ Width of the first fixed column (= row headers), in pixels }
property FixedColWidth;
{@@ Pen for the line separating the frozen cols/rows from the regular grid }
property FrozenBorderPen;
{@@ 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;
{@@ Defines the pen used for the lines drawn at the position of page breaks }
property PageBreakPen;
{@@ Activates reading of RPN formulas. Should be turned off when
non-implemented formulas crashes reading of the spreadsheet file. }
property ReadFormulas;
{@@ Pen used for drawing the selection rectangle }
property SelectionPen;
{@@ Shows/hides formulas in grid cells when AutoCalc is off. }
property ShowFormulas;
{@@ 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;
{@@ Shows/hides lines at the position of page breaks }
property ShowPageBreaks;
{@@ 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 default 27; //stored;
//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;
{@@ inherited from ancestors }
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 default 101;
{@@ 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 TCustomWorksheetGrid}
property OnGetColHeaderText;
{@@ inherited from TCustomWorksheetGrid}
property OnGetRowHeaderText;
(*
{@@ 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 OnHeaderSizing;
{@@ 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;
var
{@@ Default number of columns prepared for a new empty worksheet }
DEFAULT_COL_COUNT: Integer = 26;
{@@ Default number of rows prepared for a new empty worksheet }
DEFAULT_ROW_COUNT: Integer = 100;
{@@ Tolerance for mouse for hitting cell border }
CELL_BORDER_DELTA: Integer = 4;
{@@ Cursor for copy operation during drag and drop }
crDragCopy: Integer;
implementation
uses
Types, LazUTF8, Math, StrUtils,
fpCanvas, {%H-}fpsPatches, fpsStrings, fpsUtils, fpsVisualUtils, fpsHTMLUtils,
fpsImages, fpsNumFormat, fpsExprParser;
const
{@@ 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;
{@@ Interval how long the mouse must stay on the border of the selected
cell for the drag-cursor to appear. }
DRAG_TIMER_INTERVAL = 200;
const
// Constants for AGridPart parameter
DRAW_NON_FROZEN = 0;
DRAW_FROZEN_ROWS = 1;
DRAW_FROZEN_COLS = 2;
DRAW_FROZEN_CORNER = 3;
var
{@@ Auxiliary bitmap containing the previously used non-trivial fill pattern }
FillPatternBitmap: TBitmap = nil;
FillPatternStyle: TsFillStyle;
FillPatternFgColor: TColor;
FillPatternBgColor: TColor;
DragBorderBitmap: TBitmap = nil;
{@@ ----------------------------------------------------------------------------
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
@returns 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;
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;
{*******************************************************************************
* TsSelPen *
*******************************************************************************}
constructor TsSelPen.Create;
begin
inherited;
Width := 3;
JoinStyle := pjsMiter;
end;
{*******************************************************************************
* TsMultiLineStringCellEditor *
*******************************************************************************}
constructor TsMultilineStringCellEditor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoSize := false;
end;
procedure TsMultilineStringCellEditor.Change;
begin
inherited Change;
if (FGrid <> nil) and Visible then
FGrid.EditorTextChanged(FCol, FRow, Text);
end;
procedure TsMultilineStringCellEditor.EditingDone;
begin
inherited EditingDone;
if FGrid <> nil then
FGrid.EditingDone;
end;
procedure TsMultilineStringCellEditor.KeyDown(var AKey: Word; AShift: TShiftState);
function AllSelected: boolean;
begin
Result := (SelLength > 0) and (SelLength = UTF8Length(Text));
end;
function AtStart: Boolean;
begin
Result:= (SelStart = 0);
end;
function AtEnd: Boolean;
begin
Result := ((SelStart + 1) > UTF8Length(Text)) or AllSelected;
end;
procedure DoEditorKeyDown;
begin
if FGrid <> nil then
FGrid.EditorkeyDown(Self, AKey, AShift);
end;
procedure DoGridKeyDown;
begin
if FGrid <> nil then
FGrid.KeyDown(AKey, AShift);
end;
function GetFastEntry: boolean;
begin
if FGrid <> nil then
Result := FGrid.FastEditing
else
Result := False;
end;
procedure CheckEditingKey;
begin
if (FGrid = nil) or FGrid.EditorIsReadOnly then
AKey := 0;
end;
var
IntSel: boolean;
begin
inherited KeyDown(AKey, AShift);
case AKey of
VK_F2:
if AllSelected then begin
SelLength := 0;
SelStart := Length(Text);
end;
VK_DELETE, VK_BACK:
CheckEditingKey;
VK_UP, VK_DOWN:
doGridKeyDown;
VK_LEFT, VK_RIGHT:
if GetFastEntry then begin
IntSel:=
((AKey = VK_LEFT) and not AtStart) or
((AKey = VK_RIGHT) and not AtEnd);
if not IntSel then begin
doGridKeyDown;
end;
end;
VK_END, VK_HOME:
;
VK_ESCAPE:
begin
doGridKeyDown;
if AKey <> 0 then begin
Text := FGrid.FOldEditorText;
FGrid.EditorHide;
end;
end;
else
DoEditorKeyDown;
end;
end;
procedure TsMultilineStringCellEditor.msg_GetGrid(var AMsg: TGridMessage);
begin
AMsg.Grid := FGrid;
AMsg.Options:= EO_IMPLEMENTED;
end;
procedure TsMultilineStringCellEditor.msg_GetValue(var AMsg: TGridMessage);
begin
AMsg.Col := FCol;
AMsg.Row := FRow;
AMsg.Value := Text;
end;
procedure TsMultilineStringCellEditor.msg_SelectAll(var AMsg: TGridMessage);
begin
Unused(AMsg);
SelectAll;
end;
procedure TsMultilineStringCellEditor.msg_SetGrid(var AMsg: TGridMessage);
begin
FGrid := AMsg.Grid as TsCustomWorksheetGrid;
AMsg.Options := EO_AUTOSIZE or EO_SELECTALL or EO_HOOKKEYPRESS or EO_HOOKKEYUP;
end;
procedure TsMultilineStringCellEditor.msg_SetPos(var AMsg: TGridMessage);
begin
FCol := AMsg.Col;
FRow := AMsg.Row;
end;
procedure TsMultilineStringCellEditor.msg_SetValue(var AMsg: TGridMessage);
begin
Text := AMsg.Value;
SelStart := UTF8Length(Text);
end;
procedure TsMultilineStringCellEditor.WndProc(var AMsg: TLMessage);
begin
if FGrid <> nil then
case AMsg.Msg of
LM_CLEAR, LM_CUT, LM_PASTE:
if FGrid.EditorIsReadOnly then exit;
end;
inherited WndProc(AMsg);
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
inc(FRowHeightLock);
FInternalWorkbookSource := TsWorkbookSource.Create(self);
FInternalWorkbookSource.Name := 'internal';
inc(FActiveCellLock);
inherited Create(AOwner);
dec(FActiveCellLock);
AutoAdvance := aaDown;
ExtendedSelect := true;
FHeaderCount := 1;
FAutoDetectCellType := true;
ColCount := DEFAULT_COL_COUNT + FHeaderCount;
RowCount := DEFAULT_ROW_COUNT + FHeaderCount;
FDefRowHeight100 := inherited GetDefaultRowHeight;
FDefColWidth100 := inherited DefaultColWidth;
FFixedColWidth := 0;
FCellFont := TFont.Create;
FSelPen := TsSelPen.Create;
FSelPen.Style := psSolid;
FSelPen.Color := clBlack;
FSelPen.JoinStyle := pjsMiter;
FSelPen.OnChange := @GenericPenChangeHandler;
FFrozenBorderPen := TPen.Create;
FFrozenBorderPen.Style := psSolid;
FFrozenBorderPen.Color := clBlack;
FFrozenBorderPen.OnChange := @GenericPenChangeHandler;
FPageBreakPen := TPen.Create;
FPageBreakPen.Style := psDash;
FPageBreakPen.Color := clBlue;
FPageBreakPen.OnChange := @GenericPenChangeHandler;
FShowPageBreaks := true;
FAutoExpand := [aeData, aeNavigation, aeDefault];
FHyperlinkTimer := TTimer.Create(self);
FHyperlinkTimer.Interval := HYPERLINK_TIMER_INTERVAL;
FHyperlinkTimer.OnTimer := @HyperlinkTimerElapsed;
FDragTimer := TTimer.Create(self);
FDragTimer.Interval := DRAG_TIMER_INTERVAL;
FDragTimer.OnTimer := @DragTimerElapsed;
FAllowDragAndDrop := true;
SetWorkbookSource(FInternalWorkbookSource);
{$IFNDEF FPS_NO_GRID_MULTISELECT}
RangeSelectMode := rsmMulti;
{$ENDIF}
dec(FRowHeightLock);
UpdateRowHeights;
end;
{@@ ----------------------------------------------------------------------------
Destructor of the grid: Destroys the workbook and the internal CellFont.
-------------------------------------------------------------------------------}
destructor TsCustomWorksheetGrid.Destroy;
begin
SetWorkbookSource(nil);
if FInternalWorkbookSource <> nil then
FInternalWorkbookSource.RemoveListener(self); // will be destroyed automatically
FreeAndNil(FCellFont);
FreeAndNil(FSelPen);
FreeAndNil(FPageBreakPen);
FreeAndNil(FFrozenBorderPen);
FreeAndNil(FMultiLineStringEditor);
inherited Destroy;
end;
procedure TsCustomWorksheetGrid.AdaptToZoomFactor;
var
c, r: Integer;
begin
inc(FZoomLock);
DefaultRowHeight := round(GetZoomfactor * FDefRowHeight100);
DefaultColWidth := round(GetZoomFactor * FDefColWidth100);
UpdateColWidths;
UpdateRowHeights;
dec(FZoomLock);
// Bring active cell back into the viewport: There is a ScrollToCell but
// this method is private. It is called by SetCol/SetRow, though.
if ((Col < GCache.Visiblegrid.Left) or (Col >= GCache.VisibleGrid.Right)) and
(GCache.VisibleGrid.Left <> GCache.VisibleGrid.Right) then
begin
c := Col;
Col := c-1; // "Col" must change in order to call ScrtollToCell
Col := c;
end;
if ((Row < GCache.VisibleGrid.Top) or (Row >= GCache.VisibleGrid.Bottom)) and
(GCache.VisibleGrid.Top <> GCache.VisibleGrid.Bottom) then
begin
r := Row;
Row := r-1;
Row := r;
end;
end;
procedure TsCustomWorksheetGrid.AutoColWidth(ACol: Integer);
begin
AutoAdjustColumn(ACol);
end;
procedure TscustomWorksheetGrid.AutoRowHeight(ARow: Integer);
begin
AutoAdjustRow(ARow);
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
w, maxw: Integer;
txt: String;
cell: PCell;
RTL: Boolean;
begin
if Worksheet = nil then
exit;
RTL := IsRightToLeft;
maxw := -1;
for cell in Worksheet.Cells.GetColEnumerator(GetWorkSheetCol(ACol)) do
begin
// Merged cells are not considered for calculating AutoColWidth -- see Excel.
if Worksheet.IsMerged(cell) then
continue;
gRow := GetGridRow(cell^.Row);
txt := GetCellText(ACol, gRow, false);
if txt = '' then
Continue;
case Worksheet.ReadBiDiMode(cell) of
bdRTL: RTL := true;
bdLTR: RTL := false;
end;
w := RichTextWidth(Canvas, Workbook, Rect(0, 0, MaxInt, MaxInt),
txt, cell^.RichTextParams, Worksheet.ReadCellFontIndex(cell),
Worksheet.ReadTextRotation(cell), false, RTL, ZoomFactor);
if 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
inc(FZoomLock);
if Worksheet <> nil then
RowHeights[ARow] := CalcAutoRowHeight(ARow)
else
RowHeights[ARow] := DefaultRowHeight;
HeaderSized(false, ARow);
dec(FZoomLock);
end;
{@@ ----------------------------------------------------------------------------
Automatically expands the ColCount such that the specified column fits in
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.AutoExpandToCol(ACol: Integer;
AMode: TsAutoExpandMode);
begin
if ACol >= ColCount then
begin
if (AMode in FAutoExpand) then
ColCount := ACol + 1
else
raise Exception.CreateFmt(rsOperationExceedsColCount, [ACol, ColCount]);
end;
end;
{@@ ----------------------------------------------------------------------------
Automatically expands the RowCount such that the specified column fits in
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.AutoExpandToRow(ARow: Integer;
AMode: TsAutoExpandMode);
begin
if ARow >= RowCount then
begin
if (AMode in FAutoExpand) then
RowCount := ARow + 1
else
raise Exception.CreateFmt(rsOperationExceedsRowCount, [ARow, RowCount]);
end;
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);
Workbook.DisableNotifications;
Workbook.LockFormulas;
inherited BeginUpdate;
end;
{@@ ----------------------------------------------------------------------------
Converts the column width, given in units used by the worksheet, to pixels.
@param AWidth Width of a column in units used by the worksheet
@return Column width in pixels.
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.CalcColWidthFromSheet(AWidth: Single): Integer;
var
w_pts: Double;
begin
w_pts := Workbook.ConvertUnits(AWidth, Workbook.Units, suPoints);
Result := PtsToPx(w_pts, Screen.PixelsPerInch);
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)); // Zoom factor is applied to font size
if h = 0 then
Result := DefaultRowHeight // Zoom factor applied by getter function
else
Result := h;
end;
{@@ ----------------------------------------------------------------------------
Converts the row height (from a worksheet row record), given in units used by
the sheet, to pixels as needed by the grid
@param AHeight Row height expressed in units used by the worksheet.
@returns Row height in pixels.
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.CalcRowHeightFromSheet(AHeight: Single): Integer;
var
h_pts: Single;
begin
h_pts := Workbook.ConvertUnits(abs(AHeight), Workbook.Units, suPoints);;
Result := PtsToPx(h_pts, Screen.PixelsPerInch); // + 4;
end;
function TsCustomWorksheetGrid.CalcRowHeightToSheet(AHeight: Integer): Single;
var
h_pts: Single;
begin
h_pts := PxToPts(AHeight, Screen.PixelsPerInch);
Result := Workbook.ConvertUnits(h_pts, suPoints, Workbook.Units);
end;
{@@ ----------------------------------------------------------------------------
Calculates the top-left corner (in pixels) of the area which can be
scrolled. Is bordered by the fixed header cells and the frozen columns and
rows.
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.CalcTopLeft(AHeaderOnly: Boolean): TPoint;
var
fc, fr: Integer;
tmp: Integer = 0;
begin
Result := Point(0, 0); // to silence the compiler...
fc := IfThen(AHeaderOnly, FHeaderCount, FHeaderCount + FFrozenCols);
if IsRightToLeft then
begin
if fc > 0 then
ColRowToOffset(true, true, fc-1, Result.X, tmp)
else
Result.X := ClientRect.Right;
end else
begin
if fc > 0 then
ColRowToOffset(true, true, fc-1, tmp, Result.X)
else
Result.X := ClientRect.Left;
end;
fr := IfThen(AHeaderOnly, FHeaderCount, FHeaderCount + FFrozenRows);
if fr > 0 then
ColRowToOffset(false, true, fr-1, tmp, Result.Y)
else
Result.Y := ClientRect.Top;
end;
{@@ ----------------------------------------------------------------------------
Converts the column height given in screen pixels to the units used by the
worksheet.
@param AValue Column width in pixels
@returns Column width expressed in units defined by the workbook.
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.CalcWorksheetColWidth(AValue: Integer): Single;
var
w_pts: Double;
begin
Result := 0;
if Worksheet <> nil then
begin
// The grid's column width is in "pixels", the worksheet's column width
// has the units defined by the workbook.
w_pts := PxToPts(AValue/ZoomFactor, Screen.PixelsPerInch);
Result := Workbook.ConvertUnits(w_pts, suPoints, Workbook.Units);
end;
end;
{@@ ----------------------------------------------------------------------------
Converts the row height given in screen pixels to the units used by the
worksheet.
@param AValue Row height in pixels
@returns Row height expressed in units defined by the workbook.
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.CalcWorksheetRowHeight(AValue: Integer): Single;
var
h_pts: Double;
begin
Result := 0;
if Worksheet <> nil then
begin
// The grid's row heights are in "pixels", the worksheet's row height
// has the units defined by the workbook.
h_pts := PxToPts(AValue/ZoomFactor, Screen.PixelsPerInch);
Result := Workbook.ConvertUnits(h_pts, suPoints, Workbook.Units);
end;
end;
function TsCustomWorksheetGrid.CanEditShow: Boolean;
begin
Result := inherited and (not FReadOnly);
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
@returns @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;
fc: Integer;
idx: Integer;
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;
idx := Worksheet.GetEffectiveCellFormatIndex(cell);
fmt := Workbook.GetPointerToCellFormat(idx);
if (uffWordWrap in fmt^.UsedFormattingFields) then // ... word-wrap
exit;
if (uffTextRotation in fmt^.UsedFormattingFields) and // ... vertical text
(fmt^.TextRotation <> trHorizontal)
then
exit;
fc := FHeaderCount + FFrozenCols;
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,
haJustified, haDistributed, haFilled, // to do: get a separate option for these
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 > fc) 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 > fc) 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;
function TsCustomWorksheetGrid.CellRect(ACol1, ARow1, ACol2, ARow2: Integer): TRect;
var
cmin, cmax: Integer;
rmin, rmax: Integer;
tmp: Integer = 0;
begin
Result := Rect(0, 0, 0, 0); // to silence the compiler...
cmin := Min(ACol1, ACol2);
cmax := Max(ACol1, ACol2);
rmin := Min(ARow1, ARow2);
rmax := Max(ARow1, ARow2);
if IsRightToLeft then begin
ColRowToOffset(True, True, cmin, tmp, Result.Right);
ColRowToOffset(True, True, cmax, Result.Left, tmp);
end else
begin
ColRowToOffset(True, True, cmin, Result.Left, tmp);
ColRowToOffset(True, True, cmax, tmp, Result.Right);
end;
ColRowToOffSet(False, True, rmin, Result.Top, tmp);
ColRowToOffset(False, True, rmax, tmp, Result.Bottom);
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;
{@@ ----------------------------------------------------------------------------
Clears the grid contents
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.Clear;
begin
if (Worksheet <> nil) then Worksheet.Clear;
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(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(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));
// Update following row heights because their index has changed
UpdateRowHeights(AGridRow);
end;
procedure TsCustomWorksheetGrid.ColRowMoved(IsColumn: Boolean;
FromIndex,ToIndex: Integer);
begin
inherited;
if IsColumn then
Worksheet.MoveCol(GetWorksheetCol(FromIndex), GetWorksheetCol(ToIndex));
end;
procedure TsCustomWorksheetGrid.CreateHandle;
begin
inherited;
Setup;
end;
{@@ ----------------------------------------------------------------------------
Creates a new empty workbook into which a file will be loaded. Destroys the
previously used workbook.
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.CreateNewWorkbook;
begin
GetWorkbookSource.CreateNewWorkbook;
if FReadFormulas then
WorkbookSource.Options := WorkbookSource.Options + [boReadFormulas] else
WorkbookSource.Options := Workbooksource.Options - [boReadFormulas];
SetAutoCalc(FAutoCalc);
SetAutoDetectCellType(FAutoDetectCellType);
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
//inherited;
// Don't call inherited, this is where the ColWidths/RowHeights are written
// to the lfm file - we don't need them, we get them from the workbook!
Unused(Filer);
end;
procedure TsCustomWorksheetGrid.DoCopyToClipboard;
begin
WorkbookSource.CopyCellsToClipboard;
end;
procedure TsCustomWorksheetGrid.DoCutToClipboard;
begin
// This next comment does not seem to be valid any more: Issue handled by eating key in KeyDown
// Remove for the moment: If TsCopyActions is available this code would be executed twice (and destroy the clipboard)
WorkbookSource.CutCellsToClipboard;
end;
procedure TsCustomWorksheetGrid.DoPasteFromClipboard;
begin
// This next comment does not seem to be valid any more: Issue handled by eating key in KeyDown
// Remove for the moment: If TsPasteActions is available this code would be executed twice
WorkbookSource.PasteCellsFromClipboard(coCopyCell);
end;
{ Make the cell editor the same size as the edited cell, in particular for
even for merged cells; otherwise the merge base content would be seen during
editing at several places. }
procedure TsCustomWorksheetGrid.DoEditorShow;
var
r1, c1, r2, c2: Cardinal;
cell: PCell;
Rct: TRect;
delta: Integer;
begin
FOldEditorText := GetCellText(Col, Row);
inherited;
if Worksheet = nil then
exit;
if (Editor is TStringCellEditor) or (Editor is TsMultiLineStringCellEditor) then
begin
delta := FSelPen.Width div 2;
cell := Worksheet.FindCell(GetWorksheetRow(Row), GetWorksheetCol(Col));
if Worksheet.IsMerged(cell) then begin
Worksheet.FindMergedRange(cell, r1,c1,r2,c2);
Rct := CellRect(GetGridCol(c1), GetGridRow(r1), GetGridCol(c2), GetGridRow(r2));
end else
Rct := CellRect(Col, Row);
InflateRect(Rct, -delta, -delta);
inc(Rct.Top);
if not odd(FSelPen.Width) then dec(Rct.Left);
Editor.Font := CellFont[Col, Row];
Editor.Font.Height := Round(Font.Height * ZoomFactor);
Editor.Color := BackgroundColor[Col, Row];
Editor.SetBounds(Rct.Left, Rct.Top, Rct.Right-Rct.Left-1, Rct.Bottom-Rct.Top-1);
end;
end;
procedure TsCustomWorksheetGrid.DoEnter;
begin
if FRefocusing = self then
FRefocusing := nil;
inherited;
end;
procedure TsCustomWorksheetGrid.DoExit;
var
ed: TWinControl;
begin
{ Post a message to myself which indicates it's time to validate the input.
Pass the grid instance (Self) as the message lParam. }
if FRefocusing = nil then begin
ed := EditorByStyle(cbsAuto);
if ed is TCustomEdit then
FRefocusingSelStart := TCustomEdit(ed).SelStart;
PostMessage(Handle, um_ValidateInput, 0, LParam(Self));
end;
FGridState := gsNormal;
end;
procedure TsCustomWorksheetGrid.DoOnResize;
begin
if (csDesigning in ComponentState) and (Worksheet = nil) then
NewWorkbook(ColCount, RowCount);
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;
isSelected: Boolean;
fgcolor, bgcolor: TColor;
// numFmt: TsNumFormatParams;
begin
GetSelectedState(AState, isSelected);
Canvas.Font.Assign(Font);
//Canvas.Font.Height := Round(ZoomFactor * Canvas.Font.Height);
Canvas.Brush.Bitmap := nil;
Canvas.Brush.Color := Color;
ts := Canvas.TextStyle;
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;
fmt := Worksheet.GetPointerToEffectiveCellFormat(r, c);
lCell := Worksheet.FindCell(r, c);
//if lCell <> nil then
//begin
// fmt := Workbook.GetPointerToCellFormat(lCell^.FormatIndex);
// numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
// Background color
if (uffBackground in fmt^.UsedFormattingFields) then
begin
if Workbook.FileFormatID = ord(sfExcel2) then
begin
CreateFillPattern(FillPatternBitmap, fsGray12, 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 := fmt^.Background.FgColor and $00FFFFFF;
end;
else
if fmt^.Background.BgColor = scTransparent
then bgcolor := Color
else bgcolor := fmt^.Background.BgColor and $00FFFFFF;
if fmt^.Background.FgColor = scTransparent
then fgcolor := Color
else fgcolor := fmt^.Background.FgColor and $00FFFFFF;
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 (lcell <> nil) and Worksheet.HasHyperlink(lCell) then
fnt := Workbook.GetHyperlinkFont
else
fnt := Workbook.GetDefaultFont;
if (uffFont in fmt^.UsedFormattingFields) then
fnt := Workbook.GetFont(fmt^.FontIndex);
Convert_sFont_to_Font(fnt, Canvas.Font);
Canvas.Font.Height := Round(ZoomFactor * Canvas.Font.Height);
// Wordwrap, text alignment and text rotation are handled by "DrawTextInCell".
//end;
end;
if IsSelected then
Canvas.Brush.Color := CalcSelectionColor(Canvas.Brush.Color, 16);
Canvas.TextStyle := ts;
inherited DoPrepareCanvas(ACol, ARow, AState);
end;
procedure TsCustomWorksheetGrid.DragDrop(Source: TObject; X, Y: Integer);
var
sel: TsCellRange;
srccell, destcell: PCell;
r: LongInt = 0;
c: LongInt = 0;
dr, dc: LongInt;
dragMove: Boolean;
begin
Unused(X, Y);
inherited;
if not ((goEditing in Options)) or (not FAllowDragAndDrop) then
Exit;
// Offset of col/row coordinates from source to destination cell
MouseToCell(X,Y, c, r);
dr := r - FDragStartRow;
dc := c - FDragStartCol;
// Copy cells or only move them?
dragMove := not (ssCtrl in GetKeyShiftState);
// Copy cells to destination and delete the source cells if required.
for sel in Worksheet.GetSelection do
begin
for r := sel.Row1 to sel.Row2 do
for c := sel.Col1 to sel.Col2 do
begin
srccell := Worksheet.FindCell(r, c);
if Worksheet.IsMerged(srccell) then
srccell := Worksheet.FindMergeBase(srccell);
if srccell <> nil then begin
destcell := Worksheet.GetCell(r + dr, c + dc);
if dragMove then
Worksheet.MoveCell(srccell, destcell^.Row, destcell^.Col)
else
Worksheet.CopyCell(srccell, destcell);
end;
end;
end;
end;
procedure TsCustomWorksheetGrid.DragOver(ASource: TObject; X, Y: Integer;
AState: TDragState; var Accept: Boolean);
var
destcell: PCell;
sc, sr: Integer;
gc: Integer = 0;
gr: Integer = 0;
dc, dr: Integer;
sel: TsCellRange;
dragMove: Boolean;
begin
inherited;
Unused(AState);
if FAllowDragAndDrop and (ASource = self) and (goEditing in Options) then
begin
MouseToCell(X,Y, gc, gr);
// Don't drop over over the header cells
if (gc < FHeaderCount) or (gr < FHeaderCount) then
exit;
// Find dragged selection rectangle
dc := gc - FDragStartCol;
dr := gr - FDragStartRow;
FDragSelection := Selection;
OffsetRect(FDragSelection, dc, dr);
// Draw dragged selection rectangle
if (FOldDragStartRow <> gr) or (FOldDragStartCol <> gc) then
Invalidate;
FOldDragStartRow := gr;
FOldDragStartCol := gc;
// Change mouse cursor: Copy or Move
dragMove := not (ssCtrl in GetKeyShiftState);
if dragMove then
DragCursor := crDrag
else
DragCursor := crDragCopy;
if Worksheet.IsProtected then
// Allow drop only if no destination cell is locked
for sel in Worksheet.GetSelection do
for sr := sel.Row1 to sel.Row2 do
for sc := sel.Col1 to sel.Col2 do
begin
destcell := Worksheet.FindCell(sr + dr, sc + dc);
if (cpLockCell in Worksheet.ReadCellProtection(destcell)) then
exit;
end;
Accept := true;
end;
end;
procedure TsCustomWorksheetGrid.DragTimerElapsed(Sender: TObject);
var
P: TPoint;
begin
FDragTimer.Enabled := false;
P := ScreenToClient(Mouse.CursorPos);
if MouseOnCellBorder(P, Selection) then
Cursor := crSize
else
Cursor := crDefault;
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;
//fc, fr: Integer;
TL: TPoint;
begin
inherited;
if Worksheet = nil then
exit;
FTopLeft := CalcTopLeft(false);
if (FrozenRows > 0) or (FrozenCols > 0) then
DrawFrozenPanes;
// Set cliprect for scrollable grid area
cliprect := ClientRect;
TL := CalcTopLeft(false);
if IsRightToLeft then
cliprect.Right := TL.X + 1
else
cliprect.Left := TL.X - 1;
cliprect.Top := TL.Y;
DrawPageBreaks(cliprect);
// Paint cell borders, selection rectangle, images and frozen-pane-borders
// into this clipped area
rgn := CreateRectRgn(cliprect.Left, cliprect.top, cliprect.Right, cliprect.Bottom);
try
SelectClipRgn(Canvas.Handle, Rgn);
DrawCellBorders;
DrawSelection;
DrawDragSelection;
DrawImages(DRAW_NON_FROZEN);
// DrawFrozenPaneBorders(clipRect);
finally
DeleteObject(rgn);
end;
end;
procedure TsCustomWorksheetGrid.DrawFrozenPanes;
var
cliprect, R: TRect;
rgn: HRGN;
tmp: Integer = 0;
fc, fr: Integer;
begin
if Worksheet = nil then
exit;
Canvas.SaveHandleState;
try
// Avoid painting into header cells.
R := ClientRect;
if HeaderCount > 0 then begin
ColRowToOffset(false, True, 0, tmp, R.Top);
if IsRightToLeft then
ColRowToOffset(true, True, 0, R.Right, tmp)
else
ColRowToOffset(true, True, 0, tmp, R.Left);
end;
fr := FHeaderCount + FFrozenRows;
fc := FHeaderCount + FFrozenCols;
// Paint cell border in frozen rows
if fr > 0 then begin
if IsRightToLeft then
clipRect := Rect(ClientRect.Left, ClientRect.Top, FTopLeft.X, FTopLeft.Y)
else
cliprect := Rect(FTopLeft.X, ClientRect.Top, ClientRect.Right, FTopLeft.Y);
rgn := CreateRectRgn(cliprect.Left, cliprect.Top, cliprect.Right, cliprect.Bottom);
try
SelectClipRgn(Canvas.Handle, rgn);
DrawCellBorders(DRAW_FROZEN_ROWS);
DrawImages(DRAW_FROZEN_ROWS);
DrawFrozenPaneBorder(cliprect.Left, clipRect.Right, cliprect.Bottom-1, true);
finally
DeleteObject(rgn);
end;
end;
// Paint cell border in frozen columns
if fc > 0 then begin
if IsRightToLeft then
cliprect := Rect(FTopLeft.X, FTopLeft.Y, ClientRect.Right, ClientRect.Bottom)
else
cliprect := Rect(ClientRect.Left, FTopLeft.Y, FTopLeft.X, ClientRect.Bottom);
rgn := CreateRectRgn(cliprect.Left, cliprect.Top, cliprect.Right, cliprect.Bottom);
try
SelectClipRgn(Canvas.Handle, rgn);
DrawCellBorders(DRAW_FROZEN_COLS);
DrawImages(DRAW_FROZEN_COLS);
if IsRightToLeft then
DrawFrozenPaneBorder(cliprect.Top, cliprect.Bottom, cliprect.Left+1, false)
else
DrawFrozenPaneBorder(cliprect.Top, cliprect.Bottom, cliprect.Right-1, false);
finally
DeleteObject(rgn);
end;
end;
// Paint intersection of frozen cols and frozen rows
if (fr > 0) and (fc > 0) then begin
if IsRightToLeft then
cliprect := Rect(FTopLeft.X, ClientRect.Top, ClientRect.Right, FTopLeft.Y)
else
cliprect := Rect(ClientRect.Left, ClientRect.Top, FTopLeft.X, FTopLeft.Y);
rgn := CreateRectRgn(clipRect.Left, cliprect.Top, cliprect.Right, cliprect.Bottom);
try
SelectClipRgn(Canvas.Handle, rgn);
DrawCellBorders(DRAW_FROZEN_CORNER);
DrawImages(DRAW_FROZEN_CORNER);
finally
DeleteObject(rgn);
end;
end;
finally
Canvas.RestoreHandleState;
end;
end;
{@@ ----------------------------------------------------------------------------
Draws the borders of all cells. Calls DrawCellBorders for each individual cell.
AGridPart denotes where the cells are painted:
@unorderedlist(
@item(0 = normal grid area)
@item(1 = FrozenRows)
@item(2 = FrozenCols)
@item(3 = Top-left corner where FrozenCols and FrozenRows intersect)
)
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.DrawCellBorders(AGridPart: Integer = 0);
var
cell, base: PCell;
gc, gr: Integer;
sr1, sc1, sr2, sc2: Cardinal;
rect: TRect;
cellHasBorder: Boolean;
begin
if Worksheet = nil then
exit;
case AGridPart of
0: begin
sr1 := GetWorksheetRow(GCache.VisibleGrid.Top);
sc1 := GetWorksheetCol(GCache.VisibleGrid.Left);
sr2 := GetWorksheetRow(GCache.VisibleGrid.Bottom);
sc2 := GetWorksheetCol(GCache.VisibleGrid.Right);
end;
1: begin
sr1 := 0;
if FFrozenRows = 0 then sr2 := 0 else sr2 := FFrozenRows - 1;
if FFrozenCols = 0 then sc1 := 0 else sc1 := FFrozenCols - 1;
sc2 := GetWorksheetCol(GCache.VisibleGrid.Right);
end;
2: begin
sc1 := 0;
if FFrozenCols = 0 then sc2 := 0 else sc2 := FFrozenCols - 1;
if FFrozenRows = 0 then sr1 := 0 else sr1 := FFrozenRows - 1;
sr2 := GetWorksheetRow(GCache.VisibleGrid.Bottom);
end;
3: begin
sc1 := 0;
if FFrozenCols = 0 then sc2 := 0 else sc2 := FFrozenCols - 1;
sr1 := 0;
if FFrozenRows = 0 then sr2 := 0 else sr2 := FFrozenRows - 1;
end;
end;
if sr1 = UNASSIGNED_ROW_COL_INDEX then sr1 := 0;
if sc1 = UNASSIGNED_ROW_COL_INDEX then sc1 := 0;
for cell in Worksheet.Cells.GetRangeEnumerator(sr1, sc1, sr2, sc2) do
begin
if Worksheet.IsMerged(cell) then
begin
base := Worksheet.FindMergeBase(cell);
cellHasBorder := uffBorder in Worksheet.ReadUsedFormatting(base);
end else
cellHasBorder := uffBorder in Worksheet.ReadUsedFormatting(cell);
if cellHasBorder then
begin
gc := GetGridCol(cell^.Col);
gr := GetGridRow(cell^.Row);
rect := CellRect(gc, gr);
DrawCellBorders(gc, gr, 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,
// lsMediumDash, lsDashDot, lsMediumDashDot, lsDashDotDot, lsMediumDashDotDot,
// lsSlantDashDot);
PEN_STYLES: array[TsLineStyle] of TPenStyle =
(psSolid, psSolid, psDash, psDot, psSolid, psSolid, psDot,
psDash, psDashDot, psDashDot, psDashDotDot, psDashDotDot,
psDashDot);
PEN_WIDTHS: array[TsLineStyle] of Integer =
(1, 2, 1, 1, 3, 1, 1,
2, 1, 2, 1, 2,
2);
var
deltax, deltay: Integer;
angle: Double;
savedCosmetic: Boolean;
begin
savedCosmetic := Canvas.Pen.Cosmetic;
Canvas.Pen.Style := PEN_STYLES[ABorderStyle.LineStyle];
Canvas.Pen.Width := PEN_WIDTHS[ABorderStyle.LineStyle];
Canvas.Pen.Color := ABorderStyle.Color and $00FFFFFF;
Canvas.Pen.EndCap := pecSquare;
if ABorderStyle.LineStyle = lsHair then
Canvas.Pen.Cosmetic := false;
// Painting
case ABorderStyle.LineStyle of
lsThin, lsMedium, lsThick, lsDotted, lsDashed, lsDashDot, lsDashDotDot,
lsMediumDash, lsMediumDashDot, lsMediumDashDotDot, lsSlantDashDot, lsHair:
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;
Canvas.Pen.Cosmetic := savedCosmetic;
end;
var
bs: TsCellBorderStyle;
fmt: PsCellFormat;
idx: Integer;
r1, c1, r2, c2: Cardinal;
begin
if Assigned(Worksheet) then begin
if Worksheet.IsMergeBase(ACell) then begin
Worksheet.FindMergedRange(ACell, r1, c1, r2, c2);
ARect := CellRect(GetGridCol(c1), GetGridRow(r1), GetGridCol(c2), GetGridRow(r2));
end;
// Left border
if GetBorderStyle(ACol, ARow, -1, 0, ACell, bs) and (ACol <> LeftCol) then
if IsRightToLeft then
DrawBorderLine(ARect.Right, ARect, drawVert, bs)
else
DrawBorderLine(ARect.Left-ord(not IsRightToLeft), ARect, drawVert, bs);
// Right border
if GetBorderStyle(ACol, ARow, +1, 0, ACell, bs) and (ACol + 1 <> LeftCol) then
if IsRightToLeft then
DrawBorderLine(ARect.Left, ARect, drawVert, bs)
else
DrawBorderLine(ARect.Right-ord(not IsRightToLeft), 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
idx := Worksheet.GetEffectiveCellFormatIndex(ACell);
fmt := Workbook.GetPointerToCellFormat(idx);
// fmt := Worksheet.GetPointerToEffectiveCellFormat(ACell);
// Diagonal up
if cbDiagUp in fmt^.Border then begin
bs := fmt^.Borderstyles[cbDiagUp];
if IsRightToLeft then
DrawBorderLine(0, ARect, drawDiagDown, bs)
else
DrawBorderLine(0, ARect, drawDiagUp, bs);
end;
// Diagonal down
if cbDiagDown in fmt^.Border then begin
bs := fmt^.BorderStyles[cbDiagDown];
if IsRightToLeft then
DrawBorderLine(0, ARect, drawDiagUp, bs)
else
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;
commentSize: Integer;
begin
Canvas.Brush.Color := clRed;
Canvas.Brush.Style := bsSolid;
Canvas.Pen.Style := psClear;
{$IFDEF LCL_FULLVERSION_LT_180}
commentSize := ScalePPI(COMMENT_SIZE);
{$ELSE}
commentSize := Scale96ToFont(COMMENT_SIZE);
{$ENDIF}
if IsRightToLeft then
begin
P[0] := Point(ARect.Left, ARect.Top);
P[1] := Point(ARect.Left + commentSize, ARect.Top);
P[2] := Point(ARect.Left, ARect.Top + commentSize);
end else
begin
P[0] := Point(ARect.Right, ARect.Top);
P[1] := Point(ARect.Right - commentSize, ARect.Top);
P[2] := Point(ARect.Right, ARect.Top + commentSize);
end;
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 AStart Start coordinate of the pane border line
@param AEnd End coordinate of the pane border line
@param ACoord Other coordinate of the border line (y if horizontal, x if vertical)
@param(IsHor Determines whether a horizontal or vertical line is drawn and,
thus, how AStart, AEnd and ACoord are interpreted.)
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.DrawFrozenPaneBorder(AStart, AEnd, ACoord: Integer;
IsHor: Boolean);
var
delta: Integer;
begin
if (IsHor and (FFrozenRows = 0)) or (not IsHor and (FFrozenCols = 0)) then
exit;
if FFrozenBorderPen.Style = psClear then
exit;
delta := (FFrozenBorderPen.Width - 1) div 2;
Canvas.Pen.Assign(FFrozenBorderPen);
if IsHor then
Canvas.Line(AStart, ACoord-delta, AEnd, ACoord-delta)
else
if IsRightToLeft then
Canvas.Line(ACoord+delta, AStart, ACoord+delta, AEnd)
else
Canvas.Line(ACoord-delta, AStart, ACoord-delta, AEnd);
end;
{@@ ----------------------------------------------------------------------------
Draws the embedded images of the worksheet. Is called at the end of the
painting process.
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.DrawImages(AGridPart: Integer);
procedure CalcClipRect(var ARect: TRect);
var
headerTL: TPoint;
begin
ARect := ClientRect;
headerTL := CalcTopLeft(true);
case AGridPart of
DRAW_NON_FROZEN:
begin
if IsRightToLeft then
ARect.Right := FTopLeft.X
else
ARect.Left := FTopLeft.X;
ARect.Top := FTopLeft.Y;
end;
DRAW_FROZEN_ROWS:
begin
if IsRightToLeft then
ARect.Right := FTopLeft.X
else
ARect.Left := FTopLeft.X;
ARect.Top := headerTL.Y;
ARect.Bottom := FTopLeft.Y;
end;
DRAW_FROZEN_COLS:
begin
if IsRightToLeft then
begin
ARect.Left := FTopLeft.X;
ARect.Right := headerTL.X;
end else
begin
ARect.Left := headerTL.X;
ARect.Right := FTopLeft.X;
end;
ARect.Top := FTopLeft.Y;
end;
DRAW_FROZEN_CORNER:
begin
if IsRightToLeft then
begin
ARect.Left := FTopLeft.X;
ARect.Right := headerTL.X;
end else
begin
ARect.Left := headerTL.X;
ARect.Right := FTopLeft.X;
end;
ARect.Top := headerTL.Y;
ARect.Bottom := FTopLeft.Y;
end;
end;
end;
// Offset to convert relative to absolute row/col coordinates for ColRowToOffset
procedure GetScrollOffset(out ARowDelta, AColDelta: Integer);
var
tmp: Integer;
x: Integer = 0;
y: Integer = 0;
begin
AColDelta := 0;
if FrozenCols > 0 then begin
if IsRightToLeft then begin
tmp := LeftCol;
ColRowToOffset(true, false, LeftCol, AColDelta, tmp); //tmp, AColDelta);
ColRowToOffset(true, true, LeftCol, tmp, x);
dec(AColDelta, ClientWidth - x);
end else
begin
ColRowToOffset(true, false, LeftCol, AColDelta, tmp);
ColRowToOffset(true, true, LeftCol, x, tmp);
dec(AColDelta, x);
end;
end;
ARowDelta := 0;
if FrozenRows > 0 then begin
ColRowToOffset(false, false, TopRow, ARowDelta, tmp);
ColRowToOffset(false, true, TopRow, y, tmp);
dec(ARowDelta, y);
end;
end;
function GetImageRect(img: PsImage; AWidth, AHeight: Integer;
ARowDelta, AColDelta: Integer): TRect;
var
tmp: Integer = 0;
gcol, grow: Integer;
relativeX, relativeY: Boolean;
begin
Result := Rect(0, 0, 0, 0); // To silence the compiler
grow := GetGridRow(img^.row);
gcol := GetGridCol(img^.Col);
case AGridPart of
DRAW_NON_FROZEN:
begin
relativeX := (FrozenCols = 0);
relativeY := (FrozenRows = 0);
end;
DRAW_FROZEN_COLS:
begin
relativeX := true;
relativeY := not ((integer(img^.Row) < FrozenRows) and
(integer(img^.Col) < FrozenCols));
end;
DRAW_FROZEN_ROWS:
begin
relativeX := not ((integer(img^.Row) < FrozenRows) and
(integer(img^.Col) < FrozenCols));
relativeY := true;
end;
DRAW_FROZEN_CORNER:
begin
relativeX := true;
relativeY := true;
end;
end;
if IsRightToLeft then begin
if not relativeX then
ColRowToOffset(true, false, gcol, Result.Right, tmp)
else
ColRowToOffset(true, true, gcol, tmp, Result.Right);
if not relativeX then
Result.Right := ClientWidth - Result.Right + AColDelta;
Result.Left := Result.Right - AWidth;
end else
begin
ColRowToOffset(true, relativeX, gcol, Result.Left, tmp);
if not relativeX then
dec(Result.Left, AColDelta);
Result.Right := Result.Left + AWidth;
end;
ColRowToOffset(false, relativeY, grow, Result.Top, tmp);
if not relativeY then
dec(Result.Top, ARowDelta);
Result.Bottom := Result.Top + AHeight;
if IsRightToLeft then
OffsetRect(Result, -ToPixels(img^.OffsetX), ToPixels(img^.OffsetY))
else
OffsetRect(Result, ToPixels(img^.OffsetX), ToPixels(img^.OffsetY));
end;
var
i: Integer;
img: PsImage;
obj: TsEmbeddedObj;
clipArea: TRect = (Left:0; Top:0; Right:0; Bottom:0);
imgRect: TRect;
w, h: Integer;
coloffs, rowoffs: Integer;
rgn: HRGN;
fc, fr: Integer;
R: TRect = (Left:0; Top:0; Right: 0; Bottom: 0);
begin
if Worksheet.GetImageCount = 0 then
exit;
CalcClipRect(clipArea);
GetScrollOffset(rowOffs, colOffs);
fc := FHeaderCount + FFrozenCols;
fr := FHeaderCount + FFrozenRows;
for i := 0 to Worksheet.GetImageCount-1 do begin
img := Worksheet.GetPointerToImage(i);
obj := Workbook.GetEmbeddedObj(img^.Index);
// Frozen part of the grid draw only images which are anchored there.
case AGridPart of
DRAW_NON_FROZEN:
;
DRAW_FROZEN_ROWS:
if (integer(img^.Row) >= fr) then Continue;
DRAW_FROZEN_COLS:
if (integer(img^.Col) >= fc) then Continue;
DRAW_FROZEN_CORNER:
if (integer(img^.Row) >= fr) or (integer(img^.Col) >= fc) then Continue;
end;
// Size of image and its position
w := ToPixels(obj.ImageWidth * img^.ScaleX);
h := ToPixels(obj.ImageHeight * img^.ScaleY);
imgRect := GetImageRect(img, w, h, rowoffs, coloffs);
// Nothing to do if image is outside the visible grid area
if not IntersectRect(R, clipArea, imgRect) then
continue;
// If not yet done load image stream into picture and scale to required size
if img^.Picture = nil then
begin
img^.Picture := TPicture.Create;
obj.Stream.Position := 0;
TPicture(img^.Picture).LoadFromStream(obj.Stream);
end;
// Scale and draw image
rgn := CreateRectRgn(clipArea.Left, clipArea.Top, clipArea.Right, clipArea.Bottom);
try
SelectClipRgn(Canvas.Handle, rgn);
R := Rect(0, 0, w, h);
OffsetRect(R, imgRect.Left, imgRect.Top);
if (img^.ScaleX = 1.0) and (img^.ScaleY = 1.0) then
Canvas.Draw(R.Left, R.Top, TPicture(img^.Picture).Graphic)
else
Canvas.StretchDraw(R, TPicture(img^.Picture).Graphic);
finally
DeleteObject(rgn);
end;
end;
end;
{@@ ----------------------------------------------------------------------------
Draws lines with the PageBreakPen along the cell border indicating the
position of page breaks
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.DrawPageBreaks(AClipRect: TRect);
var
i: Integer;
lCol: PCol;
lRow: PRow;
idx: Integer;
R: TRect;
begin
if not FShowPageBreaks then
exit;
Canvas.Pen.Assign(FPageBreakPen);
for i:= 0 to Worksheet.Rows.Count-1 do begin
lRow := Worksheet.Rows[i];
if (croPageBreak in lRow^.Options) then begin
idx := GetGridRow(lRow^.Row);
// R := CellRect(0, idx);
ColRowToOffSet(false, true, idx, R.Top, R.Bottom);
Canvas.Line(AClipRect.Left, R.Top-1, AClipRect.Right, R.Top-1);
end;
end;
for i:= 0 to Worksheet.Cols.Count-1 do begin
lCol := Worksheet.Cols[i];
if (croPageBreak in lCol^.Options) then begin
idx := GetGridRow(lCol^.Col);
// R := CelLRect(idx, 0);
ColRowToOffSet(true, true, idx, R.Left, R.Right);
Canvas.Line(R.Left-1, AClipRect.Top, R.Left-1, AClipRect.Bottom);
end;
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 for drawing the default
focus rectangle is removed.
@param ARow Index of the row to be drawn (in grid coordinates)
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.DrawRow(ARow: Integer);
var
gr, gc, gcLast: Integer; // grid row/column
fc: Integer; // Fixed columns (= header column + frozen columns)
rct, row_rct, header_rct: TRect;
clipArea: TRect;
begin
clipArea := Canvas.ClipRect;
// Upper and lower bounds for this row
row_rct := Rect(clipArea.Left, 0, clipArea.Right, 0);
ColRowToOffSet(False, True, ARow, row_rct.Top, row_rct.Bottom);
// Rectangle covering the fixed row headers (but not the frozen cells)
header_rct := Rect(0, 0, 0, 0);
header_rct.Top := row_rct.Top;
header_rct.Bottom := row_rct.Bottom;
if HeaderCount > 0 then
ColRowToOffset(true, true, 0, header_rct.Left, header_rct.Right);
// Don't draw rows outside the clipping area
if (row_rct.Top >= row_rct.Bottom) or not VerticalIntersect(row_rct, clipArea) then
begin
{$IFDEF DbgVisualChange}
DebugLn('Drawrow: Skipped row: ', IntToStr(aRow));
{$ENDIF}
exit;
end;
// Count of non-scrolling columns
fc := FHeaderCount + FFrozenCols;
// (1) Draw data columns in this row (non-fixed part)
with GCache.VisibleGrid do
begin
gcLast := Right;
gc := Left;
rct := row_rct;
if IsRightToLeft then
rct.Right := FTopLeft.X
else
rct.Left := FTopLeft.X;
InternalDrawRow(ARow, gc, gcLast, rct);
end;
// (2) Draw fixed columns consisting of header columns and frozen cells
gr := ARow;
// (2a) Draw header column
if FHeaderCount > 0 then begin
FDrawingCell := nil;
gc := 0;
InternalDrawCell(gc, gr, header_rct, header_rct, [gdFixed]);
end;
// (2b) Draw frozen cells
if FFrozenCols > 0 then begin
rct := row_rct;
if IsRightToLeft then
rct.Left := FTopLeft.X
else
rct.Right := FTopLeft.X;
InternalDrawRow(ARow, FHeaderCount, fc-1, rct);
end;
end;
procedure TsCustomWorksheetGrid.DrawDragSelection;
begin
if Assigned(DragManager) and DragManager.IsDragging then
InternalDrawSelection(FDragSelection, false);
end;
{@@ ----------------------------------------------------------------------------
Draws the selection rectangle around selected cells.
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.DrawSelection;
begin
InternalDrawSelection(Selection, true);
end;
procedure TsCustomWorksheetGrid.InternalDrawSelection(ASel: TGridRect;
IsNormalSelection: boolean);
var
R: TRect;
cell: PCell;
r1,c1,r2,c2: Cardinal;
delta: Integer;
savedPenMode: TPenMode;
P: array[0..9] of TPoint;
begin
if Worksheet = nil then
exit;
// Selected cell
cell := Worksheet.FindCell(GetWorksheetRow(ASel.Top), GetWorksheetCol(ASel.Left));
if Worksheet.IsMerged(cell) then
begin
Worksheet.FindMergedRange(cell, r1,c1,r2,c2);
R := CellRect(GetGridCol(c1), GetGridRow(r1), GetGridCol(c2), GetGridRow(r2));
end else
R := CellRect(ASel.Left, ASel.Top, ASel.Right, ASel.Bottom);
if IsNormalSelection then begin
// Fine-tune position of selection rect
if odd(FSelPen.Width) then delta := -1 else delta := 0;
inc(R.Top, delta);
if IsRightToLeft then begin
if not odd(FSelPen.Width) then
OffsetRect(R, 1, 0) else
inc(R.Right, 1);
end else
inc(R.Left, delta);
if (ASel.Top = TopRow) then
inc(R.Top);
if ASel.Left = LeftCol then begin
if IsRightToLeft then
dec(R.Right)
else
inc(R.Left);
end;
// Set up the canvas
savedPenMode := Canvas.Pen.Mode;
Canvas.Pen.Assign(FSelPen);
if UseXORFeatures then begin
Canvas.Pen.Color := clWhite;
Canvas.Pen.Mode := pmXOR;
end;
Canvas.Brush.Style := bsClear;
// Paint
Canvas.Rectangle(R);
// Restore canvas.
Canvas.Pen.Mode := savedPenMode;
end
else
begin
// Selection during dragging: draw a dotted filled outline
delta := 2;
// outer rectangle
P[0] := Point(R.Left - delta, R.Top - delta);
P[1] := Point(R.Right + delta, R.Top - delta);
P[2] := Point(R.Right + delta, R.Bottom + delta);
P[3] := Point(R.Left - delta, R.Bottom + delta);
P[4] := P[0];
// inner rectangle
P[5] := Point(R.Left + delta, R.Top + delta);
P[6] := Point(R.Left + delta, R.Bottom - delta);
P[7] := Point(R.Right - delta, R.Bottom - delta);
P[8] := Point(R.Right - delta, R.Top + delta);
P[9] := P[5];
Canvas.Pen.style := psClear;
Canvas.Brush.Style := bsImage;
Canvas.Brush.Bitmap := DragBorderBitmap;
// Canvas.Brush.Color := clblack;
Canvas.Polygon(P);
end;
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;
fntIndex: Integer;
lCell: PCell;
fmt: PsCellFormat;
numfmt: TsNumFormatParams;
idx: Integer;
numFmtColor: TColor;
sidx: Integer; // number format section index
RTL: Boolean;
begin
if (Worksheet = nil) then
exit;
if (ACol < FHeaderCount) or (ARow < FHeaderCount) then
lCell := nil
else begin
if FDrawingCell = nil then
lCell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol))
else
lCell := FDrawingCell
end;
// Header
if (lCell = nil) and ShowHeaders and ((ACol = 0) or (ARow = 0)) then
begin
ts := Canvas.TextStyle;
ts.Alignment := taCenter;
ts.Layout := tlCenter;
ts.Opaque := false;
Canvas.TextStyle := ts;
inherited DrawCellText(aCol, aRow, aRect, aState, GetCellText(ACol,ARow));
exit;
end;
// Cells
if lCell = nil then
exit;
txt := GetCellText(GetGridRow(lCell^.Col), GetGridCol(lCell^.Row));
if txt = '' then
exit;
idx := Worksheet.GetEffectiveCellFormatIndex(lCell);
fmt := Workbook.GetPointerToCellFormat(idx);
wrapped := (uffWordWrap in fmt^.UsedFormattingFields) or (fmt^.TextRotation = rtStacked);
RTL := IsRightToLeft;
if (uffBiDi in fmt^.UsedFormattingFields) then
case Worksheet.ReadBiDiMode(lCell) of
bdRTL : RTL := true;
bdLTR : RTL := false;
end;
// Text rotation
if (uffTextRotation in fmt^.UsedFormattingFields)
then txtRot := fmt^.TextRotation
else txtRot := trHorizontal;
// vertical alignment
if (uffVertAlign in fmt^.UsedFormattingFields)
then vertAlign := fmt^.VertAlignment
else vertAlign := vaDefault;
if vertAlign = vaDefault then
vertAlign := vaBottom;
// Horizontal alignment
if (uffHorAlign in fmt^.UsedFormattingFields)
then horAlign := fmt^.HorAlignment
else horAlign := haDefault;
if (horAlign = haDefault) then
begin
if (lCell^.ContentType in [cctNumber, cctDateTime]) then
begin
if RTL then
horAlign := haLeft
else
horAlign := haRight;
end else
if (lCell^.ContentType in [cctBool]) then
horAlign := haCenter
else begin
if RTL then
horAlign := haRight
else
horAlign := haLeft;
end;
end;
// Font index
if (uffFont in fmt^.UsedFormattingFields)
then fntIndex := fmt^.FontIndex
else fntIndex := DEFAULT_FONTINDEX;
// Font color as derived from number format
numFmtColor := clNone;
if not IsNaN(lCell^.NumberValue) and (uffNumberFormat in fmt^.UsedFormattingFields) then
begin
numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
if numFmt <> nil then
begin
sidx := 0;
if (Length(numFmt.Sections) > 1) and (lCell^.NumberValue < 0) then
sidx := 1
else
if (Length(numFmt.Sections) > 2) and (lCell^.NumberValue = 0) then
sidx := 2;
if (nfkHasColor in numFmt.Sections[sidx].Kind) then
numFmtColor := numFmt.Sections[sidx].Color and $00FFFFFF;
end;
end;
InflateRect(ARect, -constCellPadding, -constCellPadding);
InternalDrawTextInCell(txt, ARect, horAlign, vertAlign, txtRot, wrapped,
fntIndex, numfmtColor, lCell^.RichTextParams, RTL);
end;
{@@ ----------------------------------------------------------------------------
Is called when editing is complete; checks whether input is valid already
have been done.
The method must transfer the edited cell text to the worksheet cell
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.EditorDoGetValue;
var
cell: Pcell;
begin
inherited;
if (FOldEditorText <> 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 := '';
FOldEditorText := '';
end;
end;
function TsCustomWorksheetGrid.EditorByStyle(Style: TColumnButtonStyle): TWinControl;
begin
if (Style = cbsAuto) and (FLineMode = elmMultiLine) then
Result := FMultiLineStringEditor
else
Result := inherited;
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(ARefresh: Boolean = true);
begin
inherited EndUpdate(false);
Workbook.UnlockFormulas;
Workbook.EnableNotifications;
dec(FLockCount);
if (FLockCount = 0) and ARefresh then
VisualChange;
end;
{@@ ----------------------------------------------------------------------------
Executes a hyperlink stored in the FHyperlinkCell
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.ExecuteHyperlink;
var
hlink: TsHyperlink;
target, bookmark: String;
sheetname: String;
sheet: TsWorksheet;
r, c: Cardinal;
begin
if FHyperlinkCell = nil then
exit;
hlink := Worksheet.ReadHyperlink(FHyperlinkCell);
SplitHyperlink(hlink.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, [hlink.Target]);
end else
// Fires the OnClickHyperlink event which should open a file or a URL
if Assigned(FOnClickHyperlink) then FOnClickHyperlink(self, hlink);
end;
{@@ ----------------------------------------------------------------------------
Copies the borders of a cell to the correspondig edges of 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);
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;
idx: Integer;
begin
if (Worksheet = nil) or (ACell = nil) then
exit;
idx := Worksheet.GetEffectiveCellFormatIndex(ACell);
fmt := Workbook.GetPointerToCellFormat(idx);
// fmt := Worksheet.GetPointerToEffectiveCellFormat(ACell);
with ACell^ do
begin
// fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
if Col > 0 then
SetNeighborBorder(Row, Col-1, cbEast, fmt^.BorderStyles[cbWest], cbWest in fmt^.Border);
SetNeighborBorder(Row, Col+1, cbWest, fmt^.BorderStyles[cbEast], cbEast in fmt^.Border);
if Row > 0 then
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;
{@@ ----------------------------------------------------------------------------
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
@returns 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 ALeft Index of the left column of the cell range
@param ATop Index of the top row of the cell range
@param ARight Index of the right column of the cell range
@param ABottom Index of the bottom row of the cell range
@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(ALeft, ATop, ARight, ABottom: Integer): TsColor;
var
c, r: Integer;
clr: TsColor;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetBackgroundColor(ALeft, ATop);
clr := Result;
for c := ALeft to ARight do
for r := ATop to ABottom do
begin
Result := GetBackgroundColor(c, r);
if Result <> clr then
begin
Result := scNotDefined;
exit;
end;
end;
end;
function TsCustomWorksheetGrid.GetCellBiDiMode(ACol,ARow: Integer): TsBiDiMode;
var
cell: PCell;
begin
cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if cell <> nil then
Result := Worksheet.ReadBiDiMode(cell) else
Result := bdDefault;
end;
{@@ ----------------------------------------------------------------------------
Returns the cell borders which are drawn around a given cell.
If the cell is part of a merged block then the borders of the merge base
are applied to the location of the cell (no inner borders for merged cells).
@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;
base: PCell;
r, c, r1, c1, r2, c2: Cardinal;
begin
Result := [];
if Assigned(Worksheet) then
begin
r := GetWorksheetRow(ARow);
c := GetWorksheetCol(ACol);
cell := Worksheet.FindCell(r, c);
if Worksheet.IsMerged(cell) then
begin
Worksheet.FindMergedRange(cell, r1, c1, r2, c2);
base := Worksheet.FindCell(r1, c1);
Result := Worksheet.ReadCellBorders(base);
if (cbNorth in Result) and (r > r1) then Exclude(Result, cbNorth);
if (cbSouth in Result) and (r < r2) then Exclude(Result, cbSouth);
if IsRightToLeft then
begin
if (cbEast in Result) and (c > c1) then Exclude(Result, cbEast);
if (cbWest in Result) and (c < c2) then Exclude(Result, cbWest);
end else
begin
if (cbWest in Result) and (c > c1) then Exclude(Result, cbWest);
if (cbEast in Result) and (c < c2) then Exclude(Result, cbEast);
end;
end else
Result := Worksheet.ReadCellBorders(cell);
end;
end;
{@@ ----------------------------------------------------------------------------
Returns the cell borders which are drawn around a given rectangular cell range.
@param ALeft Index of the left column of the cell range
@param ATop Index of the top row of the cell range
@param ARight Index of the right column of the cell range
@param ABottom Index of the bottom row of the cell range
@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(ALeft, ATop, ARight, ABottom: Integer): TsCellBorders;
var
c, r: Integer;
b: TsCellBorders;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellBorder(ALeft, ATop);
b := Result;
for c := ALeft to ARight do
for r := ATop to ABottom 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.
If the cell belongs to a merged block then the border styles of the merge
base are returned.
@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));
if Worksheet.IsMerged(cell) then
cell := Worksheet.FindMergeBase(cell);
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 ALeft Index of the left column of the cell range
@param ATop Index of the top row of the cell range
@param ARight Index of the right column of the cell range
@param ABottom Index of the bottom row of the cell range
@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(ALeft, ATop, ARight, ABottom: Integer;
ABorder: TsCellBorder): TsCellBorderStyle;
var
c, r: Integer;
bs: TsCellBorderStyle;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellBorderStyle(ALeft, ATop, ABorder);
bs := Result;
for c := ALeft to ARight do
for r := ATop to ABottom 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 comment assigned to a cell.
@param ACol Grid column index of the cell
@param ARow Grid row index of the cell
@return String used as a cell comment.
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.GetCellComment(ACol, ARow: Integer): String;
begin
if Worksheet <> nil then
Result := Worksheet.ReadComment(GetWorksheetRow(ARow), GetWorksheetCol(ACol))
else
Result :='';
end;
{@@ ----------------------------------------------------------------------------
Returns the (LCL) 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;
end;
{@@ ----------------------------------------------------------------------------
Returns the (LCL) font to be used when painting text in the cells defined
by the rectangle of row/column indexes.
@param ALeft Index of the left column of the cell range
@param ATop Index of the top row of the cell range
@param ARight Index of the right column of the cell range
@param ABottom Index of the bottom row of the cell range
@return Font usable when painting on a canvas.
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.GetCellFonts(ALeft, ATop, ARight, ABottom: Integer): TFont;
var
r1,c1,r2,c2: Cardinal;
sFont, sDefFont: TsFont;
cell: PCell;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellFont(ALeft, ATop);
sDefFont := Workbook.GetDefaultFont; // Default font
r1 := GetWorksheetRow(ATop);
c1 := GetWorksheetCol(ALeft);
r2 := GetWorksheetRow(ABottom);
c2 := GetWorksheetRow(ARight);
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;
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.)
@return(Height of the cell in pixels. Wrapped text is handled correctly.
Value contains the zoom factor.)
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.GetCellHeight(ACol, ARow: Integer): Integer;
var
lCell: PCell;
s: String;
wrapped: Boolean;
cellR: TRect;
r1,c1,r2,c2: Cardinal;
fmt: PsCellFormat;
idx: Integer;
fntIndex: Integer;
txtRot: TsTextRotation;
RTL: Boolean;
begin
Result := 0;
if (ACol < FHeaderCount) or (ARow < FHeaderCount) then
exit;
if Worksheet = nil then
exit;
lCell := Worksheet.FindCell(ARow-FHeaderCount, ACol-FHeaderCount);
if lCell <> nil then
begin
cellR := CellRect(ACol, ARow);
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;
cellR := CellRect(LongInt(c1)+FHeaderCount, ARow);
cellR.Right := CellRect(LongInt(c2)+FHeaderCount, ARow).Right;
end;
InflateRect(cellR, -constCellPadding, -constCellPadding);
s := GetCellText(ACol, ARow, false);
if s = '' then
exit;
DoPrepareCanvas(ACol, ARow, []);
idx := Worksheet.GetEffectiveCellFormatIndex(lCell);
fmt := Workbook.GetPointerToCellFormat(idx);
// fmt := Worksheet.GetPointerToEffectiveCellFormat(lCell);
if (uffFont in fmt^.UsedFormattingFields) then
fntIndex := fmt^.FontIndex else fntIndex := DEFAULT_FONTINDEX;
if (uffTextRotation in fmt^.UsedFormattingFields) then
txtRot := fmt^.TextRotation else txtRot := trHorizontal;
wrapped := (uffWordWrap in fmt^.UsedFormattingFields);
RTL := IsRightToLeft;
if (uffBiDi in fmt^.UsedFormattingFields) then
case fmt^.BiDiMode of
bdRTL: RTL := true;
bdLTR: RTL := false;
end;
case txtRot of
trHorizontal: ;
rt90DegreeClockwiseRotation,
rt90DegreeCounterClockwiseRotation:
cellR := Rect(0, 0, MaxInt, MaxInt);
rtStacked:
cellR := Rect(0, 0, MaxInt, MaxInt);
end;
Result := RichTextHeight(Canvas, Workbook, cellR, s, lCell^.RichTextParams,
fntIndex, txtRot, wrapped, RTL, ZoomFactor)
+ 2 * constCellPadding;
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;
hlink: PsHyperlink;
comment: String;
begin
Result := '';
if Worksheet = nil then
exit;
cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if cell = nil then
exit;
// Read comment
comment := Worksheet.ReadComment(cell);
// Avoid splitting the comment at the '|': draw a unicode character which looks similar.
if pos('|', comment) > 0 then
comment := StringReplace(comment, '|', #$E2#$94#$82, [rfReplaceAll]);
// Read hyperlink info
if Worksheet.HasHyperlink(cell) then begin
hlink := Worksheet.FindHyperlink(cell);
if hlink <> nil then
begin
if hlink^.ToolTip <> '' then
Result := hlink^.ToolTip
else
Result := Format('Hyperlink: %s' + LineEnding + rsStdHyperlinkTooltip,
[hlink^.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;
// Call hint event handler
if Assigned(OnGetCellHint) then
OnGetCellHint(self, ACol, ARow, Result);
end;
function TsCustomWorksheetGrid.GetCells(ACol, ARow: Integer): String;
var
msg: TGridMessage;
begin
if (Editor <> nil) and Editor.Visible then
begin
msg.LclMsg.msg := GM_GETVALUE;
msg.Grid := Self;
msg.Col := ACol;
msg.Row := ARow;
msg.Value := ''; //GetCells(FCol, FRow);
Editor.Dispatch(msg);
Result := msg.value;
end else
Result := GetCellText(ACol, ARow);
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
@param ATrim If true show replacement characters if numerical data are wider than cell.
@return Text to be displayed in the cell.
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.GetCellText(ACol, ARow: Integer;
ATrim: Boolean = true): String;
var
cell: PCell;
r, c: Integer;
begin
Result := '';
if ShowHeaders then
begin
// Headers
if (ARow = 0) and (ACol = 0) then
exit;
if (ARow = 0) then
begin
Result := GetColString(ACol - FHeaderCount);
if Assigned(FGetColHeaderText) then
FGetColHeaderText(Self, ACol, Result);
exit;
end
else
if (ACol = 0) then
begin
Result := IntToStr(ARow);
if Assigned(FGetRowHeaderText) then
FGetRowHeaderText(Self, ARow, Result);
exit;
end;
end;
if Worksheet <> nil then
begin
r := ARow - FHeaderCount;
c := ACol - FHeaderCount;
cell := Worksheet.FindCell(r, c);
if cell <> nil then
begin
if HasFormula(cell) and not (boAutoCalc in Workbook.Options) and FShowFormulas then
Result := '=' + Worksheet.ReadFormula(cell)
else
if ATrim then
Result := TrimToCell(cell)
else
Result := Worksheet.ReadAsText(cell);
end;
end;
end;
function TsCustomWorksheetGrid.GetDefaultColumnTitle(Column: Integer): string;
var
s: String = '';
begin
if Assigned(FGetColHeaderText) then
FGetColHeaderText(Self, Column, s)
else
s := GetColString(Column - FHeaderCount);
Result := s;
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.ReadAsText(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.
@return Result is @FALSE if there is no border line.
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.GetBorderStyle(ACol, ARow, ADeltaCol, ADeltaRow: Integer;
ACell: PCell; out ABorderStyle: TsCellBorderStyle): Boolean;
var
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);
if (longint(r) + ADeltaRow < 0) or (longint(c) + ADeltaCol < 0) then
neighborcell := nil
else
neighborcell := Worksheet.FindCell(longint(r) + ADeltaRow, longint(c) + 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 := GetCellBorderStyle(ACol, ARow, 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 := GetCellBorderStyle(ACol+ADeltaCol, ARow+ADeltaRow, 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 := GetCellBorderStyle(ACol+ADeltaCol, ARow+ADeltaRow, neighborborder)
else
ABorderStyle := GetCellBorderStyle(ACol, ARow, border);
end else
Result := false;
end;
{@@ ----------------------------------------------------------------------------
Returns the width of the fixed header column 0, in pixels
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.GetFixedColWidth: Integer;
begin
if FFixedColWidth = 0 then begin
PrepareCanvasFont;
Result := Canvas.TextWidth(' 9999999 ');
end else
Result := FFixedColWidth;
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;
{@@ ----------------------------------------------------------------------------
Inherited method. Is overridden to make sure that no column headers are
drawn when ShowHeaders is false.
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.GetIsCellTitle(ACol, ARow: Integer): Boolean;
begin
Result := (FHeaderCount > 0) and (ARow = 0);
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 some 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 := UNASSIGNED_ROW_COL_INDEX
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
@return Index of the corresponding worksheet row.
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.GetWorksheetRow(AGridRow: Integer): Cardinal;
begin
if (FHeaderCount > 0) and (AGridRow = 0) then
Result := UNASSIGNED_ROW_COL_INDEX
else
Result := AGridRow - FHeaderCount;
end;
{@@ ----------------------------------------------------------------------------
Returns true if the cell has the given border. In case of merged cell the
borders of the merge base are checked. Inner merged cells don't have a 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;
var
base: PCell;
r1, c1, r2, c2: Cardinal;
begin
if Worksheet = nil then
result := false
else
if Worksheet.IsMerged(ACell) then
begin
Worksheet.FindMergedRange(ACell, r1, c1, r2, c2);
base := Worksheet.FindCell(r1, c1);
Result := ABorder in Worksheet.ReadCellBorders(base);
case ABorder of
cbNorth : if ACell^.Row > r1 then Result := false;
cbSouth : if ACell^.Row < r2 then Result := false;
cbEast : if ACell^.Col < c2 then Result := false;
cbWest : if ACell^.Col > c1 then Result := false;
end;
end else
Result := ABorder in Worksheet.ReadCellBorders(ACell);
end;
{@@ ----------------------------------------------------------------------------
HeaderSizing is called while a column width or row height is resized by the
mouse. Is overridden here to enforce a grid repaint if merged cells are
affected by the resizing column/row. Otherwise parts of the merged cells would
not be updated if the cell text moves during the resizing action.
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.HeaderSizing(const IsColumn:boolean;
const AIndex,ASize:Integer);
var
gc, gr: Integer;
sr1, sr2, sc1, sc2, si: Cardinal;
cell: PCell;
begin
inherited;
if Worksheet = nil then
exit;
// replaint the grid if merged cells are affected by the resizing col/row.
si := IfThen(IsColumn, GetWorksheetCol(AIndex), GetWorksheetRow(AIndex));
for gc := GetFirstVisibleColumn to GetLastVisibleColumn do
begin
for gr := GetFirstVisibleRow to GetLastVisibleRow do
begin
cell := Worksheet.FindCell(gr, gc);
if Worksheet.IsMerged(cell) then begin
Worksheet.FindMergedRange(cell, sr1, sc1, sr2, sc2);
if IsColumn and InRange(si, sc1, sc2) or
(not IsColumn) and InRange(si, sr1, sr2) then
begin
InvalidateGrid;
exit;
end;
end;
end;
end;
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);
const
EPS = 0.1;
var
idx: Integer;
w, h, wdef, hdef: Single;
begin
if (Worksheet = nil) or (FZoomLock <> 0) or (AIndex < FHeaderCount) then
exit;
if IsColumn then
begin
w := CalcWorksheetColWidth(ColWidths[AIndex]); // w and wdef are at 100% zoom
wdef := Worksheet.ReadDefaultColWidth(Workbook.Units);
if not SameValue(w, wdef, EPS) then begin
idx := GetWorksheetCol(AIndex);
Worksheet.WriteColWidth(idx, w, Workbook.Units);
end;
end else
begin
h := CalcWorksheetRowHeight(RowHeights[AIndex]);
hdef := Worksheet.ReadDefaultRowHeight(Workbook.Units);
if not SameValue(h, hdef, EPS) then begin
idx := GetWorksheetRow(AIndex);
Worksheet.WriteRowHeight(idx, h, Workbook.Units);
end;
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 >= ColCount then //FInitColCount then
if GetGridCol(Worksheet.GetLastColIndex + 1) >= ColCount then
ColCount := ColCount + 1;
c := GetWorksheetCol(AGridCol);
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
if GetGridRow(Worksheet.GetLastRowIndex + 1) >= RowCount then
RowCount := RowCount + 1;
r := GetWorksheetRow(AGridRow);
Worksheet.InsertRow(r);
// Calculate row height if new row
UpdateRowHeight(AGridRow, true);
// Update following row heights because their index has changed.
UpdateRowHeights(AGridRow);
end;
procedure TsCustomWorksheetGrid.InternalDrawCell(ACol, ARow: Integer;
AClipRect, ACellRect: TRect; AState: TGridDrawState);
function IsPushCellActive: boolean;
begin
with GCache do
Result := (PushedCell.X <> -1) and (PushedCell.Y <> -1);
end;
var
rgn: HRGN;
begin
with GCache do begin
if (ACol = HotCell.x) and (ARow = HotCell.y) and not IsPushCellActive() then begin
Include(AState, gdHot);
HotCellPainted := True;
end;
if ClickCellPushed and (ACol = PushedCell.x) and (ARow = PushedCell.y) then begin
Include(AState, gdPushed);
end;
end;
Canvas.SaveHandleState;
try
rgn := CreateRectRgn(AClipRect.Left, AClipRect.Top, AClipRect.Right, AClipRect.Bottom);
SelectClipRgn(Canvas.Handle, rgn);
DrawCell(ACol, ARow, ACellRect, AState);
DeleteObject(rgn);
finally
Canvas.RestoreHandleState;
end;
end;
{ Draws the cells in the specified row. Drawing takes care of text overflow
and merged cells.
AClipRect covers the paintable row, painting outside will be clipped. }
procedure TsCustomWorksheetGrid.InternalDrawRow(ARow, AFirstCol, ALastCol: Integer;
AClipRect: TRect);
var
sr: Cardinal;
scLastUsed: Cardinal;
sr1, sc1, sr2, sc2: Cardinal;
gr, gc, gc1, gc2, gcNext, gcLast, gcLastUsed: Integer;
i: Integer;
tmp: Integer = 0;
cell: PCell;
idx: Integer;
fmt: PsCellFormat;
rct, clip_rct, commentcell_rct, temp_rct: TRect;
gds: TGridDrawState;
clipArea: TRect;
begin
if Worksheet = nil then
exit;
sr := GetWorksheetRow(ARow);
scLastused := Worksheet.GetLastColIndex;
gc := AFirstCol;
gcLast := ALastCol;
clipArea := Canvas.ClipRect;
with GCache.VisibleGrid do
begin
// 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 <> UNASSIGNED_ROW_COL_INDEX) and Assigned(Worksheet) then
while (gc > FHeaderCount) 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
idx := Worksheet.GetEffectiveCellFormatIndex(cell);
fmt := Workbook.GetPointerToCellFormat(idx);
// fmt := Worksheet.GetPointerToEffectiveCellFormat(cell);
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 := AFirstCol;
break;
end;
// Now find the last column. Again text can overflow into the visible area
// from invisible cells at the right.
gcLast := ALastCol;
if FTextOverflow and (sr <> UNASSIGNED_ROW_COL_INDEX) and Assigned(Worksheet) then
begin
gcLastUsed := GetGridCol(scLastUsed);
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
idx := Worksheet.GetEffectiveCellFormatIndex(cell);
fmt := Workbook.GetPointerToCellFormat(idx);
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 := ALastCol;
Break;
end;
end;
// Here begins the drawing loop of all cells in the row between gc and gcLast
while (gc <= gcLast) do begin
gr := ARow;
rct := AClipRect;
commentcell_rct := Rect(0, 0, 0, 0);
// 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 >= FHeaderCount) and (gc >= FHeaderCount) 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);
// 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
if IsRightToLeft then begin
ColRowToOffset(true, true, gc1, tmp, rct.Right);
ColRowToOffset(true, true, gc2, rct.Left, tmp);
end else begin
ColRowToOffset(true, true, gc1, rct.Left, tmp); // rct is the clip rect
ColRowToOffset(true, true, gc2, tmp, rct.Right);
end;
FDrawingCell := nil;
temp_rct := rct;
for i:= gc2 downto gc1 do begin
// Starting from last col will ensure drawing grid lines below text
// when text is overflowing in RTL, no problem in LTR
// (Modification by "shobits1" - ok)
ColRowToOffset(true, true, i, temp_rct.Left, temp_rct.Right);
if HorizontalIntersect(temp_rct, clipArea) and (i <> gc) then
begin
gds := GetGridDrawState(i, gr);
InternalDrawCell(i, gr, rct, temp_rct, gds);
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);
IntersectRect(rct, rct, clipArea);
InternalDrawCell(gc, gr, rct, temp_rct, gds);
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);
if Worksheet.FindMergedRange(FDrawingCell, sr1, sc1, sr2, sc2) then
begin
gr := GetGridRow(sr1);
if Worksheet.HasComment(FDrawingCell) then
commentcell_rct := CellRect(GetGridCol(sc2), gr);
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;
end;
// Take care of upper and lower bounds of merged cells!
temp_rct := rct;
rct := CellRect(gc, gr, gcNext-1, gr);
rct.Top := temp_rct.Top;
rct.Bottom := temp_rct.Bottom;
if (rct.Left < rct.Right) and HorizontalIntersect(rct, clipArea) then
begin
// Define clipping rectangle in order to avoid painting into the header cells
clip_rct := rct;
clip_rct.Top := AClipRect.Top;
clip_rct.Bottom := AClipRect.Bottom;
if (gc >= FHeaderCount + FFrozenCols) then begin
if UseRightToLeftReading then begin
if (clip_rct.Right > FTopLeft.X) then
clip_rct.Right := FTopLeft.X;
end else
if (clip_rct.Left < FTopLeft.X) then
clip_rct.Left := FTopLeft.X;
end;
gds := GetGridDrawState(gc, gr);
// Draw cell
InternalDrawCell(gc, gr, clip_rct, rct, gds);
// 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 ...
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 # characters 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(AFontIndex Font index to be used for drawing non-rich-text.)
@param(ARichTextParams An array of character and font index combinations
for rich-text formatting of text in cell)
@param(AIsRightToLeft If @true cell must be drawn in right-to-left mode.)
@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: String;
ARect: TRect; ACellHorAlign: TsHorAlignment; ACellVertAlign: TsVertAlignment;
ATextRot: TsTextRotation; ATextWrap: Boolean; AFontIndex: Integer;
AOverrideTextColor: TColor; ARichTextParams: TsRichTextParams;
AIsRightToLeft: Boolean);
begin
// Since - due to the rich-text mode - characters are drawn individually their
// background occasionally overpaints the prev characters (italic). To avoid
// this we do not paint the character background - it is not needed anyway.
Canvas.Brush.Style := bsClear;
// Work horse for text drawing, both standard text and rich-text
DrawRichText(Canvas, Workbook, ARect, AText, ARichTextParams, AFontIndex,
ATextWrap, ACellHorAlign, ACellVertAlign, ATextRot, AOverrideTextColor,
AIsRightToLeft, ZoomFactor
);
end;
{@@ ----------------------------------------------------------------------------
Standard key handling method inherited from TCustomGrid. Is overridden to
catch some keys for special processing.
@param Key Key which has been pressed
@param Shift Additional shift keys which are pressed
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.KeyDown(var Key : Word; Shift : TShiftState);
var
R: TRect;
msg: String;
begin
FFormulaError := false;
// Check validity for formula before navigating to another cell.
case Key of
VK_RETURN,
VK_TAB,
VK_LEFT, VK_RIGHT,
VK_UP, VK_DOWN,
VK_PRIOR, VK_NEXT,
VK_END, VK_HOME:
if not ValidFormula(FEditText, msg) then begin
FFormulaError := true;
MessageDlg(msg, mtError, [mbOK], 0);
Key := 0;
end;
end;
case Key of
VK_RIGHT:
if (aeNavigation in FAutoExpand) and (Col = ColCount-1) then
ColCount := ColCount + 1;
VK_DOWN:
if (aeNavigation in FAutoExpand) and (Row = RowCount-1) then
RowCount := RowCount + 1;
VK_END:
if (aeNavigation in FAutoExpand) and (Col = ColCount-1) then
begin
R := GCache.FullVisibleGrid;
ColCount := ColCount + R.Right - R.Left;
end;
VK_NEXT: // Page down
if (aeNavigation in FAutoExpand) and (Row = RowCount-1) then
begin
R := GCache.FullVisibleGrid;
RowCount := Row + R.Bottom - R.Top;
end;
VK_F2:
FEnhEditMode := true;
VK_DELETE:
if (not FReadOnly) and (goEditing in Options) then begin
if (ssCtrl in Shift) then
Worksheet.DeleteSelection
else
Worksheet.EraseSelection(true);
end;
VK_X, VK_V:
if (Shift = [ssCtrl]) and (Worksheet.IsProtected or not (goEditing in Options)) then
Key := 0;
end;
inherited;
case Key of
VK_C, VK_X, VK_V:
if Shift = [ssCtrl] then Key := 0;
// Clipboard has already been handled, avoid passing key to CellAction
end;
end;
procedure TsCustomWorksheetGrid.KeyUp(var Key : Word; Shift : TShiftState);
begin
if FFormulaError and (Key = VK_RETURN) then
Key := 0;
inherited;
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.
Call this method only for built-in file formats.
@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
(If empty then the active worksheet is loaded))
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.LoadFromSpreadsheetFile(AFileName: string;
AFormat: TsSpreadsheetFormat; AWorksheetIndex: Integer);
var
ae: TsAutoExpandModes;
begin
ae := RelaxAutoExpand;
GetWorkbookSource.LoadFromSpreadsheetFile(AFileName, AFormat, AWorksheetIndex);
RestoreAutoExpand(ae);
SetAutoDetectCellType(FAutoDetectCellType);
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.
Call this method for both built-in and user-provided file formats.
@param(AFileName Name of the file to be loaded)
@param(AFormatID Spreadsheet file format identifier assumed for the
file (automatic detection if empty))
@param(AWorksheetIndex Index of the worksheet to be displayed in the grid
(If empty then the active worksheet is loaded))
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.LoadFromSpreadsheetFile(AFileName: string;
AFormatID: TsSpreadFormatID = sfidUnknown; AWorksheetIndex: Integer = -1);
var
ae: TsAutoExpandModes;
begin
ae := RelaxAutoExpand;
GetWorkbookSource.LoadFromSpreadsheetFile(AFileName, AFormatID, AWorksheetIndex);
RestoreAutoExpand(ae);
SetAutoDetectCellType(FAutoDetectCellType);
end;
{@@ ----------------------------------------------------------------------------
Creates a new workbook and loads the given file into it. Shows the sheet
with the specified sheet index. The file format is determined automatically.
@param(AFileName Name of the file to be loaded)
@param(AWorksheetIndex Index of the worksheet to be shown in the grid
(If empty then the active worksheet is loaded))
@param(AFormatID Spreadsheet file format identifier assumed for the
file (automatic detection if empty))
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.LoadSheetFromSpreadsheetFile(AFileName: String;
AWorksheetIndex: Integer = -1; AFormatID: TsSpreadFormatID = sfidUnknown);
var
ae: TsAutoExpandModes;
begin
ae := RelaxAutoExpand;
GetWorkbookSource.LoadFromSpreadsheetFile(AFilename, AFormatID, AWorksheetIndex);
RestoreAutoExpand(ae);
SetAutoDetectCellType(FAutoDetectCellType);
end;
{@@ ----------------------------------------------------------------------------
Loads an existing workbook into the grid.
@param(AWorkbook Workbook that had been created/loaded before. )
@param(AWorksheetIndex Index of the worksheet to be shown in the grid
(If empty then the active worksheet is loaded))
@Note(THE CALLING PROCEDURE MUST NOT DESTROY THE WORKBOOK!
The workbook will be destroyed by the workbook source.)
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.LoadFromWorkbook(AWorkbook: TsWorkbook;
AWorksheetIndex: Integer = -1);
var
ae: TsAutoExpandModes;
begin
ae := RelaxAutoExpand;
GetWorkbookSource.LoadFromWorkbook(AWorkbook, AWorksheetIndex);
RestoreAutoExpand(ae);
SetAutoDetectCellType(FAutoDetectCellType);
Invalidate;
end;
{@@ ----------------------------------------------------------------------------
Notification message received from the WorkbookLink telling which item of the
spreadsheet has changed.
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.ListenerNotification(AChangedItems: TsNotificationItems;
AData: Pointer = nil);
var
actgrow, actgcol: Integer;
grow, gcol: Integer;
srow, scol: Cardinal;
cell: PCell;
lRow: PRow;
{$IFDEF GRID_DEBUG}
procedure DebugNotification(ACaption: String);
var
s: String;
begin
WriteLn(ACaption);
s := '';
if (lniWorksheet in AChangedItems) then s := s + 'lniWorksheet, ';
if (lniCell in AChangedItems) then s := s + 'lniCell, ';
if (lniSelection in AChangedItems) then s := s + 'lniSelection, ';
if (lniAbortSelection in AChangedItems) then s := s + 'lniAbortSelection, ';
if (lniRow in AChangedItems) then s := s + 'lniRow, ';
if (lniCol in AChangedItems) then s := s + 'lniCol, ';
if (lniWorksheetZoom in AChangedItems) then s := s + 'lniWorksheetZoom, ';
if s <> '' then SetLength(s, Length(s) - 2);
WriteLn(' AChangedItems = [', s, ']');
WriteLn(' ActiveCellRow: ', Worksheet.ActiveCellRow, ' ActiveCellCol: ', Worksheet.ActiveCellCol);
WriteLn(' TopRow: ', Worksheet.TopRow, ' LeftCol: ', Worksheet.LeftCol);
WriteLn;
end;
{$ENDIF}
begin
Unused(AData);
if WorkbookSource.UsesBuiltinWorkbook then
exit;
{$IFDEF GRID_DEBUG}
if Worksheet <> nil then
DebugNotification('BEFORE ListenerNotification WorksheetGrid "' + Worksheet.Name + '":');
{$ENDIF}
// Nothing to do for "workbook changed" because this is always combined with
// "worksheet changed".
// Worksheet changed
if (lniWorksheet in AChangedItems) then
begin
BeginUpdate; // avoid flicker...
try
if (Worksheet <> nil) then
begin
// remember indexes of top/left and active cell
grow := GetGridRow(Worksheet.TopRow);
gcol := GetGridCol(Worksheet.LeftCol);
actgrow := GetGridRow(Worksheet.ActiveCellRow);
actgcol := GetGridCol(Worksheet.ActiveCellCol);
AutoExpandToRow(grow, aeNavigation);
AutoExpandToCol(gcol, aeNavigation);
if (grow <> Row) or (gcol <> Col) then
MoveExtend(false, gcol, grow);
inc(FLockSetup);
// Setup grid headers and col/row count
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;
case Worksheet.BiDiMode of
bdDefault: ParentBiDiMode := true;
bdLTR : begin
ParentBiDiMode := false;
BiDiMode := bdLeftToRight;
end;
bdRTL : begin
ParentBiDiMode := false;
BiDiMode := bdRightToLeft;
end;
end;
dec(FLockSetup);
end;
Setup;
// scroll the grid for top/left to be as stored in the sheet
if (grow <> TopRow) or (gcol <> LeftCol) then
begin
TopRow := gRow;
LeftCol := gCol;
end;
// Select active cell
AutoExpandToRow(actgrow, aeNavigation);
AutoExpandToCol(actgcol, aeNavigation);
if (actgrow <> Row) or (actgcol <> Col) then
MoveExtend(false, actgcol, actgrow);
finally
EndUpdate;
end;
end;
// Cell value or format changed
if (lniCell in AChangedItems) then
begin
cell := PCell(AData);
if (cell <> nil) then begin
grow := GetGridRow(cell^.Row);
gcol := GetGridCol(cell^.Col);
AutoExpandToRow(grow, aeData);
AutoExpandToCol(gcol, aeData);
lRow := Worksheet.FindRow(cell^.Row);
if (lRow = nil) or (lRow^.RowHeightType <> rhtCustom) then
UpdateRowHeight(grow, true);
end;
Invalidate;
end;
// Selection changed
if (lniSelection in AChangedItems) and (Worksheet <> nil) then
begin
grow := GetGridRow(Worksheet.ActiveCellRow);
gcol := GetGridCol(Worksheet.ActiveCellCol);
AutoExpandToRow(grow, aeNavigation);
AutoExpandToCol(gcol, aeNavigation);
if (grow <> Row) or (gcol <> Col) then
MoveExtend(false, gcol, grow);
if Worksheet.IsProtected then
begin
cell := Worksheet.FindCell(Worksheet.ActiveCellRow, Worksheet.ActiveCellCol);
FReadOnly := (cell = nil) or (cpLockCell in Worksheet.ReadCellProtection(cell));
end else
FReadOnly := false;
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 or row record change).
if (lniRow in AChangedItems) and (Worksheet <> nil) then
begin
srow := {%H-}PtrInt(AData); // sheet row
grow := GetGridRow(srow); // grid row
AutoExpandToRow(grow, aeData);
lRow := Worksheet.FindRow(srow);
if (lRow = nil) or (lRow^.RowHeightType <> rhtCustom) then
UpdateRowHeight(grow, true);
end;
// Column width
if (lniCol in AChangedItems) and (Worksheet <> nil) then
begin
scol := {%H-}PtrInt(AData); // sheet column index
gcol := GetGridCol(scol);
//lCol := Worksheet.FindCol(scol);
UpdateColWidth(gcol);
end;
// Worksheet zoom
if (lniWorksheetZoom in AChangedItems) and (Worksheet <> nil) then
AdaptToZoomFactor; // Reads value directly from Worksheet
{$IFDEF GRID_DEBUG}
if Worksheet <> nil then
DebugNotification('AFTER ListenerNotification WorksheetGrid "' + Worksheet.Name + '":');
{$ENDIF}
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
MergeCells(Selection);
end;
{@@ ----------------------------------------------------------------------------
Merges the cells of the specified cell block 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(ARect: TGridRect);
begin
MergeCells(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;
{@@ ----------------------------------------------------------------------------
Merges the cells of the specified cell block 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(ALeft, ATop, ARight, ABottom: Integer);
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Worksheet.MergeCells(
GetWorksheetRow(ATop),
GetWorksheetCol(ALeft),
GetWorksheetRow(ABottom),
GetWorksheetCol(ARight)
);
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;
err: String;
begin
if Worksheet = nil then
exit;
if not ValidFormula(FEditText, err) then begin
MessageDlg(err, mtError, [mbOK], 0);
exit;
end;
mouseCell := MouseToCell(Point(X, Y));
if FAllowDragAndDrop and
(not Assigned(DragManager) or not DragManager.IsDragging) and
(ssLeft in Shift) and
MouseOnCellBorder(Point(X, Y), Selection) then
begin
if DragBorderBitmap = nil then
CreateFillPattern(DragBorderBitmap, fsGray50, clBlack, clWhite);
FDragStartCol := Col;
FDragStartRow := Row;
FOldDragStartCol := Col;
FOldDragStartRow := Row;
BeginDrag(false, DragManager.DragThreshold);
exit;
end;
inherited;
if (ssLeft in Shift) then
begin
{ Prepare processing of the hyperlink: triggers a timer, the hyperlink is
executed when the timer has expired (see HyperlinkTimerElapsed). }
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);
begin
if Worksheet = nil then
exit;
inherited;
if MouseOnHeader(X,Y) then
exit;
if Assigned(Dragmanager) and DragManager.IsDragging then
begin
Cursor := crDefault;
end else
begin
if FHyperlinkTimer.Enabled and (ssLeft in Shift) then
FHyperlinkTimer.Enabled := false;
if MouseOnCellBorder(Point(X, Y), Selection) then
FDragTimer.Enabled := true
else
Cursor := crDefault;
end;
end;
{@@ Checks whether the specified point is on the border of a given cell.
The tolerance is defined by the global variable CELL_BORDER_DELTA }
function TsCustomWorksheetGrid.MouseOnCellBorder(const APoint: TPoint;
const ACellRect: TGridRect): Boolean;
var
R: TRect;
R1, R2: TRect;
begin
R := CellRect(ACellRect.Left, ACellRect.Top, ACellRect.Right, ACellRect.Bottom);
R1 := R;
InflateRect(R1, CELL_BORDER_DELTA, CELL_BORDER_DELTA);
R2 := R;
InflateRect(R2, -CELL_BORDER_DELTA, -CELL_BORDER_DELTA);
Result := PtInRect(R1, APoint) and not PtInRect(R2, APoint);
end;
function TsCustomWorksheetGrid.MouseOnHeader(X, Y: Integer): Boolean;
var
R: TRect;
begin
if FHeaderCount = 0 then
exit(false);
R := CellRect(0, 0);
Result := (Y < R.Bottom) or (X < R.Right);
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 = nil;
{$IFNDEF FPS_NO_GRID_MULTISELECT}
i: Integer;
{$ENDIF}
begin
if (FActiveCellLock > 0) or (Assigned(DragManager) and DragManager.IsDragging) then
exit;
if Worksheet <> nil then
begin
{$IFNDEF FPS_NO_GRID_MULTISELECT}
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;
inherited;
Refresh;
end;
{$IFNDEF LCL_FULLVERSION_LT_v190} // Supported by Laz v1.9+
function TsCustomWorksheetGrid.MoveNextSelectable(Relative: Boolean; DCol, DRow: Integer
): Boolean;
var
cell: PCell;
r1, r2, c1, c2: Cardinal;
begin
if Relative then begin
cell := Worksheet.FindCell(GetWorksheetRow(Row), GetWorksheetCol(Col));
if Worksheet.IsMerged(cell) then begin
Worksheet.FindMergedRange(cell, r1,c1,r2,c2);
// we are only interested on relative movement (basically by keyboard)
if DCol>0 then DCol := GetGridCol(c2) - Col + 1 else
if DCol<0 then DCol := GetGridCol(c1) - Col - 1 else
if DRow>0 then DRow := GetGridRow(r2) - Row + 1 else
if DRow<0 then DRow := GetGridRow(r1) - Row - 1;
end;
end;
Result := inherited MoveNextSelectable(Relative, DCol, DRow);
end;
{$ENDIF}
{@@ ----------------------------------------------------------------------------
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
GetWorkbookSource.CreateNewWorkbook;
ColCount := AColCount + FHeaderCount;
RowCount := ARowCount + FHeaderCount;
Setup;
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;
{@@ Prepares the Canvas default font for methods determining text size }
procedure TsCustomWorksheetGrid.PrepareCanvasFont;
var
fnt: TsFont;
begin
if Worksheet = nil then
Canvas.Font.Assign(Font)
else
begin
fnt := Workbook.GetDefaultFont;
Convert_sFont_to_Font(fnt, Canvas.Font);
end;
Canvas.Font.Height := Round(ZoomFactor * Canvas.Font.Height);
end;
function TsCustomWorksheetGrid.RelaxAutoExpand: TsAutoExpandModes;
begin
Result := FAutoExpand;
FAutoExpand := [aeData, aeNavigation];
end;
procedure TsCustomWorksheetGrid.RestoreAutoExpand(AValue: TsAutoExpandModes);
begin
FAutoExpand := AValue;
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.
Call this method only for built-in file formats.
@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;
{@@ ----------------------------------------------------------------------------
Writes the workbook represented by the grid to a spreadsheet file.
Call this method for both built-in and user-provided file formats.
@param(AFileName Name of the file to which the workbook is to be saved.)
@param(AFormatID Identifier for the 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;
AFormatID: TsSpreadFormatID; AOverwriteExisting: Boolean = true);
begin
if Workbook <> nil then
Workbook.WriteToFile(AFileName, AFormatID, 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 it 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;
{@@ ----------------------------------------------------------------------------
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
GetWorkbookSource.SelectWorksheet(Workbook.GetWorksheetByIndex(AIndex));
end;
{@@ ----------------------------------------------------------------------------
Standard method inherited from TCustomGrid. Is overridden to prevent
selection of cells in a protected worksheet. Details depend on whether
the elements spSelectLockedCells and/or spSelectUnlockedCells are included in
the worksheet's set of protections, and whether the cell to be selected is
locked or not.
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.SelectCell(ACol, ARow: Integer): Boolean;
var
cell: PCell;
cp: TsCellProtections;
err: String;
begin
// Checking validity of formula in current cell
if Assigned(Worksheet) and EditorMode then begin
if not ValidFormula(FEditText, err) then begin
FGridState := gsNormal;
MessageDlg(err, mtError, [mbOK], 0);
Result := false;
exit;
end;
end;
Result := inherited;
if Result and Assigned(Worksheet) and Worksheet.IsProtected then
begin
cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
cp := Worksheet.ReadCellProtection(cell);
if (cpLockCell in cp) and (spSelectLockedCells in Worksheet.Protection) then
Result := false;
if not (cpLockCell in cp) and (spSelectUnlockedCells in Worksheet.Protection) then
Result := false;
end;
end;
{@@ Event handler which fires when an element of the SelectionPen changes. }
procedure TsCustomWorksheetGrid.GenericPenChangeHandler(Sender: TObject);
begin
InvalidateGrid;
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;
var
maxColCount, maxRowCount: Integer;
begin
if csLoading in ComponentState then
exit;
if FLockSetup > 0 then
exit;
if not HandleAllocated then //or (not Parent.HandleAllocated) then
//Avoid crash when accessing the canvas, e.g. in GetDefaultHeaderColWidth
exit;
if (Worksheet = nil) or (Worksheet.GetCellCount = 0) then begin
FixedCols := FFrozenCols + FHeaderCount;
FixedRows := FFrozenRows + FHeaderCount;
if ShowHeaders then begin
PrepareCanvasFont; // Applies the zoom factor
ColWidths[0] := GetFixedColWidth;
RowHeights[0] := GetDefaultRowHeight;
end;
FTopLeft := CalcTopLeft(false);
end else
if Worksheet <> nil then begin
maxColCount := IfThen(aeDefault in FAutoExpand, DEFAULT_COL_COUNT, 1);
maxRowCount := IfThen(aeDefault in FAutoExpand, DEFAULT_ROW_COUNT, 1);
ColCount := Max(GetGridCol(Worksheet.GetLastColIndex) + 1, maxColCount);
RowCount := Max(GetGridRow(Worksheet.GetLastRowIndex) + 1, maxRowCount);
FixedCols := FFrozenCols + FHeaderCount;
FixedRows := FFrozenRows + FHeaderCount;
if ShowHeaders then begin
PrepareCanvasFont;
ColWidths[0] := GetFixedColWidth;
RowHeights[0] := GetDefaultRowHeight;
end;
FTopLeft := CalcTopLeft(false);
end;
UpdateColWidths;
UpdateRowHeights;
//Invalidate; // wp: really needed? Might cause flicker
end;
{@@ ----------------------------------------------------------------------------
Setter to define the link to the workbook.
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.SetWorkbookSource(AValue: TsWorkbookSource);
begin
if AValue = FWorkbookSource then
exit;
if FWorkbookSource <> nil then
FWorkbookSource.RemoveListener(self);
FInternalWorkbookSource.RemoveListener(self);
if (AValue = FInternalWorkbookSource) or (AValue = nil) then
begin
FWorkbookSource := nil;
FInternalWorkbookSource.AddListener(self);
end else
begin
FWorkbookSource := AValue;
FWorkbookSource.AddListener(self);
end;
if not (csDestroying in ComponentState) and Assigned(Parent) then
ListenerNotification([lniWorksheet, lniSelection]);
end;
{@@ ----------------------------------------------------------------------------
Shows cell borders for the cells in the range between columns ALeft and ARight
and rows ATop and ABottom.
The border of the block's left outer edge is defined by ALeftOuterStyle,
that of the block's top outer edge by ATopOuterStyle, etc.
Set the color of a border style to scNotDefined or scTransparent in order to
hide the corresponding border line, or use the constant NO_CELL_BORDER.
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.ShowCellBorders(ALeft, ATop, ARight, ABottom: Integer;
const ALeftOuterStyle, ATopOuterStyle, ARightOuterStyle, ABottomOuterStyle,
AHorInnerStyle, AVertInnerStyle: TsCellBorderStyle);
function BorderVisible(const AStyle: TsCellBorderStyle): Boolean;
begin
Result := (AStyle.Color <> scNotDefined) and (AStyle.Color <> scTransparent);
end;
procedure ProcessBorder(ARow, ACol: Cardinal; ABorder: TsCellBorder;
const AStyle: TsCellBorderStyle);
var
cb: TsCellBorders = [];
cell: PCell;
begin
cell := Worksheet.FindCell(ARow, ACol);
if cell <> nil then
cb := Worksheet.ReadCellBorders(cell);
if BorderVisible(AStyle) then
begin
Include(cb, ABorder);
cell := Worksheet.WriteBorders(ARow, ACol, cb);
Worksheet.WriteBorderStyle(cell, ABorder, AStyle);
end else
if cb <> [] then
begin
Exclude(cb, ABorder);
cell := Worksheet.WriteBorders(ARow, ACol, cb);
end;
FixNeighborCellBorders(cell);
end;
var
r, c, r1, c1, r2, c2: Cardinal;
begin
if Worksheet = nil then
exit;
// Preparations
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
r1 := GetWorksheetRow(ATop);
r2 := GetWorksheetRow(ABottom);
c1 := GetWorksheetCol(ALeft);
c2 := GetWorksheetCol(ARight);
// Top outer border
for c := c1 to c2 do
ProcessBorder(r1, c, cbNorth, ATopOuterStyle);
// Bottom outer border
for c := c1 to c2 do
ProcessBorder(r2, c, cbSouth, ABottomOuterStyle);
// Left outer border
for r := r1 to r2 do
ProcessBorder(r, c1, cbWest, ALeftOuterStyle);
// Right outer border
for r := r1 to r2 do
ProcessBorder(r, c2, cbEast, ARightOuterStyle);
// Horizontal inner border
if r1 <> r2 then
for r := r1 to r2-1 do
for c := c1 to c2 do
ProcessBorder(r, c, cbSouth, AHorInnerStyle);
// Vertical inner border
if c1 <> c2 then
for r := r1 to r2 do
for c := c1 to c2-1 do
ProcessBorder(r, c, cbEast, AVertInnerStyle);
end;
{@@ ----------------------------------------------------------------------------
Shows the column with the specified index previously hidden.
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.ShowCol(ACol: Integer);
var
c: Cardinal;
begin
c := GetWorksheetCol(ACol);
if Worksheet.ColHidden(c) then begin
Worksheet.ShowCol(c);
UpdateColWidth(ACol);
InvalidateGrid;
end;
end;
{@@ ----------------------------------------------------------------------------
Hides the column with the specifed index
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.HideCol(ACol: Integer);
var
c: Cardinal;
begin
c := GetWorksheetCol(ACol);
if not Worksheet.ColHidden(c) then begin
Worksheet.HideCol(c);
UpdateColWidth(ACol);
InvalidateGrid;
end;
end;
{@@ ----------------------------------------------------------------------------
Shows the row with the specified index previously hidden
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.ShowRow(ARow: Integer);
var
r: Cardinal;
begin
r := GetWorksheetRow(ARow);
if Worksheet.RowHidden(r) then begin
Worksheet.ShowRow(r);
UpdateRowHeight(ARow);
InvalidateGrid;
end;
end;
{@@ ----------------------------------------------------------------------------
Hides the row with the specifed index
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.HideRow(ARow: Integer);
var
r: Cardinal;
begin
r := GetWorksheetRow(ARow);
if not Worksheet.RowHidden(r) then begin
Worksheet.HideRow(r);
UpdateRowHeight(ARow);
InvalidateGrid;
end;
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. Otherwise
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;
{@@ ----------------------------------------------------------------------------
Converts a coordinate given in workbook units to pixels using the current
screen resolution
-------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.ToPixels(AValue: Double): Integer;
var
inches: Double;
begin
inches := Workbook.ConvertUnits(AValue, Workbook.Units, suInches);
Result := round(inches * Screen.PixelsPerInch);
end;
{@@ ----------------------------------------------------------------------------
Is called whenever the worksheet is scrolled.
Stores the coordinates of the TopLeft cell in the worksheet
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.TopLeftChanged;
begin
inherited;
Worksheet.ScrollTo(GetWorkSheetRow(TopRow), GetWorksheetCol(LeftCol));
end;
{@@ ----------------------------------------------------------------------------
Modifies the text that is shown 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;
fmt: PsCellFormat;
numFmt: TsNumFormatParams;
nfs: String;
isGeneralFmt: Boolean;
r1,c1,r2,c2: Cardinal;
begin
Result := Worksheet.ReadAsText(ACell);
if (Result = '') or ((ACell <> nil) and (ACell^.ContentType = cctUTF8String)) then
exit;
// fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
fmt := Worksheet.GetPointerToEffectiveCellFormat(ACell^.Row, ACell^.Col);
isRotated := (fmt^.TextRotation <> trHorizontal);
isStacked := (fmt^.TextRotation = rtStacked);
numFmt := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
isGeneralFmt := (numFmt = nil) or (numFmt.NumFormat = nfGeneral);
// Determine space available in cell
if Worksheet.IsMerged(ACell) then
begin
Worksheet.FindMergedRange(ACell, r1, c1, r2, c2);
cellSize := 0;
if isRotated then
for p:=GetGridRow(r1) to GetGridRow(r2) do cellSize := cellSize + RowHeights[p]
else
for p:=GetGridCol(c1) to GetGridCol(c2) do cellSize := cellSize + ColWidths[p];
end else
begin
if isRotated then
cellSize := RowHeights[GetGridRow(ACell^.Row)]
else
cellSize := ColWidths[GetGridCol(ACell^.Col)];
end;
cellSize := cellSize - 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 isGeneralFmt 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);
nfs := IfThen(decs = 0, '0E-00', '0.' + DupeString('0', decs) + 'E-00');
Result := FormatFloat(nfs, ACell^.NumberValue, Workbook.FormatSettings);
// 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;
{@@ ----------------------------------------------------------------------------
If the specified cell belongs to a merged block, the merged block is
split into single cells
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.UnmergeCells(ACol, ARow: Integer);
begin
Worksheet.UnmergeCells(
GetWorksheetRow(ARow),
GetworksheetCol(ACol)
);
end;
procedure TsCustomWorksheetGrid.UpdateColWidth(ACol: Integer);
var
lCol: PCol;
w: Integer; // Col width at current zoom level
w100: Integer; // Col width at 100% zoom level
begin
if Worksheet <> nil then
begin
lCol := Worksheet.FindCol(ACol - FHeaderCount);
if (lCol <> nil) and (croHidden in lCol^.Options) then
w := 0
else begin
if (lCol <> nil) and (lCol^.ColWidthType = cwtCustom) then
w100 := CalcColWidthFromSheet(lCol^.Width)
else
w100 := CalcColWidthFromSheet(Worksheet.ReadDefaultColWidth(Workbook.Units));
w := round(w100 * ZoomFactor);
end;
end else
w := DefaultColWidth; // Zoom factor has already been applied by getter
ColWidths[ACol] := w;
end;
{@@ ----------------------------------------------------------------------------
Updates column widths according to the data in the TCol records
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.UpdateColWidths(AStartIndex: Integer = 0);
var
i: Integer;
begin
if AStartIndex = 0 then
AStartIndex := FHeaderCount;
BeginUpdate;
try
for i := AStartIndex to ColCount-1 do
UpdateColWidth(i);
finally
EndUpdate;
end;
end;
{@@ ----------------------------------------------------------------------------
Updates the height if the specified row in the grid with the value stored in
the worksheet multiplied by the current zoom factor. If the stored row height
type is rhtAuto (meaning: "row height is auto-calculated") and the current
row height in the row record is 0 then the row height is calculated by
iterating over all cells in this row. This happens also if the parameter
AEnforceCalcRowHeight is @true.
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.UpdateRowHeight(ARow: Integer;
AEnforceCalcRowHeight: Boolean = false);
var
lRow: PRow;
sr: Cardinal;
h: Integer; // Row height, in pixels. Contains zoom factor.
doCalcRowHeight: Boolean;
begin
if not HandleAllocated then
exit;
if ARow < FHeaderCount then
exit;
h := DefaultRowHeight;
if Worksheet <> nil then
begin
sr := ARow - FHeaderCount; // worksheet row index
lRow := Worksheet.FindRow(sr);
if (lRow <> nil) then
begin
if (croHidden in lRow^.Options) then
h := 0
else begin
case lRow^.RowHeightType of
rhtCustom:
begin
h := round(CalcRowHeightFromSheet(lRow^.Height) * ZoomFactor);
if AEnforceCalcRowHeight then begin
h := CalcAutoRowHeight(ARow);
if h = 0 then begin
h := DefaultRowHeight;
lRow^.RowHeightType := rhtDefault;
end else
lRow^.RowHeightType := rhtAuto;
lRow^.Height := CalcRowHeightToSheet(round(h / ZoomFactor));
end;
end;
rhtAuto, rhtDefault:
begin
doCalcRowHeight := AEnforceCalcRowHeight or (lRow^.Height = 0);
if doCalcRowHeight then begin
// Calculate current grid row height in pixels by iterating over all cells in row
h := CalcAutoRowHeight(ARow); // ZoomFactor already applied to font heights
if h = 0 then begin
h := DefaultRowHeight; // Zoom factor applied by getter function
lRow^.RowHeightType := rhtDefault;
end else
lRow^.RowHeightType := rhtAuto;
// Calculate the unzoomed row height in workbook units and store
// in row record
lRow^.Height := CalcRowHeightToSheet(round(h / ZoomFactor));
end else
// If autocalc mode is off we just take the row height from the row record
case lRow^.RowHeightType of
rhtDefault : h := DefaultRowHeight;
rhtAuto : h := round(CalcRowHeightFromSheet(lRow^.Height) * ZoomFactor);
end;
end;
end; // case
if h = 0 then
h := DefaultRowHeight; // Zoom factor is applied by getter function
end;
end;
// No row record so far.
if lRow = nil then
begin
if Worksheet.GetCellCountInRow(sr) > 0 then
begin
// Case 1: This row does contain cells
lRow := Worksheet.AddRow(sr);
if AEnforceCalcRowHeight then
h := CalcAutoRowHeight(ARow)
else
h := DefaultRowHeight;
lRow^.Height := CalcRowHeightToSheet(round(h / ZoomFactor));
if h <> DefaultRowHeight then
lRow^.RowHeightType := rhtAuto
else
lRow^.RowHeightType := rhtDefault;
if h = 0 then
h := DefaultRowHeight; // Zoom factor is applied by getter function
end else
// Case 2: No cells in row
h := DefaultRowHeight; // Zoom factor is applied by getter function
end;
end;
inc(FZoomLock); // We don't want to modify the sheet row heights here.
RowHeights[ARow] := h;
dec(FZoomLock);
end;
{@@ ----------------------------------------------------------------------------
Updates grid row heights by using the data from the TRow records.
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.UpdateRowHeights(AStartRow: Integer = -1;
AEnforceCalcRowHeight: Boolean = false);
var
r, r1: Integer;
begin
if FRowHeightLock > 0 then
exit;
if AStartRow = -1 then
r1 := FHeaderCount else
r1 := AStartRow;
BeginUpdate;
try
for r:=r1 to RowCount-1 do
UpdateRowHeight(r, AEnforceCalcRowHeight);
finally
EndUpdate;
end;
end;
procedure TsCustomWorksheetGrid.WMHScroll(var message: TLMHScroll);
begin
inherited;
Invalidate;
end;
procedure TsCustomWorksheetGrid.WMVScroll(var message: TLMVScroll);
begin
inherited;
Invalidate;
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(ALeft, ATop, ARight, ABottom: Integer): TsColor;
var
c, r: Integer;
clr: TsColor;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellFontColor(ALeft, ATop);
clr := Result;
for c := ALeft to ARight do
for r := ATop to ABottom 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(ALeft, ATop, ARight, ABottom: Integer): String;
var
c, r: Integer;
s: String;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellFontName(ALeft, ATop);
s := Result;
for c := ALeft to ARight do
for r := ATop to ABottom 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(ALeft, ATop, ARight, ABottom: Integer): Single;
var
c, r: Integer;
sz: Single;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellFontSize(ALeft, ATop);
sz := Result;
for c := ALeft to ARight do
for r := ATop to ABottom 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(ALeft, ATop,
ARight, ABottom: Integer): TsFontStyles;
var
c, r: Integer;
style: TsFontStyles;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellFontStyle(ALeft, ATop);
style := Result;
for c := ALeft to ARight do
for r := ATop to ABottom do begin
Result := GetCellFontStyle(c, r);
if Result <> style then begin
Result := [];
exit;
end;
end;
end;
function TsCustomWorksheetGrid.GetCellFormula(ACol, ARow: Integer): String;
begin
if Worksheet <> nil then
Result := Worksheet.ReadFormula(GetWorksheetRow(ARow), GetWorksheetCol(ACol))
else
Result :='';
end;
function TsCustomWorksheetGrid.GetCellProtection(ACol, ARow: Integer
): TsCellProtections;
var
cell:PCell;
begin
Result :=[];
if Worksheet <> nil then
begin
cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
Result := Worksheet.ReadCellProtection(cell) ;
end;
end;
function TsCustomWorksheetGrid.GetCellProtections(ALeft, ATop, ARight,
ABottom: Integer): TsCellProtections;
var
c, r: Integer;
b: TsCellProtections;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellProtection(ALeft, ATop);
b := Result;
for c := ALeft to ARight do
for r := ATop to ABottom do
begin
Result := GetCellProtection(c, r);
if Result <> b then
begin
Result := [];
exit;
end;
end;
end;
function TsCustomWorksheetGrid.GetCellValue(ACol, ARow: Integer): variant;
var
cell: PCell;
begin
Result := Null;
if Assigned(Worksheet) then
begin
cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if cell <> nil then
case cell^.ContentType of
cctEmpty : ;
cctNumber,
cctDateTime : Result := cell^.NumberValue;
cctUTF8String: Result := cell^.UTF8Stringvalue;
cctBool : Result := cell^.BoolValue;
cctError : Result := cell^.ErrorValue;
end;
end;
end;
function TsCustomWorksheetGrid.GetColWidths(ACol: Integer): Integer;
begin
Result := inherited ColWidths[ACol];
end;
function TsCustomWorksheetGrid.GetDefColWidth: Integer;
begin
Result := round(FDefColWidth100 * ZoomFactor);
end;
function TsCustomWorksheetGrid.GetDefRowHeight: Integer;
begin
Result := round(FDefRowHeight100 * Zoomfactor);
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(ALeft, ATop, ARight, ABottom: Integer): TsHorAlignment;
var
c, r: Integer;
horalign: TsHorAlignment;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetHorAlignment(ALeft, ATop);
horalign := Result;
for c := ALeft to ARight do
for r := ATop to ABottom do begin
Result := GetHorAlignment(c, r);
if Result <> horalign then begin
Result := haDefault;
exit;
end;
end;
end;
function TsCustomWorksheetGrid.GetHyperlink(ACol, ARow: Integer): String;
var
hlink: TsHyperlink;
begin
Result := '';
if Assigned(Worksheet) then
begin
hlink := Worksheet.ReadHyperLink(Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)));
if hlink.Target <> '' then begin
Result := hlink.Target;
if hlink.Tooltip <> '' then Result := Result + '|' + hlink.ToolTip;
end;
end;
end;
function TsCustomWorksheetGrid.GetNumberFormat(ACol, ARow: Integer): String;
var
nf: TsNumberFormat;
cell: PCell;
begin
Result := '';
if Assigned(Worksheet) and Assigned(Workbook) then
begin
cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if cell <> nil then
Worksheet.ReadNumFormat(cell, nf, Result);
end;
end;
function TsCustomWorksheetGrid.GetNumberFormats(ALeft, ATop,
ARight, ABottom: Integer): String;
var
c, r: Integer;
nfs: String;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
nfs := GetNumberformat(ALeft, ATop);
for r := ALeft to ARight do
for c := ATop to ABottom do
if nfs <> GetNumberFormat(c, r) then
begin
Result := '';
exit;
end;
Result := nfs;
end;
function TsCustomWorksheetGrid.GetRowHeights(ARow: Integer): Integer;
begin
Result := inherited RowHeights[ARow];
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(ALeft, ATop,
ARight, ABottom: Integer): TsTextRotation;
var
c, r: Integer;
textrot: TsTextRotation;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetTextRotation(ALeft, ATop);
textrot := Result;
for c := ALeft to ARight do
for r := ATop to ABottom do
begin
Result := GetTextRotation(c, r);
if Result <> textrot then
begin
Result := trHorizontal;
exit;
end;
end;
end;
function TsCustomWorksheetGrid.GetWorkbookSource: TsWorkbookSource;
begin
if FWorkbookSource <> nil then
Result := FWorkbookSource
else
Result := FInternalWorkbookSource;
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(
ALeft, ATop, ARight, ABottom: Integer): TsVertAlignment;
var
c, r: Integer;
vertalign: TsVertAlignment;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetVertalignment(ALeft, ATop);
vertalign := Result;
for c := ALeft to ARight do
for r := ATop to ABottom do begin
Result := GetVertAlignment(c, r);
if Result <> vertalign then begin
Result := vaDefault;
exit;
end;
end;
end;
function TsCustomWorksheetGrid.GetWorkbook: TsWorkbook;
begin
Result := GetWorkbookSource.Workbook;
end;
function TsCustomWorksheetGrid.GetWorksheet: TsWorksheet;
begin
Result := GetWorkbookSource.Worksheet;
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(ALeft, ATop,
ARight, ABottom: Integer): Boolean;
var
c, r: Integer;
wrapped: Boolean;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetWordwrap(ALeft, ATop);
wrapped := Result;
for c := ALeft to ARight do
for r := ATop to ABottom do begin
Result := GetWordwrap(c, r);
if Result <> wrapped then begin
Result := false;
exit;
end;
end;
end;
function TsCustomWorksheetGrid.GetZoomFactor: Double;
begin
if Worksheet <> nil then
Result := Worksheet.Zoomfactor
else
Result := 1.0;
end;
procedure TsCustomWorksheetGrid.SetAutoCalc(AValue: Boolean);
var
optns: TsWorkbookOptions;
begin
FAutoCalc := AValue;
if Assigned(WorkbookSource) then
begin
optns := WorkbookSource.Options;
if FAutoCalc then
Include(optns, boAutoCalc)
else
Exclude(optns, boAutoCalc);
WorkbookSource.Options := optns;
if FInternalWorkbookSource <> nil then
FInternalWorkbookSource.Options := optns;
Invalidate;
end;
end;
procedure TsCustomWorksheetGrid.SetAutoDetectCellType(AValue: Boolean);
begin
FAutoDetectCellType := AValue;
if Assigned(Worksheet) then begin
if FAutoDetectCellType then
Worksheet.Options := Worksheet.Options + [soAutoDetectCellType]
else
Worksheet.Options := Worksheet.Options - [soAutoDetectCellType];
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(
ALeft, ATop, ARight, ABottom: Integer; AValue: TsColor);
var
c,r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom do
SetBackgroundColor(c, r, AValue);
finally
EndUpdate;
end;
end;
procedure TsCustomWorksheetGrid.SetCellBiDiMode(ACol, ARow: Integer;
AValue: TsBiDiMode);
begin
if Assigned(Worksheet) then
Worksheet.WriteBiDiMode(GetWorksheetRow(ARow), GetWorksheetCol(ACol), AValue);
end;
procedure TsCustomWorksheetGrid.SetCellBorder(ACol, ARow: Integer;
AValue: TsCellBorders);
var
cell: PCell;
sr1, sc1, sr2, sc2: Cardinal;
gr1, gc1, gr2, gc2: Integer;
styles, saved_styles: TsCellBorderStyles;
begin
if Assigned(Worksheet) then begin
BeginUpdate;
try
cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if Worksheet.IsMergeBase(cell) then
begin
styles := Worksheet.ReadCellBorderStyles(cell);
saved_styles := styles;
if not (cbEast in AValue) then
styles[cbEast] := NO_CELL_BORDER;
if not (cbWest in AValue) then styles[cbWest] := NO_CELL_BORDER;
if not (cbNorth in AValue) then styles[cbNorth] := NO_CELL_BORDER;
if not (cbSouth in AValue) then styles[cbSouth] := NO_CELL_BORDER;
Worksheet.FindMergedRange(cell, sr1, sc1, sr2, sc2);
gr1 := GetGridRow(sr1);
gr2 := GetGridRow(sr2);
gc1 := GetGridCol(sc1);
gc2 := GetGridCol(sc2);
// Set border flags and styles for all outer cells of the merged block
// Note: This overwrites the styles of the base ...
ShowCellBorders(gc1,gr1, gc2,gr2, styles[cbWest], styles[cbNorth],
styles[cbEast], styles[cbSouth], NO_CELL_BORDER, NO_CELL_BORDER);
// ... Restores base border style overwritten in prev instruction
Worksheet.WriteBorderStyles(cell, saved_styles);
Worksheet.WriteBorders(cell, AValue);
end else
begin
Worksheet.WriteBorders(cell, AValue);
// FixNeighborCellBorders(cell);
end;
finally
EndUpdate;
end;
end;
end;
procedure TsCustomWorksheetGrid.SetCellBorders(
ALeft, ATop, ARight, ABottom: Integer; AValue: TsCellBorders);
var
c,r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom do
SetCellBorder(c, r, AValue);
finally
EndUpdate;
end;
end;
procedure TsCustomWorksheetGrid.SetCellBorderStyle(ACol, ARow: Integer;
ABorder: TsCellBorder; AValue: TsCellBorderStyle);
var
cell: PCell;
borders: TsCellBorders;
begin
if Assigned(Worksheet) then begin
BeginUpdate;
try
cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if Worksheet.IsMergeBase(cell) then
begin
borders := Worksheet.ReadCellBorders(cell);
Worksheet.WriteBorderStyle(cell, ABorder, AValue);
// This will apply the new border style to the outer cells of the range.
SetCellBorder(ACol, ARow, borders);
end else
begin
Worksheet.WriteBorderStyle(cell, ABorder, AValue);
// FixNeighborCellBorders(cell);
end;
finally
EndUpdate;
end;
end;
end;
procedure TsCustomWorksheetGrid.SetCellBorderStyles(ALeft, ATop,
ARight, ABottom: Integer; ABorder: TsCellBorder; AValue: TsCellBorderStyle);
var
c,r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom do
SetCellBorderStyle(c, r, ABorder, AValue);
finally
EndUpdate;
end;
end;
procedure TsCustomWorksheetGrid.SetCellComment(ACol, ARow: Integer;
AValue: String);
begin
if Assigned(Worksheet) then
Worksheet.WriteComment(GetWorksheetRow(ARow), GetWorksheetCol(ACol), AValue);
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(ALeft, ATop, ARight, ABottom: Integer;
AValue: TFont);
var
c,r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom 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(
ALeft, ATop, ARight, ABottom: Integer; AValue: TsColor);
var
c,r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom 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(
ALeft, ATop, ARight, ABottom: Integer; AValue: String);
var
c,r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom 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(
ALeft, ATop, ARight, ABottom: Integer; AValue: Single);
var
c,r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom 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(
ALeft, ATop, ARight, ABottom: Integer; AValue: TsFontStyles);
var
c,r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom do
SetCellFontStyle(c, r, AValue);
finally
EndUpdate;
end;
end;
procedure TsCustomWorksheetGrid.SetCellFormula(ACol, ARow: Integer;
AValue: String);
begin
if Assigned(Worksheet) then
Worksheet.WriteFormula(GetWorksheetRow(ARow), GetWorksheetCol(ACol), AValue);
end;
procedure TsCustomWorksheetGrid.SetCellProtection(ACol, ARow: Integer;
AValue: TsCellProtections);
begin
if Assigned(Worksheet) then
Worksheet.WriteCellProtection(GetWorksheetRow(ARow), GetWorksheetCol(ACol), AValue);
end;
procedure TsCustomWorksheetGrid.SetCellProtections(ALeft, ATop, ARight,
ABottom: Integer; AValue: TsCellProtections);
var
c, r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom do
SetCellProtection(c, r, AValue);
finally
EndUpdate;
end;
end;
procedure TsCustomWorksheetGrid.SetCellValue(ACol, ARow: Integer; AValue: Variant);
var
cell: PCell = nil;
fmt: PsCellFormat = nil;
idx: Integer;
nfp: TsNumFormatParams;
r, c: Cardinal;
s, plain: String;
rtParams: TsRichTextParams;
begin
if not Assigned(Worksheet) then
exit;
r := GetWorksheetRow(ARow);
c := GetWorksheetCol(ACol);
// If the cell already exists and contains a formula then the formula must be
// removed. The formula would dominate over the data value.
cell := Worksheet.FindCell(r, c);
if HasFormula(cell) then
Worksheet.UseformulaInCell(cell, nil); //cell^.FormulaValue := '';
if VarIsNull(AValue) then
Worksheet.WriteBlank(r, c)
else
if VarIsStr(AValue) then
begin
s := VarToStr(AValue);
if (s <> '') and (s[1] = '=') then
Worksheet.WriteFormula(r, c, Copy(s, 2, Length(s)), true)
else
begin
if cell = nil then cell := Worksheet.GetCell(r, c);
if s = '' then
Worksheet.WriteBlank(cell)
else begin
HTMLToRichText(Workbook, Worksheet.ReadCellFont(cell), s, plain, rtParams);
Worksheet.WriteText(cell, plain, rtParams); // This will erase a non-formatted cell if s = ''
end;
end;
end else
if VarIsType(AValue, varDate) then
Worksheet.WriteDateTime(r, c, VarToDateTime(AValue))
else
if VarIsNumeric(AValue) then
begin
// Check if the cell already exists and contains a format.
// If it is a date/time format write a date/time cell...
if cell <> nil then
begin
idx := Worksheet.GetEffectiveCellFormatIndex(cell);
fmt := Workbook.GetPointerToCellFormat(idx);
if fmt <> nil then
nfp := Workbook.GetNumberFormat(fmt^.NumberFormatIndex);
if (fmt <> nil) and IsDateTimeFormat(nfp) then
Worksheet.WriteDateTime(r, c, VarToDateTime(AValue)) else
Worksheet.WriteNumber(r, c, AValue);
end
else
// ... otherwise write a number cell
Worksheet.WriteNumber(r, c, AValue);
end else
if VarIsBool(AValue) then
Worksheet.WriteBoolValue(r, c, AValue);
end;
procedure TsCustomWorksheetGrid.SetColWidths(ACol: Integer; AValue: Integer);
begin
if GetColWidths(ACol) = AValue then
exit;
inherited ColWidths[ACol] := AValue;
HeaderSized(true, ACol);
end;
procedure TsCustomWorksheetGrid.SetDefColWidth(AValue: Integer);
begin
if (AValue = GetDefColWidth) or (AValue < 0) then
exit;
{ AValue contains the zoom factor.
FDefColWidth1000 is the col width at zoom factor 1.0 }
FDefColWidth100 := round(AValue / ZoomFactor);
inherited DefaultColWidth := AValue;
if (FHeaderCount > 0) and HandleAllocated then begin
PrepareCanvasFont;
ColWidths[0] := GetFixedColWidth;
end;
if (FZoomLock = 0) and (Worksheet <> nil) then
Worksheet.WriteDefaultColWidth(CalcWorksheetColWidth(GetDefColWidth), Workbook.Units);
end;
procedure TsCustomWorksheetGrid.SetDefRowHeight(AValue: Integer);
begin
if (AValue = GetDefRowHeight) or (AValue < 0) then
exit;
{ AValue contains the zoom factor
FDefRowHeight100 is the row height at zoom factor 1.0 }
FDefRowHeight100 := round(AValue / ZoomFactor);
inherited DefaultRowHeight := AValue;
if FHeaderCount > 0 then
RowHeights[0] := GetDefaultRowHeight;
if (FZoomLock = 0) and (Worksheet <> nil) then
Worksheet.WriteDefaultRowHeight(CalcWorksheetRowHeight(GetDefaultRowHeight), Workbook.Units);
end;
procedure TscustomWorksheetGrid.SetEditorLineMode(AValue: TsEditorLineMode);
begin
if FLineMode = AValue then
exit;
FLineMode := AValue;
if (FLineMode = elmMultiline) and (FMultilineStringEditor = nil) then
begin
FMultilineStringEditor := TsMultilineStringCellEditor.Create(nil);
FMultilineStringEditor.name := 'MultilineStringEditor';
FMultilineStringEditor.Text := '';
FMultilineStringEditor.Visible := False;
FMultilineStringEditor.Align := alNone;
FMultilineStringEditor.BorderStyle := bsNone;
end;
end;
procedure TsCustomWorksheetGrid.SetFixedColWidth(AValue: Integer);
begin
if FFixedColWidth = AValue then exit;
FFixedColWidth := AValue;
if FHeaderCount > 0 then
begin
ColWidths[0] := GetFixedColWidth;
FTopLeft := CalcTopLeft(false);
end;
end;
procedure TsCustomWorksheetGrid.SetFrozenBorderPen(AValue: TPen);
begin
FFrozenBorderPen.Assign(AValue);
InvalidateGrid;
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(
ALeft, ATop, ARight, ABottom: Integer; AValue: TsHorAlignment);
var
c,r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom do
SetHorAlignment(c, r, AValue);
finally
EndUpdate;
end;
end;
procedure TsCustomWorksheetGrid.SetHyperlink(ACol, ARow: Integer;
AValue: String);
var
p: Integer;
cell: PCell;
begin
if Assigned(Worksheet) then
begin
cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if AValue <> '' then
begin
p := pos('|', AValue);
if p > 0 then
Worksheet.WriteHyperlink(cell, copy(AValue, 1, p-1), copy(AValue, p+1, MaxInt))
else
Worksheet.WriteHyperlink(cell, AValue);
end else
Worksheet.RemoveHyperlink(cell);
end;
end;
procedure TsCustomWorksheetGrid.SetNumberFormat(ACol, ARow: Integer; AValue: String);
begin
if Assigned(Worksheet) then
Worksheet.WriteNumberFormat(GetWorksheetRow(ARow), GetWorksheetCol(ACol), nfCustom, AValue);
end;
procedure TsCustomWorksheetGrid.SetNumberFormats(
ALeft, ATop, ARight, ABottom: Integer; AValue: String);
var
c,r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom do
SetNumberFormat(c, r, AValue);
finally
EndUpdate;
end;
end;
procedure TsCustomWorksheetGrid.SetPageBreakPen(AValue: TPen);
begin
FPageBreakPen.Assign(AValue);
InvalidateGrid;
end;
procedure TsCustomWorksheetGrid.SetReadFormulas(AValue: Boolean);
var
optns: TsWorkbookOptions;
begin
FReadFormulas := AValue;
if Assigned(WorkbookSource) then
begin
optns := WorkbookSource.Options;
if FReadFormulas then
Include(optns, boReadFormulas)
else
Exclude(optns, boReadFormulas);
WorkbookSource.Options := optns;
if FInternalWorkbookSource <> nil then
FInternalWorkbookSource.Options := optns;
end;
end;
procedure TsCustomWorksheetGrid.SetRowHeights(ARow: Integer; AValue: Integer);
begin
if GetRowHeights(ARow) = AValue then
exit;
inherited RowHeights[ARow] := AValue;
HeaderSized(false, ARow);
end;
procedure TsCustomWorksheetGrid.SetSelPen(AValue: TsSelPen);
begin
FSelPen.Assign(AValue);
InvalidateGrid;
end;
{@@ Shows/hides formulas in the grid when AutoCalc is off }
procedure TsCustomWorksheetGrid.SetShowFormulas(AValue: Boolean);
begin
if AValue = FShowFormulas then
exit;
FShowFormulas := AValue;
InvalidateGrid;
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);
var
hdrCount: Integer;
begin
if AValue = GetShowHeaders then Exit;
// Avoid crash if selected cell is at 0/0
hdrCount := ord(AValue);
if hdrCount > 0 then
begin
if Col < hdrCount then Col := hdrCount;
if Row < hdrCount then Row := hdrCount;
end;
FHeaderCount := hdrCount;
if Worksheet <> nil then
if AValue then
Worksheet.Options := Worksheet.Options + [soShowHeaders]
else
Worksheet.Options := Worksheet.Options - [soShowHeaders];
Setup;
end;
procedure TsCustomWorksheetGrid.SetShowPageBreaks(AValue: Boolean);
begin
if FShowPageBreaks = AValue then
exit;
FShowPageBreaks := AValue;
InvalidateGrid;
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(
ALeft, ATop, ARight, ABottom: Integer; AValue: TsTextRotation);
var
c,r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom 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(
ALeft, ATop, ARight, ABottom: Integer; AValue: TsVertAlignment);
var
c,r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom do
SetVertAlignment(c, r, AValue);
finally
EndUpdate;
end;
end;
procedure TsCustomWorksheetGrid.SetWordwrap(ACol, ARow: Integer;
AValue: Boolean);
var
cell: PCell;
begin
if not Assigned(Worksheet) then
exit;
BeginUpdate;
try
cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
Worksheet.WriteWordwrap(cell, AValue);
finally
EndUpdate;
end;
end;
procedure TsCustomWorksheetGrid.SetWordwraps(ALeft, ATop, ARight, ABottom: Integer;
AValue: Boolean);
var
c,r: Integer;
begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate;
try
for c := ALeft to ARight do
for r := ATop to ABottom do
SetWordwrap(c, r, AValue);
finally
EndUpdate;
end;
end;
procedure TsCustomWorksheetGrid.SetZoomFactor(AValue: Double);
begin
if (AValue <> GetZoomFactor) and Assigned(Worksheet) then begin
BeginUpdate;
try
Worksheet.ZoomFactor := abs(AValue);
finally
EndUpdate;
end;
end;
end;
procedure TsCustomWorksheetGrid.ValidateInput(var Msg: TLMessage);
var
grid: TsCustomWorksheetGrid;
errmsg: String;
ed: TWinControl;
begin
if TObject(Msg.lParam) is TsCustomWorksheetGrid then begin
grid := TsCustomWorksheetGrid(Msg.lParam);
if not ValidFormula(FEditText, errmsg) then begin
MessageDlg(errmsg, mtError, [mbOK], 0);
FRefocusing := grid; // Avoid an endless loop
grid.SetFocus; // Set focus back
if grid.EditorMode then begin
ed := grid.EditorByStyle(cbsAuto);
if ed is TCustomEdit then TCustomEdit(ed).SelStart := FRefocusingSelStart;
end;
end;
end;
end;
{@@ Checks whether the provided expression is a valid spreadsheet formula.
If not, a descriptive error message is returned in "AErrMsg", and the function
result becomes @false.
Decimal separator and date/time formats are expected to be localized.
In contrast to the Office applications, however, formula names are never
localized in fpspreadsheet. }
function TsCustomWorksheetGrid.ValidFormula(AExpression: String;
out AErrMsg: String): Boolean;
var
parser: TsSpreadsheetParser;
begin
Result := true;
if Assigned(Worksheet) and (AExpression <> '') and (AExpression[1] = '=') then
begin
parser := TsSpreadsheetParser.Create(Worksheet);
try
try
parser.Expression[fdLocalized] := AExpression;
except
on E: Exception do begin
AErrMsg := E.Message;
Result := false;
end;
end;
finally
parser.Free;
end;
end;
end;
initialization
{$I ../../resource/fpsvisual.lrs} // contains the DragCopy cursor
fpsutils.ScreenPixelsPerInch := Screen.PixelsPerInch;
FillPatternStyle := fsNoFill;
RegisterPropertyToSkip(TsCustomWorksheetGrid, 'ColWidths', 'taken from worksheet', '');
RegisterPropertyToSkip(TsCustomWorksheetGrid, 'RowHeights', 'taken from worksheet', '');
crDragCopy := 1; //201705;
Screen.Cursors[crDragCopy] := LoadCursorFromLazarusResource('cur_dragcopy');
finalization
FreeAndNil(FillPatternBitmap);
FreeAndNil(DragborderBitmap);
end.
Reference in New Issue View Git Blame Copy Permalink