diff --git a/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.ico b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.ico
new file mode 100644
index 000000000..0341321b5
Binary files /dev/null and b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.ico differ
diff --git a/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.lpi b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.lpi
new file mode 100644
index 000000000..fb5e6982a
--- /dev/null
+++ b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.lpi
@@ -0,0 +1,89 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.lpr b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.lpr
new file mode 100644
index 000000000..2eea9e5ee
--- /dev/null
+++ b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.lpr
@@ -0,0 +1,21 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, Unit1, rxnew
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource := True;
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
+
diff --git a/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.lps b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.lps
new file mode 100644
index 000000000..5eeb9aca6
--- /dev/null
+++ b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.lps
@@ -0,0 +1,132 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.res b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.res
new file mode 100644
index 000000000..7c6cf3e4b
Binary files /dev/null and b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.res differ
diff --git a/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/unit1.lfm b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/unit1.lfm
new file mode 100644
index 000000000..c72dcd468
--- /dev/null
+++ b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/unit1.lfm
@@ -0,0 +1,265 @@
+object Form1: TForm1
+ Left = 699
+ Height = 466
+ Top = 261
+ Width = 698
+ Caption = 'Form1'
+ ClientHeight = 466
+ ClientWidth = 698
+ OnCreate = FormCreate
+ LCLVersion = '1.3'
+ object RxDBGrid1: TRxDBGrid
+ Left = 0
+ Height = 394
+ Top = 72
+ Width = 698
+ TitleButtons = False
+ AutoSort = True
+ Columns = <
+ item
+ Color = clMoneyGreen
+ Title.Alignment = taCenter
+ Title.Caption = 'CODE'
+ Title.Orientation = toHorizontal
+ Width = 90
+ FieldName = 'CODE'
+ Filter.DropDownRows = 0
+ Filter.EmptyValue = '(Нет)'
+ Filter.EmptyFont.Style = [fsItalic]
+ Filter.ItemIndex = -1
+ EditButtons = <>
+ end
+ item
+ Color = clAqua
+ Title.Alignment = taCenter
+ Title.Caption = 'NAME'
+ Title.Orientation = toHorizontal
+ Width = 350
+ FieldName = 'NAME'
+ Filter.DropDownRows = 0
+ Filter.EmptyValue = '(Нет)'
+ Filter.EmptyFont.Style = [fsItalic]
+ Filter.ItemIndex = -1
+ EditButtons = <>
+ end
+ item
+ Title.Alignment = taCenter
+ Title.Caption = 'PRICE'
+ Title.Orientation = toHorizontal
+ Width = 120
+ FieldName = 'PRICE'
+ Filter.DropDownRows = 0
+ Filter.EmptyValue = '(Нет)'
+ Filter.EmptyFont.Style = [fsItalic]
+ Filter.ItemIndex = -1
+ EditButtons = <>
+ end>
+ KeyStrokes = <
+ item
+ Command = rxgcShowFindDlg
+ ShortCut = 16454
+ Enabled = True
+ end
+ item
+ Command = rxgcShowColumnsDlg
+ ShortCut = 16471
+ Enabled = True
+ end
+ item
+ Command = rxgcShowFilterDlg
+ ShortCut = 16468
+ Enabled = True
+ end
+ item
+ Command = rxgcShowSortDlg
+ ShortCut = 16467
+ Enabled = True
+ end
+ item
+ Command = rxgcShowQuickFilter
+ ShortCut = 16465
+ Enabled = True
+ end
+ item
+ Command = rxgcHideQuickFilter
+ ShortCut = 16456
+ Enabled = True
+ end
+ item
+ Command = rxgcSelectAll
+ ShortCut = 16449
+ Enabled = True
+ end
+ item
+ Command = rxgcDeSelectAll
+ ShortCut = 16429
+ Enabled = True
+ end
+ item
+ Command = rxgcInvertSelection
+ ShortCut = 16426
+ Enabled = True
+ end
+ item
+ Command = rxgcOptimizeColumnsWidth
+ ShortCut = 16427
+ Enabled = True
+ end
+ item
+ Command = rxgcCopyCellValue
+ ShortCut = 16451
+ Enabled = True
+ end>
+ OptionsRx = [rdgAllowColumnsForm, rdgAllowDialogFind, rdgAllowToolMenu]
+ Align = alClient
+ Color = clWindow
+ DrawFullLine = False
+ FocusColor = clRed
+ SelectedColor = clHighlight
+ GridLineStyle = psSolid
+ DataSource = DataSource1
+ Options = [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColumnMove, dgColLines, dgRowLines, dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit]
+ ParentColor = False
+ TabOrder = 0
+ TitleStyle = tsNative
+ end
+ object Panel1: TPanel
+ Left = 0
+ Height = 72
+ Top = 0
+ Width = 698
+ Align = alTop
+ AutoSize = True
+ ClientHeight = 72
+ ClientWidth = 698
+ TabOrder = 1
+ object Label1: TLabel
+ AnchorSideLeft.Control = Panel1
+ AnchorSideTop.Control = Panel1
+ Left = 7
+ Height = 21
+ Top = 7
+ Width = 145
+ BorderSpacing.Around = 6
+ Caption = 'SpeadSheet file name '
+ ParentColor = False
+ end
+ object CheckBox1: TCheckBox
+ AnchorSideTop.Control = Panel1
+ AnchorSideRight.Control = Panel1
+ AnchorSideRight.Side = asrBottom
+ Left = 551
+ Height = 23
+ Top = 7
+ Width = 140
+ Anchors = [akTop, akRight]
+ BorderSpacing.Around = 6
+ Caption = 'Open after export'
+ Checked = True
+ State = cbChecked
+ TabOrder = 0
+ end
+ object FileNameEdit1: TFileNameEdit
+ AnchorSideLeft.Control = Label1
+ AnchorSideTop.Control = Label1
+ AnchorSideTop.Side = asrBottom
+ Left = 13
+ Height = 31
+ Top = 34
+ Width = 275
+ FilterIndex = 0
+ HideDirectories = False
+ ButtonWidth = 23
+ NumGlyphs = 1
+ BorderSpacing.Around = 6
+ MaxLength = 0
+ TabOrder = 1
+ end
+ object Button1: TButton
+ AnchorSideLeft.Control = FileNameEdit1
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = FileNameEdit1
+ AnchorSideTop.Side = asrCenter
+ Left = 294
+ Height = 33
+ Top = 33
+ Width = 87
+ Caption = 'Export data'
+ OnClick = Button1Click
+ TabOrder = 2
+ end
+ end
+ object RxMemoryData1: TRxMemoryData
+ FieldDefs = <
+ item
+ Name = 'CODE'
+ DataType = ftInteger
+ Precision = 0
+ Size = 0
+ end
+ item
+ Name = 'NAME'
+ DataType = ftString
+ Precision = 0
+ Size = 300
+ end
+ item
+ Name = 'PRICE'
+ DataType = ftCurrency
+ Precision = 0
+ Size = 0
+ end>
+ PacketRecords = 0
+ left = 368
+ top = 184
+ object RxMemoryData1CODE: TLongintField
+ DisplayWidth = 10
+ FieldKind = fkData
+ FieldName = 'CODE'
+ Index = 0
+ LookupCache = False
+ ProviderFlags = [pfInUpdate, pfInWhere]
+ ReadOnly = False
+ Required = False
+ end
+ object RxMemoryData1NAME: TStringField
+ DisplayWidth = 300
+ FieldKind = fkData
+ FieldName = 'NAME'
+ Index = 1
+ LookupCache = False
+ ProviderFlags = [pfInUpdate, pfInWhere]
+ ReadOnly = False
+ Required = False
+ Size = 300
+ end
+ object RxMemoryData1PRICE: TCurrencyField
+ DisplayWidth = 10
+ FieldKind = fkData
+ FieldName = 'PRICE'
+ Index = 2
+ LookupCache = False
+ ProviderFlags = [pfInUpdate, pfInWhere]
+ ReadOnly = False
+ Required = False
+ MaxValue = 0
+ MinValue = 0
+ Precision = 2
+ end
+ end
+ object DataSource1: TDataSource
+ DataSet = RxMemoryData1
+ left = 328
+ top = 184
+ end
+ object RxDBGridExportSpreadSheet1: TRxDBGridExportSpreadSheet
+ RxDBGrid = RxDBGrid1
+ Caption = 'Экспорт в электронную таблицу'
+ OnBeforeExecute = RxDBGridExportSpreadSheet1BeforeExecute
+ OnAfterExecute = RxDBGridExportSpreadSheet1AfterExecute
+ PageName = 'Test page'
+ Options = []
+ left = 336
+ top = 256
+ end
+end
diff --git a/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/unit1.pas b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/unit1.pas
new file mode 100644
index 000000000..1fef375b8
--- /dev/null
+++ b/components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/unit1.pas
@@ -0,0 +1,85 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, rxdbgrid, rxmemds, RxDBGridExportSpreadSheet,
+ Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, EditBtn, db;
+
+type
+
+ { TForm1 }
+
+ TForm1 = class(TForm)
+ Button1: TButton;
+ CheckBox1: TCheckBox;
+ DataSource1: TDataSource;
+ FileNameEdit1: TFileNameEdit;
+ Label1: TLabel;
+ Panel1: TPanel;
+ RxDBGrid1: TRxDBGrid;
+ RxDBGridExportSpreadSheet1: TRxDBGridExportSpreadSheet;
+ RxMemoryData1: TRxMemoryData;
+ RxMemoryData1CODE: TLongintField;
+ RxMemoryData1NAME: TStringField;
+ RxMemoryData1PRICE: TCurrencyField;
+ procedure Button1Click(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure RxDBGridExportSpreadSheet1AfterExecute(Sender: TObject);
+ procedure RxDBGridExportSpreadSheet1BeforeExecute(Sender: TObject);
+ private
+ { private declarations }
+ public
+ { public declarations }
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+uses LCLIntf;
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.FormCreate(Sender: TObject);
+var
+ i:integer;
+begin
+ RxMemoryData1.Open;
+ //fill test values
+ for i:=1 to 20 do
+ begin
+ RxMemoryData1.Append;
+ RxMemoryData1CODE.AsInteger:=i;
+ RxMemoryData1NAME.AsString:=Format('Line %d', [i]);
+ RxMemoryData1PRICE.AsFloat:=Random * 100 + 5;
+ RxMemoryData1.Post;
+ end;
+ RxMemoryData1.Open;
+
+ FileNameEdit1.Text:='test1.ods';
+end;
+
+procedure TForm1.RxDBGridExportSpreadSheet1AfterExecute(Sender: TObject);
+begin
+ if CheckBox1.Checked then
+ OpenDocument(FileNameEdit1.FileName);
+end;
+
+procedure TForm1.RxDBGridExportSpreadSheet1BeforeExecute(Sender: TObject);
+begin
+ RxDBGridExportSpreadSheet1.FileName:=FileNameEdit1.Text;
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+ RxDBGridExportSpreadSheet1.Execute;
+end;
+
+end.
+
diff --git a/components/rx/trunk/languages/rxdconst.es.po b/components/rx/trunk/languages/rxdconst.es.po
index e297b7b49..1171ce8c5 100644
--- a/components/rx/trunk/languages/rxdconst.es.po
+++ b/components/rx/trunk/languages/rxdconst.es.po
@@ -447,6 +447,10 @@ msgstr "Error del Servidor"
msgid "find"
msgstr "buscar"
+#: rxdconst.stoolsexportspeadsheet
+msgid "Export to speadsheet"
+msgstr ""
+
#: rxdconst.sunknownfieldtype
msgid "SUnknownFieldType %s"
msgstr "STipoCampoDesconocido %s"
diff --git a/components/rx/trunk/languages/rxdconst.po b/components/rx/trunk/languages/rxdconst.po
index b21287f86..40b98c58e 100644
--- a/components/rx/trunk/languages/rxdconst.po
+++ b/components/rx/trunk/languages/rxdconst.po
@@ -443,6 +443,10 @@ msgstr ""
msgid "find"
msgstr ""
+#: rxdconst.stoolsexportspeadsheet
+msgid "Export to speadsheet"
+msgstr ""
+
#: rxdconst.sunknownfieldtype
msgid "SUnknownFieldType %s"
msgstr ""
diff --git a/components/rx/trunk/languages/rxdconst.ru.po b/components/rx/trunk/languages/rxdconst.ru.po
index a530817cd..76ccdf6bf 100644
--- a/components/rx/trunk/languages/rxdconst.ru.po
+++ b/components/rx/trunk/languages/rxdconst.ru.po
@@ -217,7 +217,7 @@ msgstr "Вы хотите повторить попытку соединения
#: rxdconst.srxallfields
msgid "All fields"
-msgstr ""
+msgstr "Все поля"
#: rxdconst.srxascendign
msgid "Ascendign"
@@ -333,15 +333,15 @@ msgstr "По убыванию"
#: rxdconst.srxfieldslookupdisplay
msgid "Fields as LookupDisplay"
-msgstr ""
+msgstr "Поля в свойстве LookupDisplay"
#: rxdconst.srxfillfieldslookupdisp
msgid "Fill fields in LookupDisplay property"
-msgstr ""
+msgstr "Заполните список для поля LookupDisplay"
#: rxdconst.srxfillsortfieldsdisp
msgid "Fill fields in SortField property"
-msgstr ""
+msgstr "Заполните список для поля SortField"
#: rxdconst.srxfilterformapply
msgctxt "rxdconst.srxfilterformapply"
@@ -445,6 +445,10 @@ msgstr "Ошибка сервера"
msgid "find"
msgstr "поиск"
+#: rxdconst.stoolsexportspeadsheet
+msgid "Export to speadsheet"
+msgstr "Экспорт в электронную таблицу"
+
#: rxdconst.sunknownfieldtype
msgid "SUnknownFieldType %s"
msgstr "Не определён тип данных для поля %s"
diff --git a/components/rx/trunk/languages/rxdconst.uk.po b/components/rx/trunk/languages/rxdconst.uk.po
index ffc9a5b7c..b6fa70d48 100644
--- a/components/rx/trunk/languages/rxdconst.uk.po
+++ b/components/rx/trunk/languages/rxdconst.uk.po
@@ -454,6 +454,10 @@ msgstr "Помилка сервера"
msgid "find"
msgstr "Пошук"
+#: rxdconst.stoolsexportspeadsheet
+msgid "Export to speadsheet"
+msgstr ""
+
#: rxdconst.sunknownfieldtype
msgid "SUnknownFieldType %s"
msgstr "Не визначений тип даних для поля %s"
diff --git a/components/rx/trunk/rxdbgrid.pas b/components/rx/trunk/rxdbgrid.pas
index 44addc595..80127fb20 100644
--- a/components/rx/trunk/rxdbgrid.pas
+++ b/components/rx/trunk/rxdbgrid.pas
@@ -54,6 +54,7 @@ type
//forward declarations
TRxDBGrid = class;
TRxColumn = class;
+ TRxDBGridAbstractTools = class;
TRxQuickSearchNotifyEvent = procedure(Sender: TObject; Field: TField;
@@ -617,6 +618,8 @@ type
procedure DoClearInvalidTitle;
procedure DoDrawInvalidTitle;
procedure DoSetColEdtBtn;
+ procedure AddTools(ATools:TRxDBGridAbstractTools);
+ procedure RemoveTools(ATools:TRxDBGridAbstractTools);
protected
procedure CollumnSortListUpdate;
procedure CollumnSortListClear;
@@ -859,6 +862,28 @@ type
property OnDisplayLookup: TDisplayLookup read F_DisplayLookup write F_DisplayLookup;
end;
+ { TRxDBGridAbstractTools }
+
+ TRxDBGridAbstractTools = class(TComponent)
+ private
+ FOnAfterExecute: TNotifyEvent;
+ FOnBeforeExecute: TNotifyEvent;
+ procedure ExecTools(Sender:TObject);
+ protected
+ FRxDBGrid: TRxDBGrid;
+ FCaption:string;
+ procedure SetRxDBGrid(AValue: TRxDBGrid);
+ function DoExecTools:boolean; virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ function Execute:boolean;
+ published
+ property RxDBGrid:TRxDBGrid read FRxDBGrid write SetRxDBGrid;
+ property Caption:string read FCaption write FCaption;
+ property OnBeforeExecute:TNotifyEvent read FOnBeforeExecute write FOnBeforeExecute;
+ property OnAfterExecute:TNotifyEvent read FOnAfterExecute write FOnAfterExecute;
+ end;
+
procedure RegisterRxDBGridSortEngine(RxDBGridSortEngineClass: TRxDBGridSortEngineClass;
DataSetClassName: string);
@@ -960,6 +985,44 @@ type
procedure EditingDone; override;
end;
+{ TRxDBGridAbstractTools }
+
+procedure TRxDBGridAbstractTools.SetRxDBGrid(AValue: TRxDBGrid);
+begin
+ if FRxDBGrid=AValue then Exit;
+ if Assigned(FRxDBGrid) then
+ FRxDBGrid.RemoveTools(Self);
+ FRxDBGrid:=AValue;
+ if Assigned(FRxDBGrid) then
+ FRxDBGrid.AddTools(Self);
+end;
+
+function TRxDBGridAbstractTools.DoExecTools: boolean;
+begin
+ //
+end;
+
+procedure TRxDBGridAbstractTools.ExecTools(Sender: TObject);
+begin
+ Execute;
+end;
+
+constructor TRxDBGridAbstractTools.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FCaption:=Name;
+end;
+
+function TRxDBGridAbstractTools.Execute: boolean;
+begin
+ if Assigned(FOnBeforeExecute) then
+ FOnBeforeExecute(Self);
+ Result:=DoExecTools;
+ if Assigned(FOnAfterExecute) then
+ FOnAfterExecute(Self);
+end;
+
+
{ TRxDBGridCollumnConstraint }
procedure TRxDBGridCollumnConstraints.SetMaxWidth(AValue: integer);
@@ -2626,7 +2689,10 @@ begin
if Assigned(Datalink) and (AComponent = DataSource) and (Operation = opRemove) then
begin
ShowMessage('i');
- end;
+ end
+ else
+ if (Operation = opRemove) and (AComponent is TRxDBGridAbstractTools) then
+ RemoveTools(TRxDBGridAbstractTools(AComponent));
end;
function TRxDBGrid.UpdateRowsHeight: integer;
@@ -2780,6 +2846,37 @@ begin
end;
end;
+procedure TRxDBGrid.AddTools(ATools: TRxDBGridAbstractTools);
+var
+ i:integer;
+ R: TMenuItem;
+begin
+ for i:=8 to F_PopupMenu.Items.Count - 1 do
+ if F_PopupMenu.Items[i].Tag = IntPtr(ATools) then
+ exit;
+
+ R := TMenuItem.Create(F_PopupMenu);
+ F_PopupMenu.Items.Add(R);
+ R.Caption := ATools.FCaption;
+ R.OnClick := @(ATools.ExecTools);
+ R.Tag:=IntPtr(ATools);
+end;
+
+procedure TRxDBGrid.RemoveTools(ATools: TRxDBGridAbstractTools);
+var
+ i:integer;
+ R: TMenuItem;
+begin
+ for i:=8 to F_PopupMenu.Items.Count - 1 do
+ if F_PopupMenu.Items[i].Tag = IntPtr(ATools) then
+ begin
+ R:=F_PopupMenu.Items[i];
+ F_PopupMenu.Items.Delete(i);
+ R.Free;
+ exit;
+ end;
+end;
+
procedure TRxDBGrid.DefaultDrawCellA(aCol, aRow: integer; aRect: TRect;
aState: TGridDrawState);
diff --git a/components/rx/trunk/rxdbgrid_export_spreadsheet.lpk b/components/rx/trunk/rxdbgrid_export_spreadsheet.lpk
new file mode 100644
index 000000000..36008ad6f
--- /dev/null
+++ b/components/rx/trunk/rxdbgrid_export_spreadsheet.lpk
@@ -0,0 +1,38 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/rx/trunk/rxdbgrid_export_spreadsheet.pas b/components/rx/trunk/rxdbgrid_export_spreadsheet.pas
new file mode 100644
index 000000000..54183dedd
--- /dev/null
+++ b/components/rx/trunk/rxdbgrid_export_spreadsheet.pas
@@ -0,0 +1,22 @@
+{ This file was automatically created by Lazarus. Do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit rxdbgrid_export_spreadsheet;
+
+interface
+
+uses
+ RxDBGridExportSpreadSheet, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+ RegisterUnit('RxDBGridExportSpreadSheet', @RxDBGridExportSpreadSheet.Register
+ );
+end;
+
+initialization
+ RegisterPackage('rxdbgrid_export_spreadsheet', @Register);
+end.
diff --git a/components/rx/trunk/rxdbgridexportspreadsheet.pas b/components/rx/trunk/rxdbgridexportspreadsheet.pas
new file mode 100644
index 000000000..dafb59e84
--- /dev/null
+++ b/components/rx/trunk/rxdbgridexportspreadsheet.pas
@@ -0,0 +1,253 @@
+unit RxDBGridExportSpreadSheet;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, rxdbgrid, DB, fpspreadsheet, Graphics;
+
+type
+ TRxDBGridExportSpreadSheetOption = (ressExportTitle,
+ ressExportColors,
+ ressExportFooter,
+ ressOverwriteExisting
+ );
+
+ TRxDBGridExportSpreadSheetOptions = set of TRxDBGridExportSpreadSheetOption;
+
+type
+
+ { TRxDBGridExportSpeadSheet }
+
+ TRxDBGridExportSpreadSheet = class(TRxDBGridAbstractTools)
+ private
+ FFileName: string;
+ FOptions: TRxDBGridExportSpreadSheetOptions;
+ FPageName: string;
+ protected
+ FDataSet:TDataSet;
+ FWorkbook: TsWorkbook;
+ FWorksheet: TsWorksheet;
+ FCurRow : integer;
+ FCurCol : integer;
+ scColorBlack:TsColor;
+
+ procedure DoExportTitle;
+ procedure DoExportBody;
+ procedure DoExportFooter;
+ procedure DoExportColWidth;
+ function DoExecTools:boolean;override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property FileName:string read FFileName write FFileName;
+ property PageName:string read FPageName write FPageName;
+ property Options:TRxDBGridExportSpreadSheetOptions read FOptions write FOptions;
+ end;
+
+procedure Register;
+
+implementation
+uses fpsallformats, LCLType, math, LazUTF8, rxdconst;
+
+procedure Register;
+begin
+ RegisterComponents('RX DBAware',[TRxDBGridExportSpreadSheet]);
+end;
+
+const
+ ssAligns : array [TAlignment] of TsHorAlignment = (haLeft, haRight, haCenter);
+
+{ TRxDBGridExportSpeadSheet }
+
+procedure TRxDBGridExportSpreadSheet.DoExportTitle;
+var
+ i, k : Integer;
+ C : TRxColumn;
+ CT : TRxColumnTitle;
+ CC : TColor;
+ scColor : TsColor;
+ CB:TsCellBorders;
+ FMaxTitleHeight : integer;
+begin
+ FCurCol:=0;
+ FMaxTitleHeight:=1;
+ for i:=0 to FRxDBGrid.Columns.Count - 1 do
+ begin
+ C:=FRxDBGrid.Columns[i] as TRxColumn;
+ CT:=C.Title as TRxColumnTitle;
+ FMaxTitleHeight:=Max(FMaxTitleHeight, CT.CaptionLinesCount);
+ if C.Visible then
+ begin
+ if CT.CaptionLinesCount > 0 then
+ begin
+ for k:=0 to CT.CaptionLinesCount - 1 do
+ begin
+ CC:=C.Title.Color;
+ if (CC and SYS_COLOR_BASE) = 0 then
+ begin
+ scColor:=FWorkbook.AddColorToPalette(CC);
+ FWorksheet.WriteBackgroundColor(FCurRow, FCurCol, scColor);
+ end;
+
+ CB:=[cbNorth, cbWest, cbEast, cbSouth];
+
+ FWorksheet.WriteBorderColor(FCurRow + k, FCurCol, cbNorth, scColorBlack);
+
+ if not Assigned(CT.CaptionLine(k).Next) then
+ FWorksheet.WriteBorderColor(FCurRow + k, FCurCol, cbWest, scColorBlack)
+ else
+ CB:=CB - [cbWest];
+
+ if not Assigned(CT.CaptionLine(k).Prior) then
+ FWorksheet.WriteBorderColor(FCurRow + k, FCurCol, cbEast, scColorBlack)
+ else
+ CB:=CB - [cbEast];
+
+ FWorksheet.WriteBorderColor(FCurRow + k ,FCurCol, cbSouth, scColorBlack);
+
+ FWorksheet.WriteBorders(FCurRow + k, FCurCol, CB);
+
+ FWorksheet.WriteHorAlignment(FCurRow + k, FCurCol, ssAligns[C.Title.Alignment]);
+
+ FWorksheet.WriteUTF8Text(FCurRow + k, FCurCol, CT.CaptionLine(k).Caption);
+ end;
+ end
+ else
+ begin
+ CC:=C.Title.Color;
+ if (CC and SYS_COLOR_BASE) = 0 then
+ begin
+ scColor:=FWorkbook.AddColorToPalette(CC);
+ FWorksheet.WriteBackgroundColor( FCurRow, FCurCol, scColor);
+ end;
+
+ FWorksheet.WriteBorders(FCurRow,FCurCol, [cbNorth, cbWest, cbEast, cbSouth]);
+ FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbNorth, scColorBlack);
+ FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbWest, scColorBlack);
+ FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbEast, scColorBlack);
+ FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbSouth, scColorBlack);
+
+ FWorksheet.WriteHorAlignment(FCurRow, FCurCol, ssAligns[C.Title.Alignment]);
+
+ FWorksheet.WriteUTF8Text(FCurRow, FCurCol, C.Title.Caption);
+
+ end;
+
+ inc(FCurCol);
+ end;
+ end;
+
+ inc(FCurRow, FMaxTitleHeight);
+end;
+
+procedure TRxDBGridExportSpreadSheet.DoExportBody;
+var
+ i : Integer;
+ C : TRxColumn;
+ CT : TRxColumnTitle;
+ CC : TColor;
+ scColor : TsColor;
+begin
+ FDataSet.First;
+ while not FDataSet.EOF do
+ begin
+ FCurCol:=0;
+ for i:=0 to FRxDBGrid.Columns.Count - 1 do
+ begin
+ C:=FRxDBGrid.Columns[i] as TRxColumn;
+ CT:=C.Title as TRxColumnTitle;
+ if C.Visible then
+ begin
+ FWorksheet.WriteUTF8Text(FCurRow, FCurCol, C.Field.DisplayText);
+ CC:=C.Color;
+ if (CC and SYS_COLOR_BASE) = 0 then
+ begin
+// CC:=clWhite;
+ scColor:=FWorkbook.AddColorToPalette(CC);
+ FWorksheet.WriteBackgroundColor(FCurRow,FCurCol, scColor);
+ end;
+
+ FWorksheet.WriteBorders(FCurRow,FCurCol, [cbNorth, cbWest, cbEast, cbSouth]);
+ FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbNorth, scColorBlack);
+ FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbWest, scColorBlack);
+ FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbEast, scColorBlack);
+ FWorksheet.WriteBorderColor(FCurRow,FCurCol, cbSouth, scColorBlack);
+
+ FWorksheet.WriteHorAlignment(FCurRow, FCurCol, ssAligns[C.Alignment]);
+ inc(FCurCol);
+ end;
+ end;
+ inc(FCurRow);
+ FDataSet.Next;
+ end;
+end;
+
+procedure TRxDBGridExportSpreadSheet.DoExportFooter;
+begin
+
+end;
+
+procedure TRxDBGridExportSpreadSheet.DoExportColWidth;
+var
+ FW:integer;
+ C:TRxColumn;
+ i: Integer;
+begin
+ FW:=FRxDBGrid.Canvas.TextWidth('W');
+ FCurCol:=0;
+ for i:=0 to FRxDBGrid.Columns.Count - 1 do
+ begin
+ C:=FRxDBGrid.Columns[i] as TRxColumn;
+ if C.Visible then
+ begin
+ FWorksheet.WriteColWidth(FCurCol, Max(C.Width div FW, 20));
+ inc(FCurCol);
+ end;
+ end;
+end;
+
+
+constructor TRxDBGridExportSpreadSheet.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FCaption:=sToolsExportSpeadSheet;
+end;
+
+function TRxDBGridExportSpreadSheet.DoExecTools: boolean;
+var
+ P:TBookMark;
+begin
+ Result:=false;
+ if (not Assigned(FRxDBGrid)) or (not Assigned(FRxDBGrid.DataSource)) or (not Assigned(FRxDBGrid.DataSource.DataSet)) then
+ exit;
+ FDataSet:=FRxDBGrid.DataSource.DataSet;
+ FDataSet.DisableControls;
+ P:=FDataSet.Bookmark;
+
+ FWorkbook := TsWorkbook.Create;
+ FWorksheet := FWorkbook.AddWorksheet(FPageName);
+ try
+ scColorBlack:=FWorkbook.AddColorToPalette(FRxDBGrid.GridLineColor);
+ FCurRow:=0;
+
+ if ressExportTitle in FOptions then
+ DoExportTitle;
+ DoExportBody;
+
+ if ressExportFooter in FOptions then
+ DoExportFooter;
+
+ DoExportColWidth;
+
+ FWorkbook.WriteToFile(UTF8ToSys(FileName), true);
+ Result:=true;
+ finally
+ FWorkbook.Free;
+ FDataSet.Bookmark:=P;
+ FDataSet.EnableControls;
+ end;
+end;
+
+end.
diff --git a/components/rx/trunk/rxdconst.pas b/components/rx/trunk/rxdconst.pas
index 7a813f4c0..101a25b3d 100644
--- a/components/rx/trunk/rxdconst.pas
+++ b/components/rx/trunk/rxdconst.pas
@@ -172,6 +172,8 @@ resourcestring
sUnknownXMLDatasetFormat = 'Unknown XML Dataset format';
+ sToolsExportSpeadSheet = 'Export to speadsheet';
+
const
{ The following strings should not be localized }
sAction = '.Action';
@@ -192,6 +194,7 @@ const
sSortMarker = '.SortMarker';
sSortField = '.SortField';
+
implementation