fpspreadsheet: Add standard actions for predefined cell border combinations

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3731 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/fpsctrls/main.pas

@@ -43,7 +43,25 @@ type
     MenuItem29: TMenuItem;
     MenuItem3: TMenuItem;
     MenuItem30: TMenuItem;
+    MenuItem31: TMenuItem;
+    MenuItem32: TMenuItem;
+    MenuItem33: TMenuItem;
+    MenuItem34: TMenuItem;
+    MenuItem35: TMenuItem;
+    MenuItem36: TMenuItem;
+    MenuItem37: TMenuItem;
+    MenuItem38: TMenuItem;
+    MenuItem39: TMenuItem;
     MenuItem4: TMenuItem;
+    MenuItem40: TMenuItem;
+    MenuItem41: TMenuItem;
+    MenuItem42: TMenuItem;
+    MenuItem43: TMenuItem;
+    MenuItem44: TMenuItem;
+    MenuItem45: TMenuItem;
+    MenuItem46: TMenuItem;
+    MenuItem47: TMenuItem;
+    MenuItem48: TMenuItem;
     MenuItem5: TMenuItem;
     MenuItem6: TMenuItem;
     MenuItem7: TMenuItem;
@@ -76,6 +94,7 @@ type
     AcNumFormatPercentage: TsNumberFormatAction;
     AcNumFormatCurrency: TsNumberFormatAction;
     AcNumFormatCurrencyRed: TsNumberFormatAction;
+    PuBorders: TPopupMenu;
     PuTimeFormat: TPopupMenu;
     PuDateFormat: TPopupMenu;
     PuCurrencyFormat: TPopupMenu;
@@ -94,6 +113,22 @@ type
     AcDecDecimals: TsDecimalsAction;
     AcCellFont: TsFontAction;
     AcBackgroundColor: TsBackgroundColorAction;
+    AcCellBorderTop: TsCellBorderAction;
+    AcCellBorderBottom: TsCellBorderAction;
+    AcCellBorderLeft: TsCellBorderAction;
+    AcCellBorderRight: TsCellBorderAction;
+    AcCellBorderInnerHor: TsCellBorderAction;
+    AcCellBorderInnerVert: TsCellBorderAction;
+    AcCellBorderAllHor: TsCellBorderAction;
+    AcCellBorderBottomThick: TsCellBorderAction;
+    AcCellBorderBottomDbl: TsCellBorderAction;
+    AcCellBorderAllOuter: TsCellBorderAction;
+    AcCellBorderNone: TsNoCellBordersAction;
+    AcCellBorderAllOuterThick: TsCellBorderAction;
+    AcCellBorderTopBottomThick: TsCellBorderAction;
+    AcCellBorderTopBottomDbl: TsCellBorderAction;
+    AcCellBorderAll: TsCellBorderAction;
+    AcCellBorderAllVert: TsCellBorderAction;
     ToolButton11: TToolButton;
     ToolButton12: TToolButton;
     ToolButton13: TToolButton;
@@ -128,6 +163,7 @@ type
     ToolButton3: TToolButton;
     ToolButton30: TToolButton;
     ToolButton31: TToolButton;
+    TbBorders: TToolButton;
     ToolButton4: TToolButton;
     ToolButton5: TToolButton;
     ToolButton6: TToolButton;

components/fpspreadsheet/fpsactions.pas

@@ -1,3 +1,14 @@
+{ fpActions }
+
+{@@ ----------------------------------------------------------------------------
+  A collection of standard actions to simplify creation of menu and toolbar
+  for spreadsheet applications.
+
+AUTHORS: Werner Pamler
+
+LICENSE: See the file COPYING.modifiedLGPL.txt, included in the Lazarus
+         distribution, for details about the license.
+-------------------------------------------------------------------------------}
 unit fpsActions;
 
 interface
@@ -31,6 +42,7 @@ type
     property WorkbookSource: TsWorkbookSource read FWorkbookSource write FWorkbookSource;
   end;
 
+
   { --- Actions related to worksheets --- }
 
   TsWorksheetAction = class(TsSpreadsheetAction)
@@ -125,9 +137,7 @@ type
     property Visible;
   end;
 
-
   { TsFontStyleAction }
-
   TsFontStyleAction = class(TsAutoFormatAction)
   private
     FFontStyle: TsFontStyle;
@@ -142,9 +152,7 @@ type
       read FFontStyle write SetFontStyle;
   end;
 
-
   { TsHorAlignmentAction }
-
   TsHorAlignmentAction = class(TsAutoFormatAction)
   private
     FHorAlign: TsHorAlignment;
@@ -159,9 +167,7 @@ type
       read FHorAlign write SetHorAlign default haDefault;
   end;
 
-
   { TsVertAlignmentAction }
-
   TsVertAlignmentAction = class(TsAutoFormatAction)
   private
     FVertAlign: TsVertAlignment;
@@ -176,9 +182,7 @@ type
       read FVertAlign write SetVertAlign default vaDefault;
   end;
 
-
   { TsTextRotationAction }
