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

fpspreadsheet: Add action for merging cells. Add combobox for font name and font size.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3733 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-11-16 21:59:52 +00:00
parent 23db2b81b2
commit 32aa7437f9
9 changed files with 1588 additions and 157 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1264
components/fpspreadsheet/examples/fpsctrls/main.lfm
View File

File diff suppressed because it is too large Load Diff

15
components/fpspreadsheet/examples/fpsctrls/main.pas
View File

@ -111,8 +111,8 @@ type
AcNumFormatTimeInterval: TsNumberFormatAction;
AcIncDecimals: TsDecimalsAction;
AcDecDecimals: TsDecimalsAction;
AcCellFont: TsFontAction;
AcBackgroundColor: TsBackgroundColorAction;
AcCellFontDialog: TsFontDialogAction;
AcBackgroundColorDialog: TsBackgroundColorDialogAction;
AcCellBorderTop: TsCellBorderAction;
AcCellBorderBottom: TsCellBorderAction;
AcCellBorderLeft: TsCellBorderAction;
@ -129,6 +129,11 @@ type
AcCellBorderTopBottomDbl: TsCellBorderAction;
AcCellBorderAll: TsCellBorderAction;
AcCellBorderAllVert: TsCellBorderAction;
FontnameCombo: TsFontnameCombobox;
sFontSizeCombobox1: TsFontSizeCombobox;
AcMergeCells: TsMergeAction;
ToolBar2: TToolBar;
ToolButton1: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
ToolButton13: TToolButton;
@ -147,7 +152,6 @@ type
AcDeleteWorksheet: TsWorksheetDeleteAction;
acRenameWorksheet: TsWorksheetRenameAction;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton10: TToolButton;
ToolButton2: TToolButton;
ToolButton20: TToolButton;
@ -158,18 +162,19 @@ type
ToolButton25: TToolButton;
ToolButton26: TToolButton;
ToolButton27: TToolButton;
ToolButton28: TToolButton;
ToolButton29: TToolButton;
ToolButton3: TToolButton;
ToolButton30: TToolButton;
ToolButton31: TToolButton;
TbBorders: TToolButton;
ToolButton32: TToolButton;
ToolButton33: TToolButton;
ToolButton34: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
WorkbookSource: TsWorkbookSource;
WorkbookTabControl: TsWorkbookTabControl;
WorksheetGrid: TsWorksheetGrid;

14
components/fpspreadsheet/examples/fpsctrls_no_install/main.lfm
View File

