diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm index 0ba959614..c65a81ec6 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm +++ b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm @@ -30,8 +30,7 @@ object MainForm: TMainForm FrozenCols = 0 FrozenRows = 0 ReadFormulas = True - SelectionPen.JoinStyle = pjsMiter - SelectionPen.Width = 3 + SelectionPen.Width = 1 TextOverflow = True WorkbookSource = WorkbookSource Align = alClient @@ -974,28 +973,28 @@ object MainForm: TMainForm OnExecute = AcViewInspectorExecute end object AcRowAdd: TAction - Category = 'Edit' + Category = 'Worksheet' Caption = 'Add row' Hint = 'Add row' ImageIndex = 48 OnExecute = AcRowAddExecute end object AcColAdd: TAction - Category = 'Edit' + Category = 'Worksheet' Caption = 'Add column' Hint = 'Add column' ImageIndex = 47 OnExecute = AcColAddExecute end object AcRowDelete: TAction - Category = 'Edit' + Category = 'Worksheet' Caption = 'Delete row' Hint = 'Delete row' ImageIndex = 50 OnExecute = AcRowDeleteExecute end object AcColDelete: TAction - Category = 'Edit' + Category = 'Worksheet' Caption = 'Delete column' Hint = 'Delete column' ImageIndex = 49 @@ -1093,6 +1092,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = False + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = False @@ -1118,6 +1123,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = False + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = True @@ -1143,6 +1154,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = False + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = False @@ -1168,6 +1185,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = False + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = False @@ -1193,6 +1216,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = False + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = False @@ -1218,6 +1247,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = False + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = False @@ -1243,6 +1278,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = False + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = False @@ -1268,6 +1309,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = False + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = True @@ -1293,6 +1340,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = True + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = False @@ -1318,6 +1371,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = False + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = False @@ -1343,6 +1402,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = False + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = False @@ -1367,6 +1432,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = True + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = False @@ -1377,6 +1448,113 @@ object MainForm: TMainForm Hint = 'All vertical borders' ImageIndex = 43 end + object AcSearch: TAction + Category = 'Edit' + Caption = 'Search...' + Hint = 'Search for cells' + ImageIndex = 70 + OnExecute = AcSearchExecute + ShortCut = 16454 + end + object AcShowGridLines: TAction + Category = 'View' + AutoCheck = True + Caption = 'Grid lines' + Checked = True + OnExecute = AcShowGridLinesExecute + OnUpdate = AcShowGridLinesUpdate + end + object AcShowHeaders: TAction + Category = 'View' + AutoCheck = True + Caption = 'Show column/row headers' + Checked = True + OnExecute = AcShowHeadersExecute + OnUpdate = AcShowHeadersUpdate + end + object AcFrozenRows: TAction + Category = 'Worksheet' + AutoCheck = True + Caption = 'Frozen rows' + OnExecute = AcFrozenRowsExecute + OnUpdate = AcFrozenRowsUpdate + end + object AcFrozenCols: TAction + Category = 'Worksheet' + AutoCheck = True + Caption = 'Frozen columns' + OnExecute = AcFrozenColsExecute + OnUpdate = AcFrozenColsUpdate + end + object AcWorksheetRTL: TAction + Category = 'Worksheet' + AutoCheck = True + Caption = 'Text direction inverted' + OnExecute = AcWorksheetRTLExecute + OnUpdate = AcWorksheetRTLUpdate + end + object AcCellBorderDiagUp: TsCellBorderAction + Category = 'FPSpreadsheet' + WorkbookSource = WorkbookSource + Borders.East.LineStyle = lsThin + Borders.East.Color = clBlack + Borders.East.Visible = False + Borders.North.LineStyle = lsThin + Borders.North.Color = clBlack + Borders.North.Visible = False + Borders.South.LineStyle = lsThin + Borders.South.Color = clBlack + Borders.South.Visible = False + Borders.West.LineStyle = lsThin + Borders.West.Color = clBlack + Borders.West.Visible = False + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = True + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False + Borders.InnerHor.LineStyle = lsThin + Borders.InnerHor.Color = clBlack + Borders.InnerHor.Visible = False + Borders.InnerVert.LineStyle = lsThin + Borders.InnerVert.Color = clBlack + Borders.InnerVert.Visible = False + Caption = 'Diagonal up' + Hint = 'Diagonal border, bottom-left to top-right' + ImageIndex = 63 + end + object AcCellBorderDiagDown: TsCellBorderAction + Category = 'FPSpreadsheet' + WorkbookSource = WorkbookSource + Borders.East.LineStyle = lsThin + Borders.East.Color = clBlack + Borders.East.Visible = False + Borders.North.LineStyle = lsThin + Borders.North.Color = clBlack + Borders.North.Visible = False + Borders.South.LineStyle = lsThin + Borders.South.Color = clBlack + Borders.South.Visible = False + Borders.West.LineStyle = lsThin + Borders.West.Color = clBlack + Borders.West.Visible = False + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = True + Borders.InnerHor.LineStyle = lsThin + Borders.InnerHor.Color = clBlack + Borders.InnerHor.Visible = False + Borders.InnerVert.LineStyle = lsThin + Borders.InnerVert.Color = clBlack + Borders.InnerVert.Visible = False + Caption = 'Diagonal down' + Hint = 'Diagonal border, top-left to bottom-right' + ImageIndex = 64 + end object AcCellBorderAllOuter: TsCellBorderAction Category = 'FPSpreadsheet' WorkbookSource = WorkbookSource @@ -1392,6 +1570,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = True + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = False @@ -1417,6 +1601,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsMedium Borders.West.Color = clBlack Borders.West.Visible = True + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = False @@ -1442,6 +1632,12 @@ object MainForm: TMainForm Borders.West.LineStyle = lsThin Borders.West.Color = clBlack Borders.West.Visible = True + Borders.DiagonalUp.LineStyle = lsThin + Borders.DiagonalUp.Color = clBlack + Borders.DiagonalUp.Visible = False + Borders.DiagonalDown.LineStyle = lsThin + Borders.DiagonalDown.Color = clBlack + Borders.DiagonalDown.Visible = False Borders.InnerHor.LineStyle = lsThin Borders.InnerHor.Color = clBlack Borders.InnerHor.Visible = True @@ -1561,22 +1757,6 @@ object MainForm: TMainForm Hint = 'Delete hyperlink from selected cell' ImageIndex = 58 end - object AcSearch: TAction - Category = 'Edit' - Caption = 'Search...' - Hint = 'Search for cells' - ImageIndex = 70 - OnExecute = AcSearchExecute - ShortCut = 16454 - end - object AcShowGridLines: TAction - Category = 'View' - AutoCheck = True - Caption = 'Grid lines' - Checked = True - OnExecute = AcShowGridLinesExecute - OnUpdate = AcShowGridLinesUpdate - end end object ImageList: TImageList left = 176 @@ -4243,6 +4423,24 @@ object MainForm: TMainForm 80006E85890001A3BB00555555002B2B9D390101DEAF0101C640 } end + object MenuItem137: TMenuItem + Caption = '-' + end + object MenuItem136: TMenuItem + Action = AcFrozenCols + AutoCheck = True + end + object MenuItem138: TMenuItem + Action = AcFrozenRows + AutoCheck = True + end + object MenuItem140: TMenuItem + Caption = '-' + end + object MenuItem139: TMenuItem + Action = AcWorksheetRTL + AutoCheck = True + end end object MnuColumn: TMenuItem Caption = 'Column' @@ -5112,6 +5310,10 @@ object MainForm: TMainForm Action = AcShowGridLines AutoCheck = True end + object MenuItem135: TMenuItem + Action = AcShowHeaders + AutoCheck = True + end object MenuItem133: TMenuItem Caption = '-' end @@ -5709,6 +5911,15 @@ object MainForm: TMainForm object MenuItem38: TMenuItem Caption = '-' end + object MenuItem142: TMenuItem + Action = AcCellBorderDiagUp + end + object MenuItem141: TMenuItem + Action = AcCellBorderDiagDown + end + object MenuItem143: TMenuItem + Caption = '-' + end object MenuItem39: TMenuItem Action = AcCellBorderAllOuter Bitmap.Data = { diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas index fe0417e5c..1ec3f776b 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.pas +++ b/components/fpspreadsheet/examples/visual/fpsctrls/main.pas @@ -24,6 +24,10 @@ type AcSettingsFormatSettings: TAction; AcSearch: TAction; AcShowGridLines: TAction; + AcShowHeaders: TAction; + AcFrozenRows: TAction; + AcFrozenCols: TAction; + AcWorksheetRTL: TAction; AcViewInspector: TAction; ActionList: TActionList; AcFileExit: TFileExit; @@ -68,6 +72,15 @@ type MenuItem132: TMenuItem; MenuItem133: TMenuItem; MenuItem134: TMenuItem; + MenuItem135: TMenuItem; + MenuItem136: TMenuItem; + MenuItem137: TMenuItem; + MenuItem138: TMenuItem; + MenuItem139: TMenuItem; + MenuItem140: TMenuItem; + MenuItem141: TMenuItem; + MenuItem142: TMenuItem; + MenuItem143: TMenuItem; MnuSettings: TMenuItem; MenuItem11: TMenuItem; MenuItem12: TMenuItem; @@ -258,6 +271,8 @@ type AcNumFormatDayMonth: TsNumberFormatAction; AcNumFormatMonthYear: TsNumberFormatAction; AcNumFormatCustom: TsNumberFormatAction; + AcCellBorderDiagUp: TsCellBorderAction; + AcCellBorderDiagDown: TsCellBorderAction; Splitter2: TSplitter; Splitter3: TSplitter; ToolBar2: TToolBar; @@ -338,16 +353,24 @@ type procedure AcFileOpenAccept(Sender: TObject); procedure AcFileSaveAsAccept(Sender: TObject); procedure AcFileSaveAsBeforeExecute(Sender: TObject); + procedure AcFrozenColsExecute(Sender: TObject); + procedure AcFrozenColsUpdate(Sender: TObject); + procedure AcFrozenRowsExecute(Sender: TObject); + procedure AcFrozenRowsUpdate(Sender: TObject); procedure AcNumFormatCustomGetNumberFormatString(Sender: TObject; AWorkbook: TsWorkbook; var ANumFormatStr: String); procedure AcRowAddExecute(Sender: TObject); procedure AcRowDeleteExecute(Sender: TObject); + procedure AcWorksheetRTLExecute(Sender: TObject); + procedure AcWorksheetRTLUpdate(Sender: TObject); procedure AcSearchExecute(Sender: TObject); procedure AcSettingsCSVParamsExecute(Sender: TObject); procedure AcSettingsCurrencyExecute(Sender: TObject); procedure AcSettingsFormatSettingsExecute(Sender: TObject); procedure AcShowGridLinesExecute(Sender: TObject); procedure AcShowGridLinesUpdate(Sender: TObject); + procedure AcShowHeadersExecute(Sender: TObject); + procedure AcShowHeadersUpdate(Sender: TObject); procedure AcViewInspectorExecute(Sender: TObject); procedure EditCut1Execute(Sender: TObject); procedure FormCreate(Sender: TObject); @@ -455,10 +478,30 @@ procedure TMainForm.AcFileSaveAsBeforeExecute(Sender: TObject); begin if WorkbookSource.FileName = '' then exit; - AcfileSaveAs.Dialog.InitialDir := ExtractFileDir(WorkbookSource.FileName); + AcFileSaveAs.Dialog.InitialDir := ExtractFileDir(WorkbookSource.FileName); AcFileSaveAs.Dialog.FileName := ExtractFileName(WorkbookSource.FileName); end; +procedure TMainForm.AcFrozenColsExecute(Sender: TObject); +begin + WorksheetGrid.FrozenCols := WorksheetGrid.GetWorksheetCol(WorksheetGrid.Col); +end; + +procedure TMainForm.AcFrozenColsUpdate(Sender: TObject); +begin + AcFrozenCols.Checked := WorksheetGrid.FrozenCols > 0; +end; + +procedure TMainForm.AcFrozenRowsExecute(Sender: TObject); +begin + WorksheetGrid.FrozenRows := WorksheetGrid.GetWorksheetRow(WorksheetGrid.Row); +end; + +procedure TMainForm.AcFrozenRowsUpdate(Sender: TObject); +begin + AcFrozenRows.Checked := WorksheetGrid.FrozenRows > 0; +end; + procedure TMainForm.AcNumFormatCustomGetNumberFormatString(Sender: TObject; AWorkbook: TsWorkbook; var ANumFormatStr: String); var @@ -496,6 +539,22 @@ begin WorksheetGrid.Row := r; end; +procedure TMainForm.AcWorksheetRTLExecute(Sender: TObject); +begin + if AcWorksheetRTL.Checked then + begin + if WorksheetGrid.IsRightToLeft then + WorksheetGrid.Worksheet.BiDiMode := bdLTR else + WorksheetGrid.Worksheet.BiDiMode := bdRTL; + end else + WorksheetGrid.Worksheet.BiDiMode := bdDefault; +end; + +procedure TMainForm.AcWorksheetRTLUpdate(Sender: TObject); +begin + AcWorksheetRTL.Checked := WorksheetGrid.Worksheet.BiDiMode <> bdDefault; +end; + procedure TMainForm.AcSearchExecute(Sender: TObject); begin if SearchForm = nil then @@ -571,6 +630,16 @@ begin AcShowGridLines.Checked := WorksheetGrid.ShowGridLines; end; +procedure TMainForm.AcShowHeadersExecute(Sender: TObject); +begin + WorksheetGrid.ShowHeaders := AcShowHeaders.Checked; +end; + +procedure TMainForm.AcShowHeadersUpdate(Sender: TObject); +begin + AcShowHeaders.Checked := WorksheetGrid.ShowHeaders; +end; + { Toggles the spreadsheet inspector on and off } procedure TMainForm.AcViewInspectorExecute(Sender: TObject); begin diff --git a/components/fpspreadsheet/fpsactions.pas b/components/fpspreadsheet/fpsactions.pas index b0087be63..9aeab6fc5 100644 --- a/components/fpspreadsheet/fpsactions.pas +++ b/components/fpspreadsheet/fpsactions.pas @@ -282,8 +282,8 @@ type FColor: TColor; FVisible: Boolean; public - procedure ApplyStyle(AWorkbook: TsWorkbook; out ABorderStyle: TsCellBorderStyle); - procedure ExtractStyle(AWorkbook: TsWorkbook; ABorderStyle: TsCellBorderStyle); + function GetStyle: TsCellBorderStyle; + procedure SetStyle(const ABorderStyle: TsCellBorderStyle); published property LineStyle: TsLineStyle read FLineStyle write FLineStyle; property Color: TColor read FColor write FColor; @@ -292,25 +292,29 @@ type TsActionBorders = class(TPersistent) private - FBorders: Array[TsCellBorder] of TsActionBorder; - function GetBorder(AIndex: TsCellBorder): TsActionBorder; - procedure SetBorder(AIndex: TsCellBorder; AValue: TsActionBorder); + FBorders: Array[0..ord(High(TsCellBorder))+2] of TsActionBorder; + function GetBorder(AIndex: Integer): TsActionBorder; + procedure SetBorder(AIndex: integer; AValue: TsActionBorder); public constructor Create; destructor Destroy; override; procedure ExtractFromCell(AWorkbook: TsWorkbook; ACell: PCell); published - property East: TsActionBorder index cbEast + property East: TsActionBorder index ord(cbEast) read GetBorder write SetBorder; - property North: TsActionBorder index cbNorth + property North: TsActionBorder index ord(cbNorth) read GetBorder write SetBorder; - property South: TsActionBorder index cbSouth + property South: TsActionBorder index ord(cbSouth) read GetBorder write SetBorder; - property West: TsActionBorder index cbWest + property West: TsActionBorder index ord(cbWest) read GetBorder write SetBorder; - property InnerHor: TsActionBorder index cbDiagUp // NOTE: "abusing" cbDiagUp here! + property DiagonalUp: TsActionBorder index ord(cbDiagUp) read GetBorder write SetBorder; - property InnerVert: TsActionBorder index cbDiagDown // NOTE: "abusing" cbDiagDown here" + property DiagonalDown: TsActionBorder index ord(cbDiagDown) + read GetBorder write SetBorder; + property InnerHor: TsActionBorder index ord(High(TsCellBorder))+1 + read GetBorder write SetBorder; + property InnerVert: TsActionBorder index ord(High(TsCellBorder))+2 read GetBorder write SetBorder; end; @@ -557,15 +561,40 @@ end; procedure TsSpreadsheetAction.ApplyFormatToRange(ARange: TsCellRange); var - r, c: Cardinal; - cell: PCell; + r, c, r1, c1, r2, c2: Cardinal; + cell, base: PCell; begin + + r := ARange.Row1; + while r <= ARange.Row2 do + begin + c := ARange.Col1; + while c <= ARange.Col2 do + begin + cell := Worksheet.GetCell(r, c); // use "GetCell" here to format empty cells as well + if Worksheet.IsMerged(cell) then begin + Worksheet.FindMergedRange(cell, r1, c1, r2, c2); + base := Worksheet.FindCell(r1, c1); + ApplyFormatToCell(base); + c := c2+1; + end else + begin + ApplyFormatToCell(cell); + inc(c); + end; + end; + inc(r); + end; + { + for r := ARange.Row1 to ARange.Row2 do for c := ARange.Col1 to ARange.Col2 do begin cell := Worksheet.GetCell(r, c); // Use "GetCell" here to format empty cells as well + if Worksheet.IsMerged(cell) then ApplyFormatToCell(cell); // no check for nil required because of "GetCell" end; + } end; procedure TsSpreadsheetAction.ApplyFormatToSelection; @@ -844,12 +873,19 @@ begin end; procedure TsAutoFormatAction.UpdateTarget(Target: TObject); +var + cell: PCell; begin Unused(Target); Enabled := inherited Enabled and (Worksheet <> nil) and (Length(GetSelection) > 0); if Enabled then - ExtractFromCell(ActiveCell); + begin + cell := ActiveCell; + if Worksheet.IsMerged(cell) then + cell := Worksheet.FindMergeBase(cell); + ExtractFromCell(cell); + end; end; @@ -1094,71 +1130,75 @@ end; { TsCellBorderAction } -procedure TsActionBorder.ApplyStyle(AWorkbook: TsWorkbook; - out ABorderStyle: TsCellBorderStyle); +function TsActionBorder.GetStyle: TsCellBorderStyle; begin - Unused(AWorkbook); - ABorderStyle.LineStyle := FLineStyle; - ABorderStyle.Color := ABorderStyle.Color and $00FFFFFF; + Result.LineStyle := FLineStyle; + Result.Color := FColor and $00FFFFFF; end; -procedure TsActionBorder.ExtractStyle(AWorkbook: TsWorkbook; - ABorderStyle: TsCellBorderStyle); +procedure TsActionBorder.SetStyle(const ABorderStyle: TsCellBorderStyle); begin - Unused(AWorkbook); FLineStyle := ABorderStyle.LineStyle; - Color := ColorToRGB(ABorderStyle.Color); + FColor := ColorToRGB(ABorderStyle.Color); end; +{ --- } + constructor TsActionBorders.Create; var - cb: TsCellBorder; + cb: Integer; begin inherited Create; - for cb in TsCellBorder do + for cb := 0 to High(FBorders) do FBorders[cb] := TsActionBorder.Create; end; destructor TsActionBorders.Destroy; var - cb: TsCellBorder; + cb: Integer; begin - for cb in TsCellBorder do FBorders[cb].Free; + for cb := High(FBorders) downto 0 do FBorders[cb].Free; inherited Destroy; end; procedure TsActionBorders.ExtractFromCell(AWorkbook: TsWorkbook; ACell: PCell); var - cb: TsCellBorder; + cb: Integer; fmt: PsCellFormat; + sheet: TsWorksheet; begin - if (ACell <> nil) then + if (ACell <> nil) then begin + sheet := TsWorksheet(ACell^.Worksheet); + if sheet.IsMerged(ACell) then + ACell := sheet.FindMergeBase(ACell); fmt := AWorkbook.GetPointerToCellFormat(ACell^.FormatIndex); + end; if (ACell = nil) or not (uffBorder in fmt^.UsedFormattingFields) then - for cb in TsCellBorder do + for cb := 0 to High(FBorders)-2 do // inner styles not needed here begin - FBorders[cb].ExtractStyle(AWorkbook, DEFAULT_BORDERSTYLES[cb]); + FBorders[cb].SetStyle(DEFAULT_BORDERSTYLES[TsCellBorder(cb)]); FBorders[cb].Visible := false; end else - for cb in TsCellBorder do + for cb := 0 to High(FBorders)-2 do // inner styles not needed here begin - FBorders[cb].ExtractStyle(AWorkbook, fmt^.BorderStyles[cb]); - FBorders[cb].Visible := cb in fmt^.Border; + FBorders[cb].SetStyle(fmt^.BorderStyles[TsCellBorder(cb)]); + FBorders[cb].Visible := TsCellBorder(cb) in fmt^.Border; end; end; -function TsActionBorders.GetBorder(AIndex: TsCellBorder): TsActionBorder; +function TsActionBorders.GetBorder(AIndex: Integer): TsActionBorder; begin Result := FBorders[AIndex]; end; -procedure TsActionBorders.SetBorder(AIndex: TsCellBorder; - AValue: TsActionBorder); +procedure TsActionBorders.SetBorder(AIndex: Integer; AValue: TsActionBorder); begin FBorders[AIndex] := AValue; end; +{ --- } + constructor TsCellBorderAction.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -1190,48 +1230,104 @@ procedure TsCellBorderAction.ApplyFormatToRange(ARange: TsCellRange); Worksheet.ChangedCell(ACell^.Row, ACell^.Col); end; -var - r, c: LongInt; - bs: TsCellBorderStyle; -begin - // Top edges - Borders.North.ApplyStyle(Workbook, bs); - for c := ARange.Col1 to ARange.Col2 do - ShowBorder(cbNorth, Worksheet.GetCell(ARange.Row1, c), bs, Borders.North.Visible); - - // Bottom edges - Borders.South.ApplyStyle(Workbook, bs); - for c := ARange.Col1 to ARange.Col2 do - ShowBorder(cbSouth, Worksheet.GetCell(ARange.Row2, c), bs, Borders.South.Visible); - - // Inner horizontal edges - Borders.InnerHor.ApplyStyle(Workbook, bs); - for c := ARange.Col1 to ARange.Col2 do + procedure ShowBorders(ABorder: TsCellBorder; AStart, AEnd, AColRow: LongInt; + AColRowIsCol: Boolean; ABorderStyle: TsCellBorderStyle; AEnable: Boolean); + var + i: Integer; + r1, c1, r2, c2: Cardinal; + cell: PCell; begin - for r := ARange.Row1 to LongInt(ARange.Row2)-1 do - ShowBorder(cbSouth, Worksheet.GetCell(r, c), bs, Borders.InnerHor.Visible); - for r := ARange.Row1+1 to ARange.Row2 do - ShowBorder(cbNorth, Worksheet.GetCell(r, c), bs, Borders.InnerHor.Visible); + i := AStart; + while i <= AEnd do + begin + if AColRowIsCol then + // Scan along specified column, i.e. i is row index + begin + cell := Worksheet.GetCell(i, AColRow); + if Worksheet.IsMerged(cell) then + begin + Worksheet.FindMergedRange(cell, r1, c1, r2, c2); + if (r1 >= AStart) and (r2 <= AEnd) then + begin + cell := Worksheet.GetCell(r1, c1); + ShowBorder(ABorder, cell, ABorderStyle, AEnable); + while (i <= r2) do begin + cell := GetWorksheet.GetCell(i, AColRow); + inc(i); + end; + Continue; + end; + end; + end + else + // Scan along specified row, i.e. i is column index + begin + cell := Worksheet.GetCell(AColRow, i); + if Worksheet.IsMerged(cell) then + begin + Worksheet.FindMergedRange(cell, r1, c1, r2, c2); + if (c1 >= AStart) and (c2 <= AEnd) then + begin + cell := Worksheet.GetCell(r1, c1); + ShowBorder(ABorder, cell, ABorderStyle, AEnable); + while (i <= c2) do begin + cell := GetWorksheet.GetCell(AColRow, i); + inc(i); + end; + Continue; + end; + end; + end; + ShowBorder(ABorder, cell, ABorderStyle, AEnable); + inc(i); + end; end; - // Left edges - Borders.West.ApplyStyle(Workbook, bs); - for r := ARange.Row1 to ARange.Row2 do - ShowBorder(cbWest, Worksheet.GetCell(r, ARange.Col1), bs, Borders.West.Visible); +var + r, c: LongInt; + r1, c1, r2, c2: Cardinal; + bs: TsCellBorderStyle; + cell: PCell; +begin + // Top edge of range + ShowBorders(cbNorth, ARange.Col1, ARange.Col2, ARange.Row1, false, + Borders.North.GetStyle, Borders.North.Visible); - // Right edges - Borders.East.ApplyStyle(Workbook, bs); - for r := ARange.Row1 to ARange.Row2 do - ShowBorder(cbEast, Worksheet.GetCell(r, ARange.Col2), bs, Borders.East.Visible); + // Bottom edge of range + ShowBorders(cbSouth, ARange.Col1, ARange.Col2, ARange.Row2, false, + Borders.South.GetStyle, Borders.South.Visible); - // Inner vertical lines - Borders.InnerVert.ApplyStyle(Workbook, bs); - for r := ARange.Row1 to ARange.Row2 do + // Left edge of range + ShowBorders(cbWest, ARange.Row1, ARange.Row2, ARange.Col1, true, + Borders.West.GetStyle, Borders.West.Visible); + + // Right edge of range + ShowBorders(cbEast, ARange.Row1, ARange.Row2, ARange.Col2, true, + Borders.East.GetStyle, Borders.East.Visible); + + // Inner horizontal edges + for r := ARange.Row1 to ARange.Row2-1 do + ShowBorders(cbSouth, ARange.Col1, ARange.Col2, r, false, + Borders.InnerHor.GetStyle, Borders.InnerHor.Visible); + for r := ARange.Row1+1 to ARange.Row2 do + ShowBorders(cbNorth, ARange.Col1, ARange.Col2, r, false, + Borders.InnerHor.GetStyle, Borders.InnerHor.Visible); + + // Inner vertical edges + for c := ARange.Col1 to ARange.Col2-1 do + ShowBorders(cbEast, ARange.Row1, ARange.Row2, c, true, + Borders.InnerVert.GetStyle, Borders.InnerVert.Visible); + for c := ARange.Col1+1 to ARange.Col2 do + ShowBorders(cbWest, ARange.Row1, ARange.Row2, c, true, + Borders.InnerVert.GetStyle, Borders.InnerVert.Visible); + + // Diagonal up and down lines + for c := ARange.Col1 to ARange.Col2 do begin - for c := ARange.Col1 to LongInt(ARange.Col2)-1 do - ShowBorder(cbEast, Worksheet.GetCell(r, c), bs, Borders.InnerVert.Visible); - for c := ARange.Col1+1 to ARange.Col2 do - ShowBorder(cbWest, Worksheet.GetCell(r, c), bs, Borders.InnerVert.Visible); + ShowBorders(cbDiagUp, ARange.Row1, ARange.Row2, c, true, + Borders.DiagonalUp.GetStyle, Borders.DiagonalUp.Visible); + ShowBorders(cbDiagDown, ARange.Row1, ARange.Row2, c, true, + Borders.DiagonalDown.GetStyle, Borders.DiagonalDown.Visible); end; end; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index eb80e0749..a41c844e7 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -775,8 +775,6 @@ type {@@ This event fires whenever a new worksheet is added } property OnAddWorksheet: TsWorksheetEvent read FOnAddWorksheet write FOnAddWorksheet; - {@@ This event fires whenever the workbook palette changes. } -// property OnChangePalette: TNotifyEvent read FOnChangePalette write FOnChangePalette; {@@ This event fires whenever a worksheet is changed } property OnChangeWorksheet: TsWorksheetEvent read FOnChangeWorksheet write FOnChangeWorksheet; {@@ This event fires whenever a workbook is loaded } diff --git a/components/fpspreadsheet/fpspreadsheetctrls.pas b/components/fpspreadsheet/fpspreadsheetctrls.pas index 8e57dc182..8d85ecaa9 100644 --- a/components/fpspreadsheet/fpspreadsheetctrls.pas +++ b/components/fpspreadsheet/fpspreadsheetctrls.pas @@ -2126,6 +2126,9 @@ begin if (Worksheet = nil) then exit; + if Worksheet.IsMerged(ACell) then + ACell := Worksheet.FindMergeBase(ACell); + case FFormatItem of cfiFontName: if Text <> '' then @@ -2258,6 +2261,8 @@ var fnt: TsFont; clr: TsColor; begin + if Worksheet.IsMerged(ACell) then + ACell := Worksheet.FindMergeBase(ACell); case FFormatItem of cfiFontName: begin diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 56b12aee4..e2f5332e8 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -42,6 +42,14 @@ type TsHyperlinkClickEvent = procedure(Sender: TObject; const AHyperlink: TsHyperlink) of object; + TsSelPen = class(TPen) + public + constructor Create; + published + property Width stored true default 3; + property JoinStyle default pjsMiter; + end; + // TsSelectionRectMode = (srmDThickXOR, srmThick, srmDottedXOR, {@@ TsCustomWorksheetGrid is the ancestor of TsWorksheetGrid and is able to display spreadsheet data along with their formatting. } @@ -66,7 +74,7 @@ type FTextOverflowing: Boolean; FAutoExpand: TsAutoExpandModes; FEnhEditMode: Boolean; - FSelPen: TPen; + FSelPen: TsSelPen; FHyperlinkTimer: TTimer; FHyperlinkCell: PCell; // Selected cell if it stores a hyperlink FOnClickHyperlink: TsHyperlinkClickEvent; @@ -156,7 +164,7 @@ type procedure SetNumberFormats(ALeft, ATop, ARight, ABottom: Integer; AValue: String); procedure SetReadFormulas(AValue: Boolean); procedure SetRowHeights(ARow: Integer; AValue: Integer); - procedure SetSelPen(AValue: TPen); + procedure SetSelPen(AValue: TsSelPen); procedure SetShowGridLines(AValue: Boolean); procedure SetShowHeaders(AValue: Boolean); procedure SetTextRotation(ACol, ARow: Integer; AValue: TsTextRotation); @@ -248,7 +256,7 @@ type 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: TPen read FSelPen write SetSelPen; + property SelectionPen: TsSelPen read FSelPen write SetSelPen; {@@ 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. } @@ -938,6 +946,13 @@ begin end; +constructor TsSelPen.Create; +begin + inherited; + Width := 3; + JoinStyle := pjsMiter; +end; + {******************************************************************************* * TsCustomWorksheetGrid * *******************************************************************************} @@ -960,9 +975,9 @@ begin ColCount := DEFAULT_COL_COUNT + FHeaderCount; RowCount := DEFAULT_ROW_COUNT + FHeaderCount; FCellFont := TFont.Create; - FSelPen := TPen.Create; + FSelPen := TsSelPen.Create; FSelPen.Style := psSolid; - FSelPen.Width := 3; +// FSelPen.Width := 3; FSelPen.Color := clBlack; FSelPen.JoinStyle := pjsMiter; FSelPen.OnChange := @SelPenChangeHandler; @@ -1530,17 +1545,23 @@ var cell: PCell; Rct: TRect; s: String; + delta: Integer; begin inherited; if (Worksheet <> nil) and (Editor is TStringCellEditor) then begin + delta := FSelPen.Width div 2; cell := Worksheet.FindCell(GetWorksheetRow(Row), GetWorksheetCol(Col)); if Worksheet.IsMerged(cell) then begin s := Editor.ClassName; Worksheet.FindMergedRange(cell, r1,c1,r2,c2); Rct := CellRect(GetGridCol(c1), GetGridRow(r1), GetGridCol(c2), GetGridRow(r2)); - Editor.SetBounds(Rct.Left, Rct.Top, Rct.Right-Rct.Left, Rct.Bottom-Rct.Top); - end; + end else + Rct := CellRect(Col, Row); + InflateRect(Rct, -delta, -delta); + inc(Rct.Top); + if not odd(FSelPen.Width) then dec(Rct.Left); + Editor.SetBounds(Rct.Left, Rct.Top, Rct.Right-Rct.Left-1, Rct.Bottom-Rct.Top-1); end; end; @@ -1713,13 +1734,20 @@ begin try // Avoid painting into the header cells cliprect := ClientRect; + if FixedCols > 0 then if IsRightToLeft then ColRowToOffset(True, true, FixedCols-1, cliprect.Right, tmp) else + begin ColRowToOffset(True, True, FixedCols-1, tmp, cliprect.Left); - if FixedRows > 0 then + dec(clipRect.Left); + end; + if FixedRows > 0 then begin ColRowToOffset(False, True, FixedRows-1, tmp, cliprect.Top); + dec(cliprect.Top); + end; + DrawFrozenPaneBorders(clipRect); rgn := CreateRectRgn(cliprect.Left, cliprect.top, cliprect.Right, cliprect.Bottom); @@ -1817,8 +1845,9 @@ const 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; - + if ABorderStyle.LineStyle = lsHair then + Canvas.Pen.Cosmetic := false; + (* // Workaround until efficient drawing procedures for diagonal "hair" lines // is available { @@ -1832,6 +1861,7 @@ const if (ABorderStyle.LineStyle in [lsMedium, lsMediumDash, lsMediumDashDot, lsMediumDashDotDot, lsSlantDashDot, lsThick, lsDouble]) then begin + { if ACol = ColCount-1 then begin if (ADrawDirection = drawVert) and (ACoord = ARect.Right-1) and width3 @@ -1844,6 +1874,7 @@ const then dec(ACoord); dec(ARect.Bottom); end; + } end; if ABorderStyle.LineStyle in [lsMedium, lsMediumDash, lsMediumDashDot, lsMediumDashDotDot, lsSlantDashDot, lsThick, lsHair] then @@ -1858,7 +1889,7 @@ const dec(ARect.Bottom, 2); end; end; - + *) // Painting case ABorderStyle.LineStyle of lsThin, lsMedium, lsThick, lsDotted, lsDashed, lsDashDot, lsDashDotDot, @@ -1927,6 +1958,11 @@ var 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) then DrawBorderLine(ARect.Left-ord(not IsRightToLeft), ARect, drawVert, bs); @@ -1942,11 +1978,13 @@ begin if ACell <> nil then begin fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); + { if Worksheet.IsMergeBase(ACell) then begin Worksheet.FindMergedRange(ACell, r1, c1, r2, c2); ARect := CellRect(GetGridCol(c1), GetGridRow(r1), GetGridCol(c2), GetGridRow(r2)); end; + } // Diagonal up if cbDiagUp in fmt^.Border then begin bs := fmt^.Borderstyles[cbDiagUp]; @@ -2044,7 +2082,11 @@ begin if FFrozenRows > 0 then Canvas.Line(ARect.Left, ARect.Top, ARect.Right, ARect.Top); if FFrozenCols > 0 then - Canvas.Line(ARect.Left, ARect.Top, ARect.Left, ARect.Bottom); + begin + if IsRightToLeft then + Canvas.Line(ARect.Right, ARect.Top, ARect.Right, ARect.Bottom) else + Canvas.Line(ARect.Left, ARect.Top, ARect.Left, ARect.Bottom); + end; end; end; @@ -2346,9 +2388,13 @@ begin end else R := CellRect(Selection.Left, Selection.Top, Selection.Right, Selection.Bottom); - { -- wp: Is this really needed? + dec(R.Top); + if IsRightToLeft then inc(R.Right) else dec(R.Left); + // Cosmetics at the edges of the grid to avoid spurious rests - delta := FSelPen.Width div 2; + + delta := Max(FSelPen.Width div 2, 0); + { if Selection.Top > TopRow then dec(R.Top, delta) else inc(R.Top, delta); @@ -2356,17 +2402,19 @@ begin dec(R.Bottom, delta); if IsRightToLeft then begin if Selection.Right > LeftCol then - inc(R.Right, delta) else dec(R.Right, delta); + inc(R.Right, delta) else + dec(R.Right, delta); if Selection.Right = ColCount-1 then inc(R.Left, delta); end else begin if Selection.Left > LeftCol then - dec(R.Left, delta) else inc(R.Left, delta); + dec(R.Left, delta) else + inc(R.Left, delta); if Selection.Right = ColCount-1 then dec(R.Right, delta); - end; } - + end; + } // Set up the canvas savedPenMode := Canvas.Pen.Mode; Canvas.Pen.Assign(FSelPen); @@ -4356,14 +4404,11 @@ begin exit; if (Worksheet = nil) or (Worksheet.GetCellCount = 0) then begin + FixedCols := FFrozenCols + FHeaderCount; + FixedRows := FFrozenRows + FHeaderCount; if ShowHeaders then begin - FixedCols := 1; - FixedRows := 1; ColWidths[0] := GetDefaultHeaderColWidth; RowHeights[0] := GetDefaultRowHeight; - end else begin - FixedCols := 0; - FixedRows := 0; end; end else if Worksheet <> nil then begin @@ -5648,7 +5693,7 @@ begin HeaderSized(false, ARow); end; -procedure TsCustomWorksheetGrid.SetSelPen(AValue: TPen); +procedure TsCustomWorksheetGrid.SetSelPen(AValue: TsSelPen); begin FSelPen.Assign(AValue); InvalidateGrid; @@ -5674,10 +5719,21 @@ end; { Shows / hides the worksheet's row and column headers. } procedure TsCustomWorksheetGrid.SetShowHeaders(AValue: Boolean); +var + hdrCount: Integer; begin if AValue = GetShowHeaders then Exit; - FHeaderCount := ord(AValue); + // 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]