-
   TsTextRotationAction = class(TsAutoFormatAction)
   private
     FTextRotation: TsTextRotation;
@@ -193,9 +197,7 @@ type
       read FTextRotation write SetTextRotation default trHorizontal;
   end;
 
-
   { TsWordwrapAction }
-
   TsWordwrapAction = class(TsAutoFormatAction)
   private
     function GetWordwrap: Boolean;
@@ -210,9 +212,7 @@ type
       read GetWordwrap write SetWordwrap default false;
   end;
 
-
   { TsNumberFormatAction }
-
   TsNumberFormatAction = class(TsAutoFormatAction)
   private
     FNumberFormat: TsNumberFormat;
@@ -231,9 +231,7 @@ type
       read FNumberFormatStr write SetNumberFormatStr;
   end;
 
-
   { TsDecimalsAction }
-
   TsDecimalsAction = class(TsAutoFormatAction)
   private
     FDecimals: Integer;
@@ -251,8 +249,95 @@ type
     property Hint stored false;
   end;
 
+  { TsCellBorderAction }
+  TsActionBorder = class(TPersistent)
+  private
+    FLineStyle: TsLineStyle;
+    FColor: TColor;
+    FVisible: Boolean;
+  public
+    procedure ApplyStyle(AWorkbook: TsWorkbook; out ABorderStyle: TsCellBorderStyle);
+    procedure ExtractStyle(AWorkbook: TsWorkbook; ABorderStyle: TsCellBorderStyle);
+  published
+    property LineStyle: TsLineStyle read FLineStyle write FLineStyle;
+    property Color: TColor read FColor write FColor;
+    property Visible: Boolean read FVisible write FVisible;
+  end;
 
-  { --- Actions like from TCommonDialogAction --- }
+  TsActionBorders = class(TPersistent)
+  private
+    FBorders: Array[TsCellBorder] of TsActionBorder;
+    function GetBorder(AIndex: TsCellBorder): TsActionBorder;
+    procedure SetBorder(AIndex: TsCellBorder; AValue: TsActionBorder);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure ExtractFromCell(AWorkbook: TsWorkbook; ACell: PCell);
+  published
+    property East: TsActionBorder index cbEast
+      read GetBorder write SetBorder;
+    property North: TsActionBorder index cbNorth
+      read GetBorder write SetBorder;
+    property South: TsActionBorder index cbSouth
+      read GetBorder write SetBorder;
+    property West: TsActionBorder index cbWest
+      read GetBorder write SetBorder;
+    property InnerHor: TsActionBorder index cbDiagUp  // NOTE: "abusing" cbDiagUp here!
+      read GetBorder write SetBorder;
+    property InnerVert: TsActionBorder index cbDiagDown  // NOTE: "abusing" cbDiagDown here"
+      read GetBorder write SetBorder;
+  end;
+
+  TsCellBorderAction = class(TsCellAction)
+  private
+    FBorders: TsActionBorders;
+  protected
+    procedure ApplyFormatToRange(ARange: TsCellRange); override;
+    procedure ExtractFromCell(ACell: PCell); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure ExecuteTarget(Target: TObject); override;
+  published
+    property Borders: TsActionBorders read FBorders write FBorders;
+    property Caption;
+    property Enabled;
+    property HelpContext;
+    property HelpKeyword;
+    property HelpType;
+    property Hint;
+    property ImageIndex;
+    property OnExecute;
+    property OnHint;
+    property OnUpdate;
+    property SecondaryShortCuts;
+    property ShortCut;
+    property Visible;
+  end;
+
+  TsNoCellBordersAction = class(TsCellAction)
+  protected
+    procedure ApplyFormatToCell(ACell: PCell); override;
+  public
+    procedure ExecuteTarget(Target: TObject); override;
+  published
+    property Caption;
+    property Enabled;
+    property HelpContext;
+    property HelpKeyword;
+    property HelpType;
+    property Hint;
+    property ImageIndex;
+    property OnExecute;
+    property OnHint;
+    property OnUpdate;
+    property SecondaryShortCuts;
+    property ShortCut;
+    property Visible;
+  end;
+
+
+  { --- Actions like those derived from TCommonDialogAction --- }
 
   TsCommonDialogSpreadsheetAction = class(TsSpreadsheetAction)
   private
@@ -276,9 +361,7 @@ type
     property OnCancel: TNotifyEvent read FOnCancel write FOnCancel;
   end;
 
-
   { TsCommondDialogCellAction }
-
   TsCommonDialogCellAction = class(TsCommondialogSpreadsheetAction)
   protected
     procedure DoAccept; override;
@@ -305,9 +388,7 @@ type
     property OnHint;
   end;
 
-
   { TsFontAction }
-
   TsFontAction = class(TsCommonDialogCellAction)
   private
     function GetDialog: TFontDialog;
@@ -322,7 +403,6 @@ type
   end;
 
   { TsBackgroundColorAction }
-
   TsBackgroundColorAction = class(TsCommonDialogCellAction)
   private
     FBackgroundColor: TsColor;