@ -4,7 +4,7 @@ object Form1: TForm1
Top = 177
Width = 874
Caption = 'Form1'
ClientHeight = 503
ClientHeight = 508
ClientWidth = 874
Menu = MainMenu
OnCreate = FormCreate
@ -126,10 +126,10 @@ object Form1: TForm1
end
object CbLoader: TComboBox
Left = 104
Height = 28
Height = 23
Top = 8
Width = 148
ItemHeight = 20
ItemHeight = 15
ItemIndex = 1
Items.Strings = (
'Workbook'
@ -142,16 +142,16 @@ object Form1: TForm1
end
object Label1: TLabel
Left = 13
Height = 20
Height = 15
Top = 11
Width = 73
Width = 58
Caption = 'Loaded by:'
ParentColor = False
end
end
object InspectorTabControl: TTabControl
Left = 577
Height = 403
Height = 408
Top = 100
Width = 297
OnChange = InspectorTabControlChange
@ -167,7 +167,7 @@ object Form1: TForm1
end
object Splitter1: TSplitter
Left = 572
Height = 403
Height = 408
Top = 100
Width = 5
Align = alRight

6
components/fpspreadsheet/examples/fpsctrls_no_install/main.pas
View File

@ -221,6 +221,12 @@ begin
end;
MnuRenameWorksheet.Action := actn;
{ Font names }
with TsFontnameCombobox.Create(self) do begin
Parent := Toolbar1;
WorkbookSource := Self.WorkbookSource;
end;
{ Font styles }
actn := TsFontStyleAction.Create(self);
with TsFontStyleAction(actn) do begin

100
components/fpspreadsheet/fpsactions.pas
View File

@ -336,6 +336,19 @@ type
property Visible;
end;
{ TsMergeAction }
TsMergeAction = class(TsAutoFormatAction)
private
function GetMerged: Boolean;
procedure SetMerged(AValue: Boolean);
protected
procedure ApplyFormatToRange(ARange: TsCellRange); override;
procedure ExtractFromCell(ACell: PCell); override;
public
constructor Create(AOwner: TComponent); override;
published
property Merged: Boolean read GetMerged write SetMerged default false;
end;
{ --- Actions like those derived from TCommonDialogAction --- }
@ -388,22 +401,20 @@ type
property OnHint;
end;
{ TsFontAction }
TsFontAction = class(TsCommonDialogCellAction)
{ TsFontDialogAction }
TsFontDialogAction = class(TsCommonDialogCellAction)
private
function GetDialog: TFontDialog;
protected
procedure ApplyFormatToCell(ACell: PCell); override;
procedure ExtractFromCell(ACell: PCell); override;
function GetDialogClass: TCommonDialogClass; override;
public
constructor Create(AOwner: TComponent); override;
published
property Dialog: TFontDialog read GetDialog;
end;
{ TsBackgroundColorAction }
TsBackgroundColorAction = class(TsCommonDialogCellAction)
{ TsBackgroundColorDialogAction }
TsBackgroundColorDialogAction = class(TsCommonDialogCellAction)
private
FBackgroundColor: TsColor;
function GetDialog: TColorDialog;
@ -413,8 +424,6 @@ type
procedure DoBeforeExecute; override;
procedure ExtractFromCell(ACell: PCell); override;
function GetDialogClass: TCommonDialogClass; override;
public
constructor Create(AOwner: TComponent); override;
published
property Dialog: TColorDialog read GetDialog;
end;
@ -433,11 +442,12 @@ begin
// Worksheet-releated actions
TsWorksheetAddAction, TsWorksheetDeleteAction, TsWorksheetRenameAction,
// Cell or cell range formatting actions
TsFontAction, TsFontStyleAction, TsBackgroundColorAction,
TsFontStyleAction, TsFontDialogAction, TsBackgroundColorDialogAction,
TsHorAlignmentAction, TsVertAlignmentAction,
TsTextRotationAction, TsWordWrapAction,
TsNumberFormatAction, TsDecimalsAction,
TsCellBorderAction, TsNoCellBordersAction
TsCellBorderAction, TsNoCellBordersAction,
TsMergeAction
], nil);
end;
@ -1208,6 +1218,38 @@ begin
end;
{ TsMergeAction }
constructor TsMergeAction.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
AutoCheck := true;
end;
procedure TsMergeAction.ApplyFormatToRange(ARange: TsCellRange);
begin
if Merged then
Worksheet.MergeCells(ARange.Row1, ARange.Col1, ARange.Row2, ARange.Col2)
else
Worksheet.UnmergeCells(ARange.Row1, ARange.Col1);
end;
procedure TsMergeAction.ExtractFromCell(ACell: PCell);
begin
Checked := (ACell <> nil) and Worksheet.IsMerged(ACell);
end;
function TsMergeAction.GetMerged: Boolean;
begin
Result := Checked;
end;
procedure TsMergeAction.SetMerged(AValue: Boolean);
begin
Checked := AValue;
end;
{ TsCommonDialogSpreadsheetAction }
constructor TsCommonDialogSpreadsheetAction.Create(AOwner: TComponent);
@ -1285,16 +1327,9 @@ begin
end;
{ TsFontAction }
{ TsFontDialogAction }
constructor TsFontAction.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Caption := 'Font';
Hint := 'Select cell font';
end;
procedure TsFontAction.ApplyFormatToCell(ACell: PCell);
procedure TsFontDialogAction.ApplyFormatToCell(ACell: PCell);
var
sfnt: TsFont;
begin
@ -1303,7 +1338,7 @@ begin
Worksheet.WriteFont(ACell, Workbook.AddFont(sfnt));
end;
procedure TsFontAction.ExtractFromCell(ACell: PCell);
procedure TsFontDialogAction.ExtractFromCell(ACell: PCell);
var
sfnt: TsFont;
fnt: TFont;
@ -1327,44 +1362,37 @@ begin
end;
end;
function TsFontAction.GetDialog: TFontDialog;
function TsFontDialogAction.GetDialog: TFontDialog;
begin
Result := TFontDialog(FDialog);
end;
function TsFontAction.GetDialogClass: TCommonDialogClass;
function TsFontDialogAction.GetDialogClass: TCommonDialogClass;
begin
Result := TFontDialog;
end;
{ TsBackgroundColorAction }
{ TsBackgroundColorDialogAction }
constructor TsBackgroundColorAction.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Caption := 'Backgroundcolor';
Hint := 'Modify background color';
end;
procedure TsBackgroundColorAction.ApplyFormatToCell(ACell: PCell);
procedure TsBackgroundColorDialogAction.ApplyFormatToCell(ACell: PCell);
begin
Worksheet.WritebackgroundColor(ACell, FBackgroundColor);
end;
procedure TsBackgroundColorAction.DoAccept;
procedure TsBackgroundColorDialogAction.DoAccept;
begin
FBackgroundColor := Workbook.AddColorToPalette(TsColorValue(Dialog.Color));
inherited;
end;
procedure TsBackgroundColorAction.DoBeforeExecute;
procedure TsBackgroundColorDialogAction.DoBeforeExecute;
begin
inherited;
Dialog.Color := Workbook.GetPaletteColor(FBackgroundColor);
end;
procedure TsBackgroundColorAction.ExtractFromCell(ACell: PCell);
procedure TsBackgroundColorDialogAction.ExtractFromCell(ACell: PCell);
begin
if (ACell = nil) or not (uffBackgroundColor in ACell^.UsedFormattingFields) then
FBackgroundColor := scNotDefined
@ -1372,12 +1400,12 @@ begin
FBackgroundColor := ACell^.BackgroundColor;
end;
function TsBackgroundColorAction.GetDialog: TColorDialog;
function TsBackgroundColorDialogAction.GetDialog: TColorDialog;
begin
Result := TColorDialog(FDialog);
end;
function TsBackgroundColorAction.GetDialogClass: TCommonDialogClass;
function TsBackgroundColorDialogAction.GetDialogClass: TCommonDialogClass;
begin
Result := TColorDialog;
end;

