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

RxFPC - new component TRxDBGridExportSpreadSheet. Create new lazarus package rxdbgrid_export_spreadsheet.lpk and demo RxDBGrid_ExportSpreadsheet for this component

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3363 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alexs75
2014-07-23 11:40:36 +00:00
parent 40e2a85bd1
commit b59a58473d
16 changed files with 1026 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

89
components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.lpi Normal file
View File

@ -0,0 +1,89 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="project1"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="4">
<Item1>
<PackageName Value="rxdbgrid_export_spreadsheet"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
</Item2>
<Item3>
<PackageName Value="rxnew"/>
</Item3>
<Item4>
<PackageName Value="LCL"/>
</Item4>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

21
components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.lpr Normal file
View File

@ -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.

132
components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.lps Normal file
View File

@ -0,0 +1,132 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<Version Value="9"/>
<BuildModes Active="Default"/>
<Units Count="4">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="20"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<IsVisibleTab Value="True"/>
<TopLine Value="43"/>
<CursorPos X="29" Y="81"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../../fpspreadsheet/fpspreadsheet.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="4364"/>
<CursorPos Y="4385"/>
<UsageCount Value="10"/>
</Unit2>
<Unit3>
<Filename Value="unit1.lfm"/>
<EditorIndex Value="-1"/>
<TopLine Value="223"/>
<CursorPos X="56" Y="250"/>
<UsageCount Value="10"/>
<DefaultSyntaxHighlighter Value="LFM"/>
</Unit3>
</Units>
<JumpHistory Count="21" HistoryIndex="20">
<Position1>
<Filename Value="unit1.pas"/>
</Position1>
<Position2>
<Filename Value="unit1.pas"/>
<Caret Line="15" Column="27"/>
</Position2>
<Position3>
<Filename Value="unit1.pas"/>
<Caret Line="16" Column="33"/>
</Position3>
<Position4>
<Filename Value="unit1.pas"/>
<Caret Line="52" Column="22" TopLine="11"/>
</Position4>
<Position5>
<Filename Value="unit1.pas"/>
<Caret Line="53" Column="22" TopLine="11"/>
</Position5>
<Position6>
<Filename Value="unit1.pas"/>
<Caret Line="54" Column="22" TopLine="12"/>
</Position6>
<Position7>
<Filename Value="unit1.pas"/>
<Caret Line="55" Column="22" TopLine="13"/>
</Position7>
<Position8>
<Filename Value="unit1.pas"/>
<Caret Line="57" Column="22" TopLine="15"/>
</Position8>
<Position9>
<Filename Value="unit1.pas"/>
<Caret Line="53" Column="50" TopLine="22"/>
</Position9>
<Position10>
<Filename Value="unit1.pas"/>
<Caret Line="69" Column="57" TopLine="30"/>
</Position10>
<Position11>
<Filename Value="unit1.pas"/>
<Caret Line="67" Column="40" TopLine="36"/>
</Position11>
<Position12>
<Filename Value="unit1.pas"/>
<Caret Line="52" Column="59" TopLine="32"/>
</Position12>
<Position13>
<Filename Value="unit1.pas"/>
<Caret Line="48" Column="49" TopLine="8"/>
</Position13>
<Position14>
<Filename Value="unit1.pas"/>
<Caret Line="8" Column="75" TopLine="8"/>
</Position14>
<Position15>
<Filename Value="unit1.pas"/>
<Caret Line="23" Column="22" TopLine="8"/>
</Position15>
<Position16>
<Filename Value="unit1.pas"/>
<Caret Line="22" Column="26" TopLine="8"/>
</Position16>
<Position17>
<Filename Value="unit1.pas"/>
<Caret Line="23" Column="60" TopLine="8"/>
</Position17>
<Position18>
<Filename Value="unit1.pas"/>
<Caret Line="83" TopLine="48"/>
</Position18>
<Position19>
<Filename Value="unit1.pas"/>
<Caret Line="77" TopLine="43"/>
</Position19>
<Position20>
<Filename Value="unit1.pas"/>
<Caret Line="67" TopLine="43"/>
</Position20>
<Position21>
<Filename Value="unit1.pas"/>
<Caret Line="72" Column="35" TopLine="43"/>
</Position21>
</JumpHistory>
</ProjectSession>
</CONFIG>

BIN
components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/project1.res Normal file
View File

Binary file not shown.

265
components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/unit1.lfm Normal file
View File

@ -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

85
components/rx/trunk/Demos/RxDBGrid_ExportSpreadsheet/unit1.pas Normal file
View File

@ -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.

4
components/rx/trunk/languages/rxdconst.es.po
View File

@ -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"

4
components/rx/trunk/languages/rxdconst.po
View File

@ -443,6 +443,10 @@ msgstr ""
msgid "find"
msgstr ""
#: rxdconst.stoolsexportspeadsheet
msgid "Export to speadsheet"
msgstr ""
#: rxdconst.sunknownfieldtype
msgid "SUnknownFieldType %s"
msgstr ""

12
components/rx/trunk/languages/rxdconst.ru.po
View File

@ -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"

4
components/rx/trunk/languages/rxdconst.uk.po
View File

@ -454,6 +454,10 @@ msgstr "Помилка сервера"
msgid "find"
msgstr "Пошук"
#: rxdconst.stoolsexportspeadsheet
msgid "Export to speadsheet"
msgstr ""
#: rxdconst.sunknownfieldtype
msgid "SUnknownFieldType %s"
msgstr "Не визначений тип даних для поля %s"

99
components/rx/trunk/rxdbgrid.pas
View File

@ -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);

38
components/rx/trunk/rxdbgrid_export_spreadsheet.lpk Normal file
View File

@ -0,0 +1,38 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<Package Version="4">
<Name Value="rxdbgrid_export_spreadsheet"/>
<CompilerOptions>
<Version Value="11"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Version Minor="1" Release="1" Build="1"/>
<Files Count="1">
<Item1>
<Filename Value="rxdbgridexportspreadsheet.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="RxDBGridExportSpreadSheet"/>
</Item1>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3">
<Item1>
<PackageName Value="laz_fpspreadsheet"/>
</Item1>
<Item2>
<PackageName Value="rxnew"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
</Item3>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
</Package>
</CONFIG>

22
components/rx/trunk/rxdbgrid_export_spreadsheet.pas Normal file
View File

@ -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.

253
components/rx/trunk/rxdbgridexportspreadsheet.pas Normal file
View File

@ -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.

3
components/rx/trunk/rxdconst.pas
View File

@ -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