@@ -356,7 +436,8 @@ begin
     TsFontAction, TsFontStyleAction, TsBackgroundColorAction,
     TsHorAlignmentAction, TsVertAlignmentAction,
     TsTextRotationAction, TsWordWrapAction,
-    TsNumberFormatAction, TsDecimalsAction
+    TsNumberFormatAction, TsDecimalsAction,
+    TsCellBorderAction, TsNoCellBordersAction
   ], nil);
 end;
 
@@ -958,6 +1039,175 @@ begin
 end;
 
 
+{ TsCellBorderAction }
+
+procedure TsActionBorder.ApplyStyle(AWorkbook: TsWorkbook;
+  out ABorderStyle: TsCellBorderStyle);
+begin
+  ABorderStyle.LineStyle := FLineStyle;
+  ABorderStyle.Color := AWorkbook.GetPaletteColor(ABorderStyle.Color);
+end;
+
+procedure TsActionBorder.ExtractStyle(AWorkbook: TsWorkbook;
+  ABorderStyle: TsCellBorderStyle);
+begin
+  FLineStyle := ABorderStyle.LineStyle;
+  Color := AWorkbook.AddColorToPalette(ABorderStyle.Color);
+end;
+
+constructor TsActionBorders.Create;
+var
+  cb: TsCellBorder;
+begin
+  inherited Create;
+  for cb in TsCellBorder do
+    FBorders[cb] := TsActionBorder.Create;
+end;
+
+destructor TsActionBorders.Destroy;
+var
+  cb: TsCellBorder;
+begin
+  for cb in TsCellBorder do FBorders[cb].Free;
+  inherited Destroy;
+end;
+
+procedure TsActionBorders.ExtractFromCell(AWorkbook: TsWorkbook; ACell: PCell);
+var
+  cb: TsCellBorder;
+begin
+  if (ACell = nil) or not (uffBorder in ACell^.UsedFormattingFields) then
+    for cb in TsCellBorder do
+    begin
+      FBorders[cb].ExtractStyle(AWorkbook, DEFAULT_BORDERSTYLES[cb]);
+      FBorders[cb].Visible := false;
+    end
+  else
+    for cb in TsCellBorder do
+    begin
+      FBorders[cb].ExtractStyle(AWorkbook, ACell^.BorderStyles[cb]);
+      FBorders[cb].Visible := cb in ACell^.Border;
+    end;
+end;
+
+function TsActionBorders.GetBorder(AIndex: TsCellBorder): TsActionBorder;
+begin
+  Result := FBorders[AIndex];
+end;
+
+procedure TsActionBorders.SetBorder(AIndex: TsCellBorder;
+  AValue: TsActionBorder);
+begin
+  FBorders[AIndex] := AValue;
+end;
+
+constructor TsCellBorderAction.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FBorders := TsActionBorders.Create;
+end;
+
+destructor TsCellBorderAction.Destroy;
+begin
+  FBorders.Free;
+  inherited;
+end;
+
+procedure TsCellBorderAction.ApplyFormatToRange(ARange: TsCellRange);
+
+  procedure ShowBorder(ABorder: TsCellBorder; ACell: PCell;
+    ABorderStyle: TsCellBorderStyle; AEnable: boolean);
+  var
+    brdr: TsCellBorders;
+  begin
+    brdr := ACell^.Border;
+    if AEnable then
+    begin
+      Include(brdr, ABorder);
+      Worksheet.WriteBorderStyle(ACell, ABorder, ABorderStyle);
+      Worksheet.WriteBorders(ACell, brdr);
+      // Don't modify the cell directly, this will miss the OnChange event.
+    end;
+  end;
+
+var
+  r, c: LongInt;
+  ls: TsLineStyle;
+  bs: TsCellBorderStyle;
+  cell: PCell;
+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
+  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);
+  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);
+
+  // 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);
+
+  // Inner vertical lines
+  Borders.InnerVert.ApplyStyle(Workbook, bs);
+  for r := ARange.Row1 to ARange.Row2 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);
+  end;
+end;
+
+procedure TsCellBorderAction.ExecuteTarget(Target: TObject);
+begin
+  ApplyFormatToSelection;
+end;
+
+procedure TsCellBorderAction.ExtractFromCell(ACell: PCell);
+var
+  EmptyCell: TCell;
+begin
+  if (ACell = nil) or not (uffBorder in ACell^.UsedFormattingFields) then
+  begin
+    InitCell(EmptyCell);
+    FBorders.ExtractFromCell(Workbook, @EmptyCell);
+  end else
+    FBorders.ExtractFromCell(Workbook, ACell);
+end;
+
+
+{ TsNoCellBordersAction }
+
+procedure TsNoCellBordersAction.ApplyFormatToCell(ACell: PCell);
+begin
+  Worksheet.WriteBorders(ACell, []);
+end;
+
+procedure TsNoCellBordersAction.ExecuteTarget(Target: TObject);
+begin
+  ApplyFormatToSelection;
+end;
+
+
 { TsCommonDialogSpreadsheetAction }
 
 constructor TsCommonDialogSpreadsheetAction.Create(AOwner: TComponent);