332
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

@ -215,6 +215,65 @@ type
end;
{ TsCellCombobox }
TsCellCombobox = class(TCombobox)
private
FWorkbookSource: TsWorkbookSource;
function GetWorkbook: TsWorkbook;
function GetWorksheet: TsWorksheet;
procedure SetWorkbookSource(AValue: TsWorkbookSource);
protected
procedure ApplyFormatToCell(ACell: PCell); virtual;
procedure ExtractFromCell(ACell: PCell); virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Populate; virtual;
procedure Select; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ListenerNotification(AChangedItems: TsNotificationItems;
AData: Pointer = nil);
property Workbook: TsWorkbook read GetWorkbook;
property Worksheet: TsWorksheet read GetWorksheet;
published
{@@ Link to the WorkbookSource which provides the workbook and worksheet. }
property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource;
end;
{ TsCellFontCombobox }
TsCellFontCombobox = class(TsCellCombobox)
protected
function GetCellFont(ACell: PCell): TsFont;
end;
{TsFontNameCombobox }
TsFontNameCombobox = class(TsCellFontCombobox)
protected
procedure ApplyFormatToCell(ACell: PCell); override;
procedure ExtractFromCell(ACell: PCell); override;
procedure Populate; override;
public
constructor Create(AOwner: TComponent); override;
end;
{TsFontSizeCombobox }
TsFontSizeCombobox = class(TsCellFontCombobox)
protected
procedure ApplyFormatToCell(ACell: PCell); override;
procedure ExtractFromCell(ACell: PCell); override;
procedure Populate; override;
public
constructor Create(AOwner: TComponent); override;
end;
{ TsSpreadsheetInspector }
{@@ Classification of data displayed by the SpreadsheetInspector. Each item
@ -268,7 +327,7 @@ procedure Register;
implementation
uses
Dialogs, TypInfo,
Dialogs, Forms, TypInfo,
fpsStrings, fpsUtils, fpSpreadsheetGrid;
@ -278,8 +337,11 @@ uses
-------------------------------------------------------------------------------}
procedure Register;
begin
RegisterComponents('FPSpreadsheet', [TsWorkbookSource, TsWorkbookTabControl,
TsCellEdit, TsCellIndicator, TsSpreadsheetInspector]);
RegisterComponents('FPSpreadsheet', [
TsWorkbookSource, TsWorkbookTabControl, TsWorksheetGrid,
TsCellEdit, TsCellIndicator, TsFontNameCombobox, TsFontSizeCombobox,
TsSpreadsheetInspector
]);
end;
@ -508,6 +570,9 @@ var
i: Integer;
begin
for i:=0 to FListeners.Count-1 do
if TObject(FListeners[i]) is TsCellCombobox then
TsCellCombobox(FListeners[i]).ListenerNotification(AChangedItems, AData)
else
if TObject(FListeners[i]) is TsCellIndicator then
TsCellIndicator(FListeners[i]).ListenerNotification(AChangedItems, AData)
else
@ -544,6 +609,9 @@ begin
if TComponent(FListeners[i]) = AListener then
begin
FListeners.Delete(i);
if (AListener is TsCellCombobox) then
TsCellCombobox(AListener).WorkbookSource := nil
else
if (AListener is TsCellIndicator) then
TsCellIndicator(AListener).WorkbookSource := nil
else
@ -1175,6 +1243,264 @@ begin
end;
{------------------------------------------------------------------------------}
{ TsCellCombobox }
{------------------------------------------------------------------------------}
{@@ ----------------------------------------------------------------------------
Constructor of the Cell Combobox. Populates the items list
-------------------------------------------------------------------------------}
constructor TsCellCombobox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Populate;
end;
{@@ ----------------------------------------------------------------------------
Destructor of the WorkbookTabControl.
Removes itself from the WorkbookSource's listener list.
-------------------------------------------------------------------------------}
destructor TsCellCombobox.Destroy;
begin
if FWorkbookSource <> nil then FWorkbookSource.RemoveListener(self);
inherited Destroy;
end;
{@@ ----------------------------------------------------------------------------
Applies the format to a cell. Override according to the format item for
which the combobox is responsible.
-------------------------------------------------------------------------------}
procedure TsCellCombobox.ApplyFormatToCell(ACell: PCell);
begin
end;
{@@ ----------------------------------------------------------------------------
Extracts the format item the combobox is responsible for from the cell and
selectes the corresponding combobox item.
-------------------------------------------------------------------------------}
procedure TsCellCombobox.ExtractFromCell(ACell: PCell);
begin
end;
{@@ ----------------------------------------------------------------------------
Getter method for the property Workbook which is currently loaded by the
WorkbookSource
-------------------------------------------------------------------------------}
function TsCellCombobox.GetWorkbook: TsWorkbook;
begin
if FWorkbookSource <> nil then
Result := FWorkbookSource.Workbook
else
Result := nil;
end;
{@@ ----------------------------------------------------------------------------
Getter method for the property Worksheet which is currently loaded by the
WorkbookSource
-------------------------------------------------------------------------------}
function TsCellCombobox.GetWorksheet: TsWorksheet;
begin
if FWorkbookSource <> nil then
Result := FWorkbookSource.Worksheet
else
Result := nil;
end;
{@@ ----------------------------------------------------------------------------
Notification procedure received whenver "something" changes in the workbook.
Reacts on all events.
@param AChangedItems Set with elements identifying whether workbook, worksheet
cell or selection has changed.
@param AData If AChangedItems contains nliCell then AData points to
the modified cell.
-------------------------------------------------------------------------------}
procedure TsCellCombobox.ListenerNotification(
AChangedItems: TsNotificationItems; AData: Pointer = nil);
var
activeCell: PCell;
begin
Unused(AData);
if worksheet = nil then
exit;
activeCell := Worksheet.FindCell(Worksheet.ActiveCellRow, Worksheet.ActiveCellCol);
if ((lniCell in AChangedItems) and (PCell(AData) = activeCell)) or
(lniSelection in AChangedItems)
then
ExtractFromCell(activeCell);
end;
{@@ ----------------------------------------------------------------------------
Standard component notification method called when the WorkbookSource
is deleted.
-------------------------------------------------------------------------------}
procedure TsCellCombobox.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FWorkbookSource) then
SetWorkbookSource(nil);
end;
{@@ ----------------------------------------------------------------------------
Descendants override this method to populate the items of the combobox.
-------------------------------------------------------------------------------}
procedure TsCellCombobox.Populate;
begin
end;
{@@ ----------------------------------------------------------------------------
A new item in the combobox is selected. Changes the selected cells according
to the Mode property by calling ApplyFormatToCell.
-------------------------------------------------------------------------------}
procedure TsCellCombobox.Select;
var
r, c: Cardinal;
range: Integer;
sel: TsCellRangeArray;
cell: PCell;
begin
inherited Select;
if Worksheet = nil then
exit;
sel := Worksheet.GetSelection;
for range := 0 to High(sel) do
for r := sel[range].Row1 to sel[range].Row2 do
for c := sel[range].Col1 to sel[range].Col2 do
begin
cell := Worksheet.GetCell(r, c); // Use "GetCell" here to format empty cells as well
ApplyFormatToCell(cell); // no check for nil required because of "GetCell"
end;
end;
{@@ ----------------------------------------------------------------------------
Setter method for the WorkbookSource
-------------------------------------------------------------------------------}
procedure TsCellCombobox.SetWorkbookSource(AValue: TsWorkbookSource);
begin
if AValue = FWorkbookSource then
exit;
if FWorkbookSource <> nil then
FWorkbookSource.RemoveListener(self);
FWorkbookSource := AValue;
if FWorkbookSource <> nil then
FWorkbookSource.AddListener(self);
Text := '';
ListenerNotification([lniSelection]);
end;
{------------------------------------------------------------------------------}
{ TsCellFontCombobox }
{------------------------------------------------------------------------------}
function TsCellFontCombobox.GetCellFont(ACell: PCell): TsFont;
begin
if ACell = nil then
Result := Workbook.GetDefaultFont
else
if (uffBold in ACell^.UsedFormattingFields) then
Result := Workbook.GetFont(1)
else
if (uffFont in ACell^.UsedFormattingFields) then
Result := Workbook.GetFont(ACell^.FontIndex)
else
Result := Workbook.GetDefaultFont;
end;
{------------------------------------------------------------------------------}
{ TsFontNameCombobox }
{------------------------------------------------------------------------------}
constructor TsFontNameCombobox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 150;
end;
procedure TsFontNameCombobox.ApplyFormatToCell(ACell: PCell);
var
fnt: TsFont;
begin
if ItemIndex > -1 then
begin
fnt := GetCellFont(ACell);
Worksheet.WriteFont(ACell, Items[ItemIndex], fnt.Size, fnt.Style, fnt.Color);
end;
end;
procedure TsFontNameCombobox.ExtractFromCell(ACell: PCell);
var
fnt: TsFont;
begin
fnt := GetCellFont(ACell);
ItemIndex := Items.IndexOf(fnt.FontName);
end;
procedure TsFontNameCombobox.Populate;
begin
Items.Assign(Screen.Fonts);
end;
{------------------------------------------------------------------------------}
{ TsFontSizeCombobox }
{------------------------------------------------------------------------------}
constructor TsFontSizeCombobox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 60;
end;
procedure TsFontSizeCombobox.ApplyFormatToCell(ACell: PCell);
var
fnt: TsFont;
fs: Double;
begin
if ItemIndex > -1 then
begin
fs := StrToFloat(Items[ItemIndex]);
fnt := GetCellFont(ACell);
Worksheet.WriteFont(ACell, fnt.FontName, fs, fnt.Style, fnt.Color);
end;
end;
procedure TsFontSizeCombobox.ExtractFromCell(ACell: PCell);
var
fnt: TsFont;
begin
fnt := GetCellFont(ACell);
ItemIndex := Items.IndexOf(Format('%.0f', [fnt.Size]));
end;
procedure TsFontSizeCombobox.Populate;
begin
with Items do
begin
Clear;
Add('8');
Add('9');
Add('10');
Add('11');
Add('12');
Add('14');
Add('16');
Add('18');
Add('20');
Add('22');
Add('24');
Add('26');
Add('28');
Add('32');
Add('36');
Add('48');
Add('72');
end;
end;
{------------------------------------------------------------------------------}
{ TsSpreadsheetInspector }
{------------------------------------------------------------------------------}

