1 {
2 /***************************************************************************
3 lazxmlforms.pas
4 ------------------
5
6 ***************************************************************************/
7
8 ***************************************************************************
9 * *
10 * This source is free software; you can redistribute it and/or modify *
11 * it under the terms of the GNU General Public License as published by *
12 * the Free Software Foundation; either version 2 of the License, or *
13 * (at your option) any later version. *
14 * *
15 * This code is distributed in the hope that it will be useful, but *
16 * WITHOUT ANY WARRANTY; without even the implied warranty of *
17 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
18 * General Public License for more details. *
19 * *
20 * A copy of the GNU General Public License is available on the World *
21 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
22 * obtain it by writing to the Free Software Foundation, *
23 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
24 * *
25 ***************************************************************************
26
27 Author: Mattias Gaertner
28
29 Abstract:
30 Functions to convert forms to/from xml.
31 }
32 unit LazXMLForms;
33
34 {$mode objfpc}{$H+}
35
36 interface
37
38 uses
39 Classes, SysUtils, LCLProc,
40 laz2_DOM, Laz2_XMLCfg, Laz_XMLStreaming;
41
CreateXMLWriternull42 function CreateXMLWriter(ADoc: TDOMDocument; const Path: string;
43 Append: Boolean; var DestroyDriver: boolean): TWriter;
CreateXMLReadernull44 function CreateXMLReader(ADoc: TDOMDocument; const Path: string;
45 var DestroyDriver: boolean): TReader;
46
47 procedure WriteComponentToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
48 AComponent: TComponent);
49 procedure ReadComponentFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
50 var RootComponent: TComponent;
51 OnFindComponentClass: TFindComponentClassEvent; TheOwner: TComponent);
52
53 implementation
54
CreateXMLWriternull55 function CreateXMLWriter(ADoc: TDOMDocument; const Path: string;
56 Append: Boolean; var DestroyDriver: boolean): TWriter;
57 var
58 Driver: TAbstractObjectWriter;
59 begin
60 Driver:=TXMLObjectWriter.Create(ADoc,Path,Append);
61 DestroyDriver:=true;
62 Result:=TWriter.Create(Driver);
63 end;
64
CreateXMLReadernull65 function CreateXMLReader(ADoc: TDOMDocument; const Path: string;
66 var DestroyDriver: boolean): TReader;
67 var
68 p: Pointer;
69 Driver: TAbstractObjectReader;
70 DummyStream: TMemoryStream;
71 begin
72 DummyStream:=TMemoryStream.Create;
73 try
74 Result:=TReader.Create(DummyStream,256);
75 DestroyDriver:=false;
76 // hack to set a write protected variable.
77 // DestroyDriver:=true; TReader will free it
78 Driver:=TXMLObjectReader.Create(ADoc,Path);
79 p:=@Result.Driver;
80 Result.Driver.Free;
81 TAbstractObjectReader(p^):=Driver;
82 finally
83 DummyStream:=nil;
84 end;
85 end;
86
87 procedure WriteComponentToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
88 AComponent: TComponent);
89 var
90 Writer: TWriter;
91 DestroyDriver: boolean;
92 begin
93 Writer:=nil;
94 DestroyDriver:=false;
95 try
96 Writer:=CreateXMLWriter(XMLConfig.Document,Path,false,DestroyDriver);
97 XMLConfig.Modified:=true;
98 Writer.WriteRootComponent(AComponent);
99 XMLConfig.Flush;
100 finally
101 if DestroyDriver then
102 Writer.Driver.Free;
103 Writer.Free;
104 end;
105 end;
106
107 procedure ReadComponentFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
108 var RootComponent: TComponent;
109 OnFindComponentClass: TFindComponentClassEvent; TheOwner: TComponent);
110 var
111 DestroyDriver: Boolean;
112 Reader: TReader;
113 IsInherited: Boolean;
114 AClassName: String;
115 AClass: TComponentClass;
116 begin
117 Reader:=nil;
118 DestroyDriver:=false;
119 try
120 Reader:=CreateXMLReader(XMLConfig.Document,Path,DestroyDriver);
121 Reader.OnFindComponentClass:=OnFindComponentClass;
122
123 // get root class
124 AClassName:=(Reader.Driver as TXMLObjectReader).GetRootClassName(IsInherited);
125 if IsInherited then begin
126 // inherited is not supported by this simple function
DebugLnnull127 DebugLn('ReadComponentFromXMLConfig WARNING: "inherited" is not supported by this simple function');
128 end;
129 AClass:=nil;
130 OnFindComponentClass(nil,AClassName,AClass);
131 if AClass=nil then
132 raise EClassNotFound.CreateFmt('Class "%s" not found', [AClassName]);
133
134 if RootComponent=nil then begin
135 // create root component
136 // first create the new instance and set the variable ...
137 RootComponent:=AClass.NewInstance as TComponent;
138 // then call the constructor
139 RootComponent.Create(TheOwner);
140 end else begin
141 // there is a root component, check if class is compatible
142 if not RootComponent.InheritsFrom(AClass) then begin
143 raise EComponentError.CreateFmt('Cannot assign a %s to a %s.',
144 [AClassName,RootComponent.ClassName]);
145 end;
146 end;
147
148 Reader.ReadRootComponent(RootComponent);
149 finally
150 if DestroyDriver then
151 Reader.Driver.Free;
152 Reader.Free;
153 end;
154 end;
155
156 end.
157
158