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

fpspreadsheet: Add new method ShowCellBorders to TsWorksheetGrid for easier cell border creation. Replace in TsWorksheetGrid the TGridRect parameter of some public properties by the direct coordinates. WARNING: THIS CHANGE COULD BREAK EXISTING CODE.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4446 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-01-20 15:39:22 +00:00
parent f76da1c6b0
commit a352efef12
3 changed files with 371 additions and 188 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
components/fpspreadsheet/examples/visual/fpsgrid_no_install/mainfrm.pas
View File

@ -54,6 +54,8 @@ uses
procedure TForm1.FormCreate(Sender: TObject); procedure TForm1.FormCreate(Sender: TObject);
const const
THICK_BORDER: TsCellBorderStyle = (LineStyle: lsThick; Color: clNavy); THICK_BORDER: TsCellBorderStyle = (LineStyle: lsThick; Color: clNavy);
MEDIUM_BORDER: TsCellBorderSTyle = (LineStyle: lsMedium; Color: clRed);
DOTTED_BORDER: TsCellBorderSTyle = (LineStyle: lsDotted; Color: clRed);
begin begin
Grid := TsWorksheetGrid.Create(self); Grid := TsWorksheetGrid.Create(self);
@ -61,7 +63,7 @@ begin
Grid.Parent := TabControl; Grid.Parent := TabControl;
Grid.Align := alClient; Grid.Align := alClient;
// Useful options // Useful options and properties
Grid.Options := Grid.Options + [goColSizing, goRowSizing, Grid.Options := Grid.Options + [goColSizing, goRowSizing,
goFixedColSizing, // useful if the spreadsheet contains frozen columns goFixedColSizing, // useful if the spreadsheet contains frozen columns
goEditing, // needed for modifying cell content goEditing, // needed for modifying cell content
@ -76,20 +78,19 @@ begin
Grid.TextOverflow := true; // too long text extends into neighbor cells Grid.TextOverflow := true; // too long text extends into neighbor cells
Grid.AutoCalc := true; // automatically calculate formulas Grid.AutoCalc := true; // automatically calculate formulas
Grid.ShowHint := true; // needed to show cell comments Grid.ShowHint := true; // needed to show cell comments
Grid.RowCount := 10; // Prepare 10 columns (incl fixed header)
// Create an empty worksheet Grid.ColCount := 8; // and 8 rows (incl fixed header) - but grid expands automatically
//Grid.NewWorkbook(26, 100); // Not absolutely necessary - grid will expand automatically
// Add some cells and formats // Add some cells and formats
Grid.ColWidths[1] := 180; Grid.ColWidths[1] := 180;
Grid.ColWidths[2] := 80; Grid.ColWidths[2] := 100;
Grid.Cells[1,1] := 'This is a demo'; Grid.Cells[1,1] := 'This is a demo';
Grid.MergeCells(Rect(1,1, 2,1)); Grid.MergeCells(1,1, 2,1);
Grid.HorAlignment[1,1] := haCenter; Grid.HorAlignment[1,1] := haCenter;
Grid.CellBorders[Rect(1,1, 2,1)] := [cbSouth]; Grid.CellBorders[1,1, 2,1] := [cbSouth];
Grid.CellBorderStyles[Rect(1,1, 2,1), cbSouth] := THICK_BORDER; Grid.CellBorderStyles[1,1, 2,1, cbSouth] := THICK_BORDER;
Grid.BackgroundColors[Rect(1,1, 2,1)] := RGBToColor(220, 220, 220); Grid.BackgroundColors[1,1, 2,1] := RGBToColor(220, 220, 220);
Grid.CellFontColor[1,1] := clNavy; Grid.CellFontColor[1,1] := clNavy;
Grid.CellFontStyle[1,1] := [fssBold]; Grid.CellFontStyle[1,1] := [fssBold];
@ -103,7 +104,7 @@ begin
Grid.HorAlignment[1,3] := haRight; Grid.HorAlignment[1,3] := haRight;
Grid.CellFontStyle[1,3] := [fssItalic]; Grid.CellFontStyle[1,3] := [fssItalic];
Grid.CellFontColor[1,3] := clNavy; Grid.CellFontColor[1,3] := clNavy;
Grid.NumberFormat[2,3] := 'mm"/"dd, yyyy'; Grid.NumberFormat[2,3] := 'mmm dd, yyyy';
Grid.Cells[2,3] := date; Grid.Cells[2,3] := date;
Grid.Cells[1,4] := 'Time:'; Grid.Cells[1,4] := 'Time:';

506
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -80,61 +80,65 @@ type
// Setter/Getter // Setter/Getter
function GetBackgroundColor(ACol, ARow: Integer): TsColor; function GetBackgroundColor(ACol, ARow: Integer): TsColor;
function GetBackgroundColors(ARect: TGridRect): TsColor; function GetBackgroundColors(ALeft, ATop, ARight, ABottom: Integer): TsColor;
function GetCellBorder(ACol, ARow: Integer): TsCellBorders; function GetCellBorder(ACol, ARow: Integer): TsCellBorders;
function GetCellBorders(ARect: TGridRect): TsCellBorders; function GetCellBorders(ALeft, ATop, ARight, ABottom: Integer): TsCellBorders;
function GetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder): TsCellBorderStyle; function GetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder): TsCellBorderStyle;
function GetCellBorderStyles(ARect: TGridRect; ABorder: TsCellBorder): TsCellBorderStyle; function GetCellBorderStyles(ALeft, ATop, ARight, ABottom: Integer;
ABorder: TsCellBorder): TsCellBorderStyle;
function GetCellComment(ACol, ARow: Integer): string; function GetCellComment(ACol, ARow: Integer): string;
function GetCellFont(ACol, ARow: Integer): TFont; function GetCellFont(ACol, ARow: Integer): TFont;
function GetCellFonts(ARect: TGridRect): TFont; function GetCellFonts(ALeft, ATop, ARight, ABottom: Integer): TFont;
function GetCellFontColor(ACol, ARow: Integer): TsColor; function GetCellFontColor(ACol, ARow: Integer): TsColor;
function GetCellFontColors(ARect: TGridRect): TsColor; function GetCellFontColors(ALeft, ATop, ARight, ABottom: Integer): TsColor;
function GetCellFontName(ACol, ARow: Integer): String; function GetCellFontName(ACol, ARow: Integer): String;
function GetCellFontNames(ARect: TGridRect): String; function GetCellFontNames(ALeft, ATop, ARight, ABottom: Integer): String;
function GetCellFontSize(ACol, ARow: Integer): Single; function GetCellFontSize(ACol, ARow: Integer): Single;
function GetCellFontSizes(ARect: TGridRect): Single; function GetCellFontSizes(ALeft, ATop, ARight, ABottom: Integer): Single;
function GetCellFontStyle(ACol, ARow: Integer): TsFontStyles; function GetCellFontStyle(ACol, ARow: Integer): TsFontStyles;
function GetCellFontStyles(ARect: TGridRect): TsFontStyles; function GetCellFontStyles(ALeft, ATop, ARight, ABottom: Integer): TsFontStyles;
function GetCells(ACol, ARow: Integer): variant; reintroduce; function GetCells(ACol, ARow: Integer): variant; reintroduce;
function GetColWidths(ACol: Integer): Integer; function GetColWidths(ACol: Integer): Integer;
function GetDefColWidth: Integer; function GetDefColWidth: Integer;
function GetDefRowHeight: Integer; function GetDefRowHeight: Integer;
function GetHorAlignment(ACol, ARow: Integer): TsHorAlignment; function GetHorAlignment(ACol, ARow: Integer): TsHorAlignment;
function GetHorAlignments(ARect: TGridRect): TsHorAlignment; function GetHorAlignments(ALeft, ATop, ARight, ABottom: Integer): TsHorAlignment;
function GetHyperlink(ACol, ARow: Integer): String; function GetHyperlink(ACol, ARow: Integer): String;
function GetNumberFormat(ACol, ARow: Integer): String; function GetNumberFormat(ACol, ARow: Integer): String;
function GetNumberFormats(ARect: TGridRect): String; function GetNumberFormats(ALeft, ATop, ARight, ABottom: Integer): String;
function GetRowHeights(ARow: Integer): Integer; function GetRowHeights(ARow: Integer): Integer;
function GetShowGridLines: Boolean; function GetShowGridLines: Boolean;
function GetShowHeaders: Boolean; function GetShowHeaders: Boolean;
function GetTextRotation(ACol, ARow: Integer): TsTextRotation; function GetTextRotation(ACol, ARow: Integer): TsTextRotation;
function GetTextRotations(ARect: TGridRect): TsTextRotation; function GetTextRotations(ALeft, ATop, ARight, ABottom: Integer): TsTextRotation;
function GetVertAlignment(ACol, ARow: Integer): TsVertAlignment; function GetVertAlignment(ACol, ARow: Integer): TsVertAlignment;
function GetVertAlignments(ARect: TGridRect): TsVertAlignment; function GetVertAlignments(ALeft, ATop, ARight, ABottom: Integer): TsVertAlignment;
function GetWorkbook: TsWorkbook; function GetWorkbook: TsWorkbook;
function GetWorkbookSource: TsWorkbookSource; function GetWorkbookSource: TsWorkbookSource;
function GetWorksheet: TsWorksheet; function GetWorksheet: TsWorksheet;
function GetWordwrap(ACol, ARow: Integer): Boolean; function GetWordwrap(ACol, ARow: Integer): Boolean;
function GetWordwraps(ARect: TGridRect): Boolean; function GetWordwraps(ALeft, ATop, ARight, ABottom: Integer): Boolean;
procedure SetAutoCalc(AValue: Boolean); procedure SetAutoCalc(AValue: Boolean);
procedure SetBackgroundColor(ACol, ARow: Integer; AValue: TsColor); procedure SetBackgroundColor(ACol, ARow: Integer; AValue: TsColor);
procedure SetBackgroundColors(ARect: TGridRect; AValue: TsColor); procedure SetBackgroundColors(ALeft, ATop, ARight, ABottom: Integer; AValue: TsColor);
procedure SetCellBorder(ACol, ARow: Integer; AValue: TsCellBorders); procedure SetCellBorder(ACol, ARow: Integer; AValue: TsCellBorders);
procedure SetCellBorders(ARect: TGridRect; AValue: TsCellBorders); procedure SetCellBorders(ALeft, ATop, ARight, ABottom: Integer; AValue: TsCellBorders);
procedure SetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder; AValue: TsCellBorderStyle); procedure SetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder;
procedure SetCellBorderStyles(ARect: TGridRect; ABorder: TsCellBorder; AValue: TsCellBorderStyle); AValue: TsCellBorderStyle);
procedure SetCellBorderStyles(ALeft, ATop, ARight, ABottom: Integer;
ABorder: TsCellBorder; AValue: TsCellBorderStyle);
procedure SetCellComment(ACol, ARow: Integer; AValue: String); procedure SetCellComment(ACol, ARow: Integer; AValue: String);
procedure SetCellFont(ACol, ARow: Integer; AValue: TFont); procedure SetCellFont(ACol, ARow: Integer; AValue: TFont);
procedure SetCellFonts(ARect: TGridRect; AValue: TFont); procedure SetCellFonts(ALeft, ATop, ARight, ABottom: Integer; AValue: TFont);
procedure SetCellFontColor(ACol, ARow: Integer; AValue: TsColor); procedure SetCellFontColor(ACol, ARow: Integer; AValue: TsColor);
procedure SetCellFontColors(ARect: TGridRect; AValue: TsColor); procedure SetCellFontColors(ALeft, ATop, ARight, ABottom: Integer; AValue: TsColor);
procedure SetCellFontName(ACol, ARow: Integer; AValue: String); procedure SetCellFontName(ACol, ARow: Integer; AValue: String);
procedure SetCellFontNames(ARect: TGridRect; AValue: String); procedure SetCellFontNames(ALeft, ATop, ARight, ABottom: Integer; AValue: String);
procedure SetCellFontStyle(ACol, ARow: Integer; AValue: TsFontStyles);
procedure SetCellFontStyles(ARect: TGridRect; AValue: TsFontStyles);
procedure SetCellFontSize(ACol, ARow: Integer; AValue: Single); procedure SetCellFontSize(ACol, ARow: Integer; AValue: Single);
procedure SetCellFontSizes(ARect: TGridRect; 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 SetCells(ACol, ARow: Integer; AValue: variant); procedure SetCells(ACol, ARow: Integer; AValue: variant);
procedure SetColWidths(ACol: Integer; AValue: Integer); procedure SetColWidths(ACol: Integer; AValue: Integer);
procedure SetDefColWidth(AValue: Integer); procedure SetDefColWidth(AValue: Integer);
@ -142,21 +146,24 @@ type
procedure SetFrozenCols(AValue: Integer); procedure SetFrozenCols(AValue: Integer);
procedure SetFrozenRows(AValue: Integer); procedure SetFrozenRows(AValue: Integer);
procedure SetHorAlignment(ACol, ARow: Integer; AValue: TsHorAlignment); procedure SetHorAlignment(ACol, ARow: Integer; AValue: TsHorAlignment);
procedure SetHorAlignments(ARect: TGridRect; AValue: TsHorAlignment); procedure SetHorAlignments(ALeft, ATop, ARight, ABottom: Integer;
AValue: TsHorAlignment);
procedure SetHyperlink(ACol, ARow: Integer; AValue: String); procedure SetHyperlink(ACol, ARow: Integer; AValue: String);
procedure SetNumberFormat(ACol, ARow: Integer; AValue: String); procedure SetNumberFormat(ACol, ARow: Integer; AValue: String);
procedure SetNumberFormats(ARect: TGridRect; AValue: String); procedure SetNumberFormats(ALeft, ATop, ARight, ABottom: Integer; AValue: String);
procedure SetReadFormulas(AValue: Boolean); procedure SetReadFormulas(AValue: Boolean);
procedure SetRowHeights(ARow: Integer; AValue: Integer); procedure SetRowHeights(ARow: Integer; AValue: Integer);
procedure SetShowGridLines(AValue: Boolean); procedure SetShowGridLines(AValue: Boolean);
procedure SetShowHeaders(AValue: Boolean); procedure SetShowHeaders(AValue: Boolean);
procedure SetTextRotation(ACol, ARow: Integer; AValue: TsTextRotation); procedure SetTextRotation(ACol, ARow: Integer; AValue: TsTextRotation);
procedure SetTextRotations(ARect: TGridRect; AValue: TsTextRotation); procedure SetTextRotations(ALeft, ATop, ARight, ABottom: Integer;
AValue: TsTextRotation);
procedure SetVertAlignment(ACol, ARow: Integer; AValue: TsVertAlignment); procedure SetVertAlignment(ACol, ARow: Integer; AValue: TsVertAlignment);
procedure SetVertAlignments(ARect: TGridRect; AValue: TsVertAlignment); procedure SetVertAlignments(ALeft, ATop, ARight, ABottom: Integer;
AValue: TsVertAlignment);
procedure SetWorkbookSource(AValue: TsWorkbookSource); procedure SetWorkbookSource(AValue: TsWorkbookSource);
procedure SetWordwrap(ACol, ARow: Integer; AValue: boolean); procedure SetWordwrap(ACol, ARow: Integer; AValue: boolean);
procedure SetWordwraps(ARect: TGridRect; AValue: boolean); procedure SetWordwraps(ALeft, ATop, ARight, ABottom: Integer; AValue: boolean);
procedure HyperlinkTimerElapsed(Sender: TObject); procedure HyperlinkTimerElapsed(Sender: TObject);
@ -280,9 +287,14 @@ type
procedure MergeCells; overload; procedure MergeCells; overload;
procedure MergeCells(ARect: TGridRect); overload; procedure MergeCells(ARect: TGridRect); overload;
procedure MergeCells(ALeft, ATop, ARight, ABottom: Integer); overload;
procedure UnmergeCells; overload; procedure UnmergeCells; overload;
procedure UnmergeCells(ACol, ARow: Integer); overload; procedure UnmergeCells(ACol, ARow: Integer); overload;
procedure ShowCellBorders(ALeft, ATop, ARight, ABottom: Integer;
const ALeftOuterStyle, ATopOuterStyle, ARightOuterStyle, ABottomOuterStyle,
AHorInnerStyle, AVertInnerStyle: TsCellBorderStyle);
{ Utilities related to Workbooks } { Utilities related to Workbooks }
procedure Convert_sFont_to_Font(sFont: TsFont; AFont: TFont); procedure Convert_sFont_to_Font(sFont: TsFont; AFont: TFont);
procedure Convert_Font_to_sFont(AFont: TFont; sFont: TsFont); procedure Convert_Font_to_sFont(AFont: TFont; sFont: TsFont);
@ -309,14 +321,14 @@ type
read GetBackgroundColor write SetBackgroundColor; read GetBackgroundColor write SetBackgroundColor;
{@@ Common background color of the cells covered by the given rectangle. {@@ Common background color of the cells covered by the given rectangle.
Expressed as index into the workbook's color palette. } Expressed as index into the workbook's color palette. }
property BackgroundColors[ARect: TGridRect]: TsColor property BackgroundColors[ALeft, ATop, ARight, ABottom: Integer]: TsColor
read GetBackgroundColors write SetBackgroundColors; read GetBackgroundColors write SetBackgroundColors;
{@@ Set of flags indicating at which cell border a border line is drawn. } {@@ Set of flags indicating at which cell border a border line is drawn. }
property CellBorder[ACol, ARow: Integer]: TsCellBorders property CellBorder[ACol, ARow: Integer]: TsCellBorders
read GetCellBorder write SetCellBorder; read GetCellBorder write SetCellBorder;
{@@ Set of flags indicating at which border of a range of cells a border {@@ Set of flags indicating at which border of a range of cells a border
line is drawn } line is drawn }
property CellBorders[ARect: TGridRect]: TsCellBorders property CellBorders[ALeft, ATop, ARight, ABottom: Integer]: TsCellBorders
read GetCellBorders write SetCellBorders; read GetCellBorders write SetCellBorders;
{@@ Style of the border line at the given border of the cell at column ACol {@@ 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 and row ARow. Requires the cellborder flag of the border to be set
@ -326,7 +338,8 @@ type
{@@ Style of the border line at the given border of the cells within the {@@ 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 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 } flag of the border to be set for the border line to be shown }
property CellBorderStyles[ARect: TGridRect; ABorder: TsCellBorder]: TsCellBorderStyle property CellBorderStyles[ALeft, ATop, ARight, ABottom: Integer;
ABorder: TsCellBorder]: TsCellBorderStyle
read GetCellBorderStyles write SetCellBorderStyles; read GetCellBorderStyles write SetCellBorderStyles;
{@@ Comment assigned to the cell at column ACol and row ARow } {@@ Comment assigned to the cell at column ACol and row ARow }
property CellComment[ACol, ARow: Integer]: String property CellComment[ACol, ARow: Integer]: String
@ -336,21 +349,21 @@ type
read GetCellFont write SetCellFont; read GetCellFont write SetCellFont;
{@@ Font to be used for the cells in the column/row index range {@@ Font to be used for the cells in the column/row index range
given by the rectangle } given by the rectangle }
property CellFonts[ARect: TGridRect]: TFont property CellFonts[ALeft, ATop, ARight, ABottom: Integer]: TFont
read GetCellFonts write SetCellFonts; read GetCellFonts write SetCellFonts;
{@@ Color of the font used for the cell in column ACol and row ARow } {@@ Color of the font used for the cell in column ACol and row ARow }
property CellFontColor[ACol, ARow: Integer]: TsColor property CellFontColor[ACol, ARow: Integer]: TsColor
read GetCellFontColor write SetCellFontColor; read GetCellFontColor write SetCellFontColor;
{@@ Color of the font used for the cells within the range {@@ Color of the font used for the cells within the range
of column/row indexes defined by the rectangle, scUndefined if not constant. } of column/row indexes defined by the rectangle, scUndefined if not constant. }
property CellFontColors[ARect: TGridRect]: TsColor property CellFontColors[ALeft, ATop, ARight, ABottom: Integer]: TsColor
read GetCellFontColors write SetCellFontColors; read GetCellFontColors write SetCellFontColors;
{@@ Name of the font used for the cell in column ACol and row ARow } {@@ Name of the font used for the cell in column ACol and row ARow }
property CellFontName[ACol, ARow: Integer]: String property CellFontName[ACol, ARow: Integer]: String
read GetCellFontName write SetCellFontName; read GetCellFontName write SetCellFontName;
{@@ Name of the font used for the cells within the range {@@ Name of the font used for the cells within the range
of column/row indexes defined by the rectangle. } of column/row indexes defined by the rectangle. }
property CellFontNames[ARect: TGridRect]: String property CellFontNames[ALeft, ATop, ARight, ABottom: Integer]: String
read GetCellFontNames write SetCellFontNames; read GetCellFontNames write SetCellFontNames;
{@@ Style of the font (bold, italic, ...) used for text in the {@@ Style of the font (bold, italic, ...) used for text in the
cell at column ACol and row ARow. } cell at column ACol and row ARow. }
@ -358,7 +371,7 @@ type
read GetCellFontStyle write SetCellFontStyle; read GetCellFontStyle write SetCellFontStyle;
{@@ Style of the font (bold, italic, ...) used for the cells within {@@ Style of the font (bold, italic, ...) used for the cells within
the range of column/row indexes defined by the rectangle. } the range of column/row indexes defined by the rectangle. }
property CellFontStyles[ARect: TGridRect]: TsFontStyles property CellFontStyles[ALeft, ATop, ARight, ABottom: Integer]: TsFontStyles
read GetCellFontStyles write SetCellFontStyles; read GetCellFontStyles write SetCellFontStyles;
{@@ Size of the font (in points) used for the cell at column ACol {@@ Size of the font (in points) used for the cell at column ACol
and row ARow } and row ARow }
@ -366,7 +379,7 @@ type
read GetCellFontSize write SetCellFontSize; read GetCellFontSize write SetCellFontSize;
{@@ Size of the font (in points) used for the cells within the {@@ Size of the font (in points) used for the cells within the
range of column/row indexes defined by the rectangle. } range of column/row indexes defined by the rectangle. }
property CellFontSizes[ARect: TGridRect]: Single property CellFontSizes[ALeft, ATop, ARight, ABottom: Integer]: Single
read GetCellFontSizes write SetCellFontSizes; read GetCellFontSizes write SetCellFontSizes;
{@@ Cell values } {@@ Cell values }
property Cells[ACol, ARow: Integer]: Variant property Cells[ACol, ARow: Integer]: Variant
@ -377,7 +390,7 @@ type
read GetHorAlignment write SetHorAlignment; read GetHorAlignment write SetHorAlignment;
{@@ Parameter for the horizontal text alignments in all cells within the {@@ Parameter for the horizontal text alignments in all cells within the
range cf column/row indexes defined by the rectangle. } range cf column/row indexes defined by the rectangle. }
property HorAlignments[ARect: TGridRect]: TsHorAlignment property HorAlignments[ALeft, ATop, ARight, ABottom: Integer]: TsHorAlignment
read GetHorAlignments write SetHorAlignments; read GetHorAlignments write SetHorAlignments;
{@@ Hyperlink assigned to the cell in row ARow and column ACol } {@@ Hyperlink assigned to the cell in row ARow and column ACol }
property Hyperlink[ACol, ARow: Integer]: String property Hyperlink[ACol, ARow: Integer]: String
@ -387,14 +400,14 @@ type
read GetNumberFormat write SetNumberFormat; read GetNumberFormat write SetNumberFormat;
{@@ Number format (as Excel string) to be applied to all cells within the {@@ Number format (as Excel string) to be applied to all cells within the
range of column/row indexes defined by the rectangle. } range of column/row indexes defined by the rectangle. }
property NumberFormats[ARect: TGridRect]: String property NumberFormats[ALeft, ATop, ARight, ABottom: Integer]: String
read GetNumberFormats write SetNumberFormats; read GetNumberFormats write SetNumberFormats;
{@@ Rotation of the text in the cell at column ACol and row ARow. } {@@ Rotation of the text in the cell at column ACol and row ARow. }
property TextRotation[ACol, ARow: Integer]: TsTextRotation property TextRotation[ACol, ARow: Integer]: TsTextRotation
read GetTextRotation write SetTextRotation; read GetTextRotation write SetTextRotation;
{@@ Rotation of the text in the cells within the range of column/row indexes {@@ Rotation of the text in the cells within the range of column/row indexes
defined by the rectangle. } defined by the rectangle. }
property TextRotations[ARect: TGridRect]: TsTextRotation property TextRotations[ALeft, ATop, ARight, ABottom: Integer]: TsTextRotation
read GetTextRotations write SetTextRotations; read GetTextRotations write SetTextRotations;
{@@ Parameter for vertical text alignment in the cell at column ACol and {@@ Parameter for vertical text alignment in the cell at column ACol and
row ARow. } row ARow. }
@ -402,7 +415,7 @@ type
read GetVertAlignment write SetVertAlignment; read GetVertAlignment write SetVertAlignment;
{@@ Parameter for vertical text alignment in the cells having column/row {@@ Parameter for vertical text alignment in the cells having column/row
indexes defined by the rectangle. } indexes defined by the rectangle. }
property VertAlignments[ARect: TGridRect]: TsVertAlignment property VertAlignments[ALeft, ATop, ARight, ABottom: Integer]: TsVertAlignment
read GetVertAlignments write SetVertAlignments; read GetVertAlignments write SetVertAlignments;
{@@ If true, word-wrapping of text within the cell at column ACol and row ARow {@@ If true, word-wrapping of text within the cell at column ACol and row ARow
is activated. } is activated. }
@ -410,7 +423,7 @@ type
read GetWordwrap write SetWordwrap; read GetWordwrap write SetWordwrap;
{@@ If true, word-wrapping of text within all cells within the range defined {@@ If true, word-wrapping of text within all cells within the range defined
by the rectangle is activated. } by the rectangle is activated. }
property Wordwraps[ARect: TGridRect]: Boolean property Wordwraps[ALeft, ATop, ARight, ABottom: Integer]: Boolean
read GetWordwraps write SetWordwraps; read GetWordwraps write SetWordwraps;
// inherited, but modified // inherited, but modified
@ -661,6 +674,9 @@ type
property OnContextPopup; property OnContextPopup;
end; end;
const
NO_CELL_BORDER: TsCellBorderStyle = (LineStyle: lsThin; Color: scNotDefined);
procedure Register; procedure Register;
implementation implementation
@ -2572,21 +2588,24 @@ end;
is given as an index into the workbook's color palette. If the colors are 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. different from cell to cell the value scUndefined is returned.
@param ARect Cell range defined as a rectangle: Left/Top refers to the cell @param ALeft Index of the left column of the cell range
in the left/top corner of the selection, Right/Bottom to the @param ATop Index of the top row of the cell range
right/bottom corner. @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' @return Color index common to all cells within the selection. If the cells'
background colors are different the value scUndefined is returned. background colors are different the value scUndefined is returned.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.GetBackgroundColors(ARect: TGridRect): TsColor; function TsCustomWorksheetGrid.GetBackgroundColors(ALeft, ATop, ARight, ABottom: Integer): TsColor;
var var
c, r: Integer; c, r: Integer;
clr: TsColor; clr: TsColor;
begin begin
Result := GetBackgroundColor(ARect.Left, ARect.Top); EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetBackgroundColor(ALeft, ATop);
clr := Result; clr := Result;
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
begin begin
Result := GetBackgroundColor(c, r); Result := GetBackgroundColor(c, r);
if Result <> clr then if Result <> clr then
@ -2619,20 +2638,25 @@ end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Returns the cell borders which are drawn around a given rectangular cell range. Returns the cell borders which are drawn around a given rectangular cell range.
@param ARect Rectangle defining the range of cell. @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) @return Set with flags indicating where borders are drawn (top/left/right/bottom)
If the individual cells within the range have different borders an If the individual cells within the range have different borders an
empty set is returned. empty set is returned.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.GetCellBorders(ARect: TGridRect): TsCellBorders; function TsCustomWorksheetGrid.GetCellBorders(ALeft, ATop, ARight, ABottom: Integer): TsCellBorders;
var var
c, r: Integer; c, r: Integer;
b: TsCellBorders; b: TsCellBorders;
begin begin
Result := GetCellBorder(ARect.Left, ARect.Top); EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellBorder(ALeft, ATop);
b := Result; b := Result;
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
begin begin
Result := GetCellBorder(c, r); Result := GetCellBorder(c, r);
if Result <> b then if Result <> b then
@ -2673,23 +2697,27 @@ end;
by the parameter ABorder of a range of cells defined by the rectangle of 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. column and row indexes. The style is defined by linestyle and line color.
@param ARect Rectangle whose edges define the limits of the grid row and @param ALeft Index of the left column of the cell range
column indexes of the cells. @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 @param ABorder Identifier of the border where the line will be drawn
(see TsCellBorder) (see TsCellBorder)
@return CellBorderStyle record containing information on line style and @return CellBorderStyle record containing information on line style and
line color. line color.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.GetCellBorderStyles(ARect: TGridRect; function TsCustomWorksheetGrid.GetCellBorderStyles(ALeft, ATop, ARight, ABottom: Integer;
ABorder: TsCellBorder): TsCellBorderStyle; ABorder: TsCellBorder): TsCellBorderStyle;
var var
c, r: Integer; c, r: Integer;
bs: TsCellBorderStyle; bs: TsCellBorderStyle;
begin begin
Result := GetCellBorderStyle(ARect.Left, ARect.Top, ABorder); EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellBorderStyle(ALeft, ATop, ABorder);
bs := Result; bs := Result;
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
begin begin
Result := GetCellBorderStyle(c, r, ABorder); Result := GetCellBorderStyle(c, r, ABorder);
if (Result.LineStyle <> bs.LineStyle) or (Result.Color <> bs.Color) then if (Result.LineStyle <> bs.LineStyle) or (Result.Color <> bs.Color) then
@ -2745,23 +2773,26 @@ end;
Returns the font to be used when painting text in the cells defined by the Returns the font to be used when painting text in the cells defined by the
rectangle of row/column indexes. rectangle of row/column indexes.
@param ARect Rectangle whose edges define the limits of the grid row and @param ALeft Index of the left column of the cell range
column indexes of the cells. @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. @return Font usable when painting on a canvas.
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
function TsCustomWorksheetGrid.GetCellFonts(ARect: TGridRect): TFont; function TsCustomWorksheetGrid.GetCellFonts(ALeft, ATop, ARight, ABottom: Integer): TFont;
var var
// c, r: Integer;
r1,c1,r2,c2: Cardinal; r1,c1,r2,c2: Cardinal;
sFont, sDefFont: TsFont; sFont, sDefFont: TsFont;
cell: PCell; cell: PCell;
begin begin
Result := GetCellFont(ARect.Left, ARect.Top); EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellFont(ALeft, ATop);
sDefFont := Workbook.GetDefaultFont; // Default font sDefFont := Workbook.GetDefaultFont; // Default font
r1 := GetWorksheetRow(ARect.Top); r1 := GetWorksheetRow(ATop);
c1 := GetWorksheetCol(ARect.Left); c1 := GetWorksheetCol(ALeft);
r2 := GetWorksheetRow(ARect.Bottom); r2 := GetWorksheetRow(ABottom);
c2 := GetWorksheetRow(ARect.Right); c2 := GetWorksheetRow(ARight);
for cell in Worksheet.Cells.GetRangeEnumerator(r1, c1, r2, c2) do for cell in Worksheet.Cells.GetRangeEnumerator(r1, c1, r2, c2) do
begin begin
sFont := Worksheet.ReadCellFont(cell); sFont := Worksheet.ReadCellFont(cell);
@ -2774,25 +2805,6 @@ begin
exit; exit;
end; end;
end; end;
{
for c := ARect.Left to ARect.Right do
for r := ARect.Top to ARect.Bottom do
begin
cell := Worksheet.FindCell(GetWorksheetRow(r), GetWorksheetCol(c));
if cell <> nil then
begin
sFont := Worksheet.ReadCellFont(cell);
if (sFont.FontName <> sDefFont.FontName) and (sFont.Size <> sDefFont.Size)
and (sFont.Style <> sDefFont.Style) and (sFont.Color <> sDefFont.Color)
then
begin
Convert_sFont_to_Font(sDefFont, FCellFont);
Result := FCellFont;
exit;
end;
end;
end;
}
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -3806,11 +3818,23 @@ end;
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.MergeCells(ARect: TGridRect); procedure TsCustomWorksheetGrid.MergeCells(ARect: TGridRect);
begin 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( Worksheet.MergeCells(
GetWorksheetRow(ARect.Top), GetWorksheetRow(ATop),
GetWorksheetCol(ARect.Left), GetWorksheetCol(ALeft),
GetWorksheetRow(ARect.Bottom), GetWorksheetRow(ABottom),
GetWorksheetCol(ARect.Right) GetWorksheetCol(ARight)
); );
end; end;
@ -4072,10 +4096,6 @@ end;
procedure TsCustomWorksheetGrid.SelectSheetByIndex(AIndex: Integer); procedure TsCustomWorksheetGrid.SelectSheetByIndex(AIndex: Integer);
begin begin
GetWorkbookSource.SelectWorksheet(Workbook.GetWorksheetByIndex(AIndex)); GetWorkbookSource.SelectWorksheet(Workbook.GetWorksheetByIndex(AIndex));
{
if Workbook <> nil then
LoadFromWorksheet(Workbook.GetWorksheetByIndex(AIndex));
}
end; end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
@ -4165,6 +4185,84 @@ begin
ListenerNotification([lniWorksheet, lniSelection]); ListenerNotification([lniWorksheet, lniSelection]);
end; 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;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Sorts the grid by calling the corresponding method of the worksheet. Sorts the grid by calling the corresponding method of the worksheet.
Sorting extends across the entire worksheet. Sorting extends across the entire worksheet.
@ -4437,15 +4535,17 @@ begin
end; end;
end; end;
function TsCustomWorksheetGrid.GetCellFontColors(ARect: TGridRect): TsColor; function TsCustomWorksheetGrid.GetCellFontColors(ALeft, ATop, ARight, ABottom: Integer): TsColor;
var var
c, r: Integer; c, r: Integer;
clr: TsColor; clr: TsColor;
begin begin
Result := GetCellFontColor(ARect.Left, ARect.Top); EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellFontColor(ALeft, ATop);
clr := Result; clr := Result;
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do begin for r := ATop to ABottom do begin
Result := GetCellFontColor(c, r); Result := GetCellFontColor(c, r);
if (Result <> clr) then begin if (Result <> clr) then begin
Result := scNotDefined; Result := scNotDefined;
@ -4468,15 +4568,17 @@ begin
end; end;
end; end;
function TsCustomWorksheetGrid.GetCellFontNames(ARect: TGridRect): String; function TsCustomWorksheetGrid.GetCellFontNames(ALeft, ATop, ARight, ABottom: Integer): String;
var var
c, r: Integer; c, r: Integer;
s: String; s: String;
begin begin
Result := GetCellFontName(ARect.Left, ARect.Top); EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellFontName(ALeft, ATop);
s := Result; s := Result;
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do begin for r := ATop to ABottom do begin
Result := GetCellFontName(c, r); Result := GetCellFontName(c, r);
if (Result <> '') and (Result <> s) then begin if (Result <> '') and (Result <> s) then begin
Result := ''; Result := '';
@ -4498,15 +4600,17 @@ begin
end; end;
end; end;
function TsCustomWorksheetGrid.GetCellFontSizes(ARect: TGridRect): Single; function TsCustomWorksheetGrid.GetCellFontSizes(ALeft, ATop, ARight, ABottom: Integer): Single;
var var
c, r: Integer; c, r: Integer;
sz: Single; sz: Single;
begin begin
Result := GetCellFontSize(ARect.Left, ARect.Top); EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellFontSize(ALeft, ATop);
sz := Result; sz := Result;
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do begin for r := ATop to ABottom do begin
Result := GetCellFontSize(c, r); Result := GetCellFontSize(c, r);
if (Result <> -1) and not SameValue(Result, sz, 1E-3) then begin if (Result <> -1) and not SameValue(Result, sz, 1E-3) then begin
Result := -1.0; Result := -1.0;
@ -4528,15 +4632,18 @@ begin
end; end;
end; end;
function TsCustomWorksheetGrid.GetCellFontStyles(ARect: TGridRect): TsFontStyles; function TsCustomWorksheetGrid.GetCellFontStyles(ALeft, ATop,
ARight, ABottom: Integer): TsFontStyles;
var var
c, r: Integer; c, r: Integer;
style: TsFontStyles; style: TsFontStyles;
begin begin
Result := GetCellFontStyle(ARect.Left, ARect.Top); EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetCellFontStyle(ALeft, ATop);
style := Result; style := Result;
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do begin for r := ATop to ABottom do begin
Result := GetCellFontStyle(c, r); Result := GetCellFontStyle(c, r);
if Result <> style then begin if Result <> style then begin
Result := []; Result := [];
@ -4591,15 +4698,17 @@ begin
end; end;
end; end;
function TsCustomWorksheetGrid.GetHorAlignments(ARect: TGridRect): TsHorAlignment; function TsCustomWorksheetGrid.GetHorAlignments(ALeft, ATop, ARight, ABottom: Integer): TsHorAlignment;
var var
c, r: Integer; c, r: Integer;
horalign: TsHorAlignment; horalign: TsHorAlignment;
begin begin
Result := GetHorAlignment(ARect.Left, ARect.Top); EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetHorAlignment(ALeft, ATop);
horalign := Result; horalign := Result;
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do begin for r := ATop to ABottom do begin
Result := GetHorAlignment(c, r); Result := GetHorAlignment(c, r);
if Result <> horalign then begin if Result <> horalign then begin
Result := haDefault; Result := haDefault;
@ -4637,14 +4746,17 @@ begin
end; end;
end; end;
function TsCustomWorksheetGrid.GetNumberFormats(ARect: TGridRect): String; function TsCustomWorksheetGrid.GetNumberFormats(ALeft, ATop,
ARight, ABottom: Integer): String;
var var
c, r: Integer; c, r: Integer;
nfs: String; nfs: String;
begin begin
nfs := GetNumberformat(ARect.Left, ARect.Top); EnsureOrder(ALeft, ARight);
for r := ARect.Left to ARect.Right do EnsureOrder(ATop, ABottom);
for c := ARect.Top to ARect.Bottom do nfs := GetNumberformat(ALeft, ATop);
for r := ALeft to ARight do
for c := ATop to ABottom do
if nfs <> GetNumberFormat(c, r) then if nfs <> GetNumberFormat(c, r) then
begin begin
Result := ''; Result := '';
@ -4679,15 +4791,18 @@ begin
end; end;
end; end;
function TsCustomWorksheetGrid.GetTextRotations(ARect: TGridRect): TsTextRotation; function TsCustomWorksheetGrid.GetTextRotations(ALeft, ATop,
ARight, ABottom: Integer): TsTextRotation;
var var
c, r: Integer; c, r: Integer;
textrot: TsTextRotation; textrot: TsTextRotation;
begin begin
Result := GetTextRotation(ARect.Left, ARect.Top); EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetTextRotation(ALeft, ATop);
textrot := Result; textrot := Result;
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do begin for r := ATop to ABottom do begin
Result := GetTextRotation(c, r); Result := GetTextRotation(c, r);
if Result <> textrot then begin if Result <> textrot then begin
Result := trHorizontal; Result := trHorizontal;
@ -4714,15 +4829,18 @@ begin
end; end;
end; end;
function TsCustomWorksheetGrid.GetVertAlignments(ARect: TGridRect): TsVertAlignment; function TsCustomWorksheetGrid.GetVertAlignments(
ALeft, ATop, ARight, ABottom: Integer): TsVertAlignment;
var var
c, r: Integer; c, r: Integer;
vertalign: TsVertAlignment; vertalign: TsVertAlignment;
begin begin
Result := GetVertalignment(ARect.Left, ARect.Top); EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetVertalignment(ALeft, ATop);
vertalign := Result; vertalign := Result;
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do begin for r := ATop to ABottom do begin
Result := GetVertAlignment(c, r); Result := GetVertAlignment(c, r);
if Result <> vertalign then begin if Result <> vertalign then begin
Result := vaDefault; Result := vaDefault;
@ -4752,15 +4870,18 @@ begin
end; end;
end; end;
function TsCustomWorksheetGrid.GetWordwraps(ARect: TGridRect): Boolean; function TsCustomWorksheetGrid.GetWordwraps(ALeft, ATop,
ARight, ABottom: Integer): Boolean;
var var
c, r: Integer; c, r: Integer;
wrapped: Boolean; wrapped: Boolean;
begin begin
Result := GetWordwrap(ARect.Left, ARect.Top); EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
Result := GetWordwrap(ALeft, ATop);
wrapped := Result; wrapped := Result;
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do begin for r := ATop to ABottom do begin
Result := GetWordwrap(c, r); Result := GetWordwrap(c, r);
if Result <> wrapped then begin if Result <> wrapped then begin
Result := false; Result := false;
@ -4806,15 +4927,17 @@ begin
end; end;
end; end;
procedure TsCustomWorksheetGrid.SetBackgroundColors(ARect: TGridRect; procedure TsCustomWorksheetGrid.SetBackgroundColors(
AValue: TsColor); ALeft, ATop, ARight, ABottom: Integer; AValue: TsColor);
var var
c,r: Integer; c,r: Integer;
begin begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate; BeginUpdate;
try try
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
SetBackgroundColor(c, r, AValue); SetBackgroundColor(c, r, AValue);
finally finally
EndUpdate; EndUpdate;
@ -4838,15 +4961,17 @@ begin
end; end;
end; end;
procedure TsCustomWorksheetGrid.SetCellBorders(ARect: TGridRect; procedure TsCustomWorksheetGrid.SetCellBorders(
AValue: TsCellBorders); ALeft, ATop, ARight, ABottom: Integer; AValue: TsCellBorders);
var var
c,r: Integer; c,r: Integer;
begin begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate; BeginUpdate;
try try
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
SetCellBorder(c, r, AValue); SetCellBorder(c, r, AValue);
finally finally
EndUpdate; EndUpdate;
@ -4870,15 +4995,17 @@ begin
end; end;
end; end;
procedure TsCustomWorksheetGrid.SetCellBorderStyles(ARect: TGridRect; procedure TsCustomWorksheetGrid.SetCellBorderStyles(ALeft, ATop,
ABorder: TsCellBorder; AValue: TsCellBorderStyle); ARight, ABottom: Integer; ABorder: TsCellBorder; AValue: TsCellBorderStyle);
var var
c,r: Integer; c,r: Integer;
begin begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate; BeginUpdate;
try try
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
SetCellBorderStyle(c, r, ABorder, AValue); SetCellBorderStyle(c, r, ABorder, AValue);
finally finally
EndUpdate; EndUpdate;
@ -4910,15 +5037,17 @@ begin
end; end;
end; end;
procedure TsCustomWorksheetGrid.SetCellFonts(ARect: TGridRect; procedure TsCustomWorksheetGrid.SetCellFonts(ALeft, ATop, ARight, ABottom: Integer;
AValue: TFont); AValue: TFont);
var var
c,r: Integer; c,r: Integer;
begin begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate; BeginUpdate;
try try
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
SetCellFont(c, r, AValue); SetCellFont(c, r, AValue);
finally finally
EndUpdate; EndUpdate;
@ -4936,14 +5065,17 @@ begin
end; end;
end; end;
procedure TsCustomWorksheetGrid.SetCellFontColors(ARect: TGridRect; AValue: TsColor); procedure TsCustomWorksheetGrid.SetCellFontColors(
ALeft, ATop, ARight, ABottom: Integer; AValue: TsColor);
var var
c,r: Integer; c,r: Integer;
begin begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate; BeginUpdate;
try try
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
SetCellFontColor(c, r, AValue); SetCellFontColor(c, r, AValue);
finally finally
EndUpdate; EndUpdate;
@ -4961,14 +5093,17 @@ begin
end; end;
end; end;
procedure TsCustomWorksheetGrid.SetCellFontNames(ARect: TGridRect; AValue: String); procedure TsCustomWorksheetGrid.SetCellFontNames(
ALeft, ATop, ARight, ABottom: Integer; AValue: String);
var var
c,r: Integer; c,r: Integer;
begin begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate; BeginUpdate;
try try
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
SetCellFontName(c, r, AValue); SetCellFontName(c, r, AValue);
finally finally
EndUpdate; EndUpdate;
@ -4987,15 +5122,17 @@ begin
end; end;
end; end;
procedure TsCustomWorksheetGrid.SetCellFontSizes(ARect: TGridRect; procedure TsCustomWorksheetGrid.SetCellFontSizes(
AValue: Single); ALeft, ATop, ARight, ABottom: Integer; AValue: Single);
var var
c,r: Integer; c,r: Integer;
begin begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate; BeginUpdate;
try try
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
SetCellFontSize(c, r, AValue); SetCellFontSize(c, r, AValue);
finally finally
EndUpdate; EndUpdate;
@ -5014,15 +5151,17 @@ begin
end; end;
end; end;
procedure TsCustomWorksheetGrid.SetCellFontStyles(ARect: TGridRect; procedure TsCustomWorksheetGrid.SetCellFontStyles(
AValue: TsFontStyles); ALeft, ATop, ARight, ABottom: Integer; AValue: TsFontStyles);
var var
c,r: Integer; c,r: Integer;
begin begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate; BeginUpdate;
try try
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
SetCellFontStyle(c, r, AValue); SetCellFontStyle(c, r, AValue);
finally finally
EndUpdate; EndUpdate;
@ -5155,15 +5294,17 @@ begin
end; end;
end; end;
procedure TsCustomWorksheetGrid.SetHorAlignments(ARect: TGridRect; procedure TsCustomWorksheetGrid.SetHorAlignments(
AValue: TsHorAlignment); ALeft, ATop, ARight, ABottom: Integer; AValue: TsHorAlignment);
var var
c,r: Integer; c,r: Integer;
begin begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate; BeginUpdate;
try try
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
SetHorAlignment(c, r, AValue); SetHorAlignment(c, r, AValue);
finally finally
EndUpdate; EndUpdate;
@ -5197,14 +5338,17 @@ begin
Worksheet.WriteNumberFormat(GetWorksheetRow(ARow), GetWorksheetCol(ACol), nfCustom, AValue); Worksheet.WriteNumberFormat(GetWorksheetRow(ARow), GetWorksheetCol(ACol), nfCustom, AValue);
end; end;
procedure TsCustomWorksheetGrid.SetNumberFormats(ARect: TGridRect; AValue: String); procedure TsCustomWorksheetGrid.SetNumberFormats(
ALeft, ATop, ARight, ABottom: Integer; AValue: String);
var var
c,r: Integer; c,r: Integer;
begin begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate; BeginUpdate;
try try
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
SetNumberFormat(c, r, AValue); SetNumberFormat(c, r, AValue);
finally finally
EndUpdate; EndUpdate;
@ -5286,15 +5430,17 @@ begin
end; end;
end; end;
procedure TsCustomWorksheetGrid.SetTextRotations(ARect: TGridRect; procedure TsCustomWorksheetGrid.SetTextRotations(
AValue: TsTextRotation); ALeft, ATop, ARight, ABottom: Integer; AValue: TsTextRotation);
var var
c,r: Integer; c,r: Integer;
begin begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate; BeginUpdate;
try try
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
SetTextRotation(c, r, AValue); SetTextRotation(c, r, AValue);
finally finally
EndUpdate; EndUpdate;
@ -5313,15 +5459,17 @@ begin
end; end;
end; end;
procedure TsCustomWorksheetGrid.SetVertAlignments(ARect: TGridRect; procedure TsCustomWorksheetGrid.SetVertAlignments(
AValue: TsVertAlignment); ALeft, ATop, ARight, ABottom: Integer; AValue: TsVertAlignment);
var var
c,r: Integer; c,r: Integer;
begin begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate; BeginUpdate;
try try
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
SetVertAlignment(c, r, AValue); SetVertAlignment(c, r, AValue);
finally finally
EndUpdate; EndUpdate;
@ -5340,15 +5488,17 @@ begin
end; end;
end; end;
procedure TsCustomWorksheetGrid.SetWordwraps(ARect: TGridRect; procedure TsCustomWorksheetGrid.SetWordwraps(ALeft, ATop, ARight, ABottom: Integer;
AValue: Boolean); AValue: Boolean);
var var
c,r: Integer; c,r: Integer;
begin begin
EnsureOrder(ALeft, ARight);
EnsureOrder(ATop, ABottom);
BeginUpdate; BeginUpdate;
try try
for c := ARect.Left to ARect.Right do for c := ALeft to ARight do
for r := ARect.Top to ARect.Bottom do for r := ATop to ABottom do
SetWordwrap(c, r, AValue); SetWordwrap(c, r, AValue);
finally finally
EndUpdate; EndUpdate;

32
components/fpspreadsheet/fpsutils.pas
View File

@ -110,6 +110,8 @@ function GetFormatFromFileName(const AFileName: TFileName;
function GetFormatFromFileName(const AFileName: TFileName; function GetFormatFromFileName(const AFileName: TFileName;
out SheetType: TsSpreadsheetFormat): Boolean; overload; deprecated 'Use overloaded function with TsSpreadsheetID'; out SheetType: TsSpreadsheetFormat): Boolean; overload; deprecated 'Use overloaded function with TsSpreadsheetID';
procedure EnsureOrder(var a,b: Integer); overload;
procedure EnsureOrder(var a,b: Cardinal); overload;
function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload; function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload;
procedure FloatToFraction(AValue: Double; AMaxDenominator: Int64; procedure FloatToFraction(AValue: Double; AMaxDenominator: Int64;
@ -1134,6 +1136,36 @@ end;
end; end;
} }
{@@ ----------------------------------------------------------------------------
Helper procedure which guarantees that a is not larger than b
-------------------------------------------------------------------------------}
procedure EnsureOrder(var a,b: Integer);
var
tmp: Integer;
begin
if a > b then
begin
tmp := a;
a := b;
b := tmp;
end;
end;
{@@ ----------------------------------------------------------------------------
Helper procedure which guarantees that a is not larger than b
-------------------------------------------------------------------------------}
procedure EnsureOrder(var a,b: cardinal);
var
tmp: cardinal;
begin
if a > b then
begin
tmp := a;
a := b;
b := tmp;
end;
end;
{@@ ---------------------------------------------------------------------------- {@@ ----------------------------------------------------------------------------
Helper function to reduce typing: "if a conditions is true return the first Helper function to reduce typing: "if a conditions is true return the first
number format, otherwise return the second format" number format, otherwise return the second format"