1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
|
{
**********************************************************************
This file is part of the Free Pascal run time library.
See the file COPYING.FPC, included in this distribution,
for details about the license.
**********************************************************************
Registration of components and property editors for dbexport package.
Copyright (c) 2007 by Michael Van Canneyt, member of the Free Pascal development team
}
unit regdbexport;
{$mode objfpc}{$H+}
{$IF FPC_FULLVERSION > 20500}
// XMLXSDExport unit was introduced in FPC 2.5.1.
{$DEFINE HASXMLXSDEXPORT}
{$ENDIF}
interface
uses
Classes, SysUtils, lresources, dbPropEdits, propedits,
componenteditors, fpdataexporter, dialogs, sdb_consts;
Type
{ TExportFieldProperty }
TExportFieldProperty = class(TFieldProperty)
Public
procedure FillValues(const Values: TStringList); override;
end;
{ TDataExporterComponentEditor }
TDataExporterComponentEditor = class(TComponentEditor)
private
procedure ExecuteExporter(Ex: TFPDataExporter);
public
function GetVerbCount: Integer; override;
function GetVerb(Index: Integer): string; override;
procedure ExecuteVerb(Index: Integer); override;
end;
Procedure Register;
implementation
{$R dbexportimg.res}
uses
fpdbexport,
fpstdExports,
fpcsvexport,
fpfixedexport,
fpsimplexmlexport,
fpsimplejsonexport,
fptexexport,
fpsqlexport,
fprtfexport,
fpdbfexport
{$IFDEF HASXMLXSDEXPORT}
,fpxmlxsdexport
{$ENDIF}
;
{ TDataExporterComponentEditor }
function TDataExporterComponentEditor.GetVerbCount: Integer;
begin
Result:=1;
end;
function TDataExporterComponentEditor.GetVerb(Index: Integer): string;
begin
Case Index of
0: Result:=SExecute;
else
Result:=Inherited GetVerb(Index)
end;
end;
procedure TDataExporterComponentEditor.ExecuteExporter(Ex : TFPDataExporter);
Var
B: Boolean;
begin
If Assigned(Ex) then
If Not Assigned(Ex.Dataset) then
ShowMessage(SErrNoDatasetAssigned)
else
begin
B:=Not Ex.Dataset.Active;
If B then
Try
Ex.Dataset.Open;
except
On E : Exception do
begin
ShowMessage(Format(SErrOpeningDataset,[E.Message]));
Exit;
end;
end;
Try
Ex.Execute;
Finally
If B then Ex.Dataset.Close;
end;
end;
end;
procedure TDataExporterComponentEditor.ExecuteVerb(Index: Integer);
begin
Case Index of
0 : ExecuteExporter(GetComponent as TFPDataExporter);
else
Inherited
end
end;
{ TExportFieldProperty }
procedure TExportFieldProperty.FillValues(const Values: TStringList);
Var
FI : TExportFieldItem;
begin
FI:=TExportFieldItem(GetComponent(0));
If Assigned(FI.Exporter) and Assigned(FI.Exporter.Dataset) then
FI.Exporter.Dataset.GetFieldNames(Values);
end;
Procedure Register;
begin
RegisterStdFormats;
{ RegisterFixedExportFormat;
RegisterSQLExportFormat;
RegisterSimpleXMLExportFormat;
RegisterSimpleJSONExportFormat;
RegisterDBFExportFormat;
RegisterTexExportFormat;
RegisterRTFExportFormat;
Register}
RegisterComponents('Data Export',[TCSVExporter,
TFixedLengthExporter,
TSQLExporter,
{$IFDEF HASXMLXSDEXPORT}
TXMLXSDExporter,
{$ENDIF}
TSimpleXMLExporter,
TSimpleJSONExporter,
TFPDBFExport,
TTexExporter,
TRTFExporter,
TStandardExportFormats,
TFPDataExporter]);
RegisterPropertyEditor(TypeInfo(string), TExportFieldItem, 'FieldName', TExportFieldProperty);
RegisterComponentEditor(TFPDataExporter,TDataExporterComponentEditor) ;
end;
end.
|