12
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -32,10 +32,8 @@ type
{ TsCustomWorksheetGrid }
{@@
TsCustomWorksheetGrid is the ancestor of TsWorkseetGrid and is able to
display spreadsheet data along with their formatting.
}
{@@ TsCustomWorksheetGrid is the ancestor of TsWorkseetGrid and is able to
display spreadsheet data along with their formatting. }
TsCustomWorksheetGrid = class(TCustomDrawGrid)
private
{ Private declarations }
@ -556,7 +554,7 @@ type
property OnContextPopup;
end;
procedure Register;
//procedure Register;
implementation
@ -669,7 +667,7 @@ begin
then TRGBA(Result).B := TRGBA(c).B + ADelta
else TRGBA(Result).B := TRGBA(c).B - ADelta;
end;
(*
{@@ ----------------------------------------------------------------------------
Registers the worksheet grid in the Lazarus component palette,
page "FPSpreadsheet".
@ -678,7 +676,7 @@ procedure Register;
begin
RegisterComponents('FPSpreadsheet', [TsWorksheetGrid]);
end;
*)
{*******************************************************************************
* TsCustomWorksheetGrid *

1
components/fpspreadsheet/laz_fpspreadsheet_visual.lpk
View File

@ -28,7 +28,6 @@ It provides graphical components like a grid and chart."/>
</Item1>
<Item2>
<Filename Value="fpspreadsheetgrid.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="fpspreadsheetgrid"/>
</Item2>
<Item3>

1
components/fpspreadsheet/laz_fpspreadsheet_visual.pas
View File

@ -15,7 +15,6 @@ implementation
procedure Register;
begin
RegisterUnit('fpspreadsheetctrls', @fpspreadsheetctrls.Register);
RegisterUnit('fpspreadsheetgrid', @fpspreadsheetgrid.Register);
RegisterUnit('fpspreadsheetchart', @fpspreadsheetchart.Register);
RegisterUnit('fpsActions', @fpsActions.Register);
end;