mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 12:59:26 +02:00
implemented saving form as xml
git-svn-id: trunk@9172 -
This commit is contained in:
mattias
parent
92afac14f1
commit
81729dd840
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -499,6 +499,7 @@ converter/delphiproject2laz.pas svneol=native#text/plain
|
||||
converter/delphiunit2laz.lfm svneol=native#text/plain
|
||||
converter/delphiunit2laz.lrs svneol=native#text/pascal
|
||||
converter/delphiunit2laz.pas svneol=native#text/pascal
|
||||
converter/lazxmlforms.pas svneol=native#text/plain
|
||||
debian/README.Debian svneol=native#text/plain
|
||||
debian/changelog svneol=native#text/plain
|
||||
debian/compat svneol=native#text/plain
|
||||
|
||||
@ -451,17 +451,17 @@ function TXMLObjectReader.ReadNextValue(Stay: Boolean): TValueType;
|
||||
FElementPosition:=0;
|
||||
if FElement.NextSibling is TDOMElement then begin
|
||||
// go to next component
|
||||
writeln('TXMLObjectReader.ReadNextValue properties: next component');
|
||||
//writeln('TXMLObjectReader.ReadNextValue properties: next component');
|
||||
FElement:=TDOMElement(FElement.NextSibling);
|
||||
CheckNode('component');
|
||||
end else begin
|
||||
// end of children list
|
||||
if FElement.ParentNode.NodeName='children' then begin
|
||||
writeln('TXMLObjectReader.ReadNextValue end of children list');
|
||||
//writeln('TXMLObjectReader.ReadNextValue end of children list');
|
||||
FElement:=FElement.ParentNode as TDOMElement;
|
||||
FElementPosition:=1;
|
||||
end else begin
|
||||
writeln('TXMLObjectReader.ReadNextValue END reading');
|
||||
//writeln('TXMLObjectReader.ReadNextValue END reading');
|
||||
FElement:=nil;
|
||||
end;
|
||||
end;
|
||||
@ -471,10 +471,10 @@ var
|
||||
CurValue: String;
|
||||
CurInt64: Int64;
|
||||
begin
|
||||
writeln('TXMLObjectReader.ReadNextValue Stay=',Stay,' Element=',FElement.NodeName,' Pos=',FElementPosition);
|
||||
//writeln('TXMLObjectReader.ReadNextValue Stay=',Stay,' Element=',FElement.NodeName,' Pos=',FElementPosition);
|
||||
|
||||
if FElement.NodeName='component' then begin
|
||||
writeln('TXMLObjectReader.ReadNextValue is start of component');
|
||||
//writeln('TXMLObjectReader.ReadNextValue is start of component');
|
||||
Result:=vaString;
|
||||
if not Stay then begin
|
||||
// here a BeginComponent shoud be called, not ReadValue
|
||||
@ -485,12 +485,12 @@ begin
|
||||
// FElement is at end of property list or non existing children list
|
||||
// 0: end of property list
|
||||
// 1: end of non existing children list
|
||||
writeln('TXMLObjectReader.ReadNextValue FElement is at end of property list');
|
||||
//writeln('TXMLObjectReader.ReadNextValue FElement is at end of property list');
|
||||
Result:=vaNull;
|
||||
if not Stay then begin
|
||||
if FElement.NextSibling is TDOMElement then begin
|
||||
// leave properties and go to first child component
|
||||
writeln('TXMLObjectReader.ReadNextValue properties: children');
|
||||
//writeln('TXMLObjectReader.ReadNextValue properties: children');
|
||||
FElement:=TDOMElement(FElement.NextSibling);
|
||||
FElementPosition:=0;
|
||||
CheckNode('children');
|
||||
@ -510,7 +510,7 @@ begin
|
||||
end
|
||||
else if FElement.NodeName='children' then begin
|
||||
// end of children list
|
||||
writeln('TXMLObjectReader.ReadNextValue End of children list');
|
||||
//writeln('TXMLObjectReader.ReadNextValue End of children list');
|
||||
Result:=vaNull;
|
||||
if not Stay then begin
|
||||
GoToNextComponent;
|
||||
@ -524,7 +524,7 @@ begin
|
||||
case FElementPosition of
|
||||
|
||||
0:begin
|
||||
writeln('TXMLObjectReader.ReadNextValue list: vaList');
|
||||
//writeln('TXMLObjectReader.ReadNextValue list: vaList');
|
||||
Result:=vaList;
|
||||
if (FElement.FirstChild is TDOMElement) then begin
|
||||
// the list has childs
|
||||
@ -544,11 +544,11 @@ begin
|
||||
Result:=vaNull;
|
||||
if not Stay then begin
|
||||
if (FElement.NextSibling is TDOMElement) then begin
|
||||
writeln('TXMLObjectReader.ReadNextValue list: end of childs, next list');
|
||||
//writeln('TXMLObjectReader.ReadNextValue list: end of childs, next list');
|
||||
FElement:=TDOMElement(FElement.NextSibling);
|
||||
FElementPosition:=0;
|
||||
end else begin
|
||||
writeln('TXMLObjectReader.ReadNextValue list: end of childs, end of collection');
|
||||
//writeln('TXMLObjectReader.ReadNextValue list: end of childs, end of collection');
|
||||
FElement:=FElement.ParentNode as TDOMElement;
|
||||
FElementPosition:=0;
|
||||
end;
|
||||
@ -559,7 +559,7 @@ begin
|
||||
end
|
||||
else if FElement.NodeName='collection' then begin
|
||||
// FElement is at end of collection
|
||||
writeln('TXMLObjectReader.ReadNextValue FElement is at end of collection');
|
||||
//writeln('TXMLObjectReader.ReadNextValue FElement is at end of collection');
|
||||
Result:=vaNull;
|
||||
end
|
||||
else if (FElement.ParentNode.NodeName='properties')
|
||||
@ -660,7 +660,7 @@ begin
|
||||
end else begin
|
||||
RaiseUnknownParentNode(FElement.ParentNode);
|
||||
end;
|
||||
writeln('TXMLObjectReader.ReadNextValue Result=',GetEnumName(TypeInfo(TValueType),ord(Result)));
|
||||
//writeln('TXMLObjectReader.ReadNextValue Result=',GetEnumName(TypeInfo(TValueType),ord(Result)));
|
||||
end;
|
||||
|
||||
constructor TXMLObjectReader.Create(ADoc: TDOMDocument; const APath: string);
|
||||
@ -758,7 +758,7 @@ procedure TXMLObjectReader.BeginRootComponent;
|
||||
var
|
||||
Node: TDOMNode;
|
||||
begin
|
||||
writeln('TXMLObjectReader.BeginRootComponent ');
|
||||
//writeln('TXMLObjectReader.BeginRootComponent ');
|
||||
Node:=FElement.FindNode('component');
|
||||
if Node=nil then
|
||||
RaiseComponentNodeNotFound;
|
||||
@ -770,7 +770,7 @@ var
|
||||
ComponentNode: TDOMNode;
|
||||
PropertiesNode: TDOMNode;
|
||||
begin
|
||||
writeln('TXMLObjectReader.BeginComponent START');
|
||||
//writeln('TXMLObjectReader.BeginComponent START');
|
||||
|
||||
if FElement.NodeName='component' then
|
||||
ComponentNode:=FElement
|
||||
@ -802,13 +802,13 @@ end;
|
||||
function TXMLObjectReader.BeginProperty: String;
|
||||
begin
|
||||
Result:=FElement['name'];
|
||||
writeln('TXMLObjectReader.BeginProperty Result="',Result,'"');
|
||||
//writeln('TXMLObjectReader.BeginProperty Result="',Result,'"');
|
||||
inc(FElementPosition);
|
||||
end;
|
||||
|
||||
procedure TXMLObjectReader.ReadBinary(const DestData: TMemoryStream);
|
||||
begin
|
||||
writeln('TXMLObjectReader.ReadBinary ');
|
||||
//writeln('TXMLObjectReader.ReadBinary ');
|
||||
end;
|
||||
|
||||
function TXMLObjectReader.ReadFloat: Extended;
|
||||
@ -822,7 +822,7 @@ begin
|
||||
Val(Value, Back, FloatError);
|
||||
Result:=Back;
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.ReadFloat ',Result);
|
||||
//writeln('TXMLObjectReader.ReadFloat ',Result);
|
||||
end;
|
||||
|
||||
function TXMLObjectReader.ReadSingle: Single;
|
||||
@ -836,7 +836,7 @@ begin
|
||||
Val(Value, Back, FloatError);
|
||||
Result:=Back;
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.ReadSingle ',Result);
|
||||
//writeln('TXMLObjectReader.ReadSingle ',Result);
|
||||
end;
|
||||
|
||||
function TXMLObjectReader.ReadCurrency: Currency;
|
||||
@ -850,7 +850,7 @@ begin
|
||||
Val(Value, Back, FloatError);
|
||||
Result:=Back;
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.ReadCurrency ',Result);
|
||||
//writeln('TXMLObjectReader.ReadCurrency ',Result);
|
||||
end;
|
||||
|
||||
function TXMLObjectReader.ReadDate: TDateTime;
|
||||
@ -864,14 +864,14 @@ begin
|
||||
Val(Value, Back, FloatError);
|
||||
Result:=Back;
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.ReadDate ',Result);
|
||||
//writeln('TXMLObjectReader.ReadDate ',Result);
|
||||
end;
|
||||
|
||||
function TXMLObjectReader.ReadIdent(ValueType: TValueType): String;
|
||||
begin
|
||||
Result:=FElement['value'];
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.ReadIdent ',Result);
|
||||
//writeln('TXMLObjectReader.ReadIdent ',Result);
|
||||
end;
|
||||
|
||||
function TXMLObjectReader.ReadInt8: ShortInt;
|
||||
@ -885,7 +885,7 @@ begin
|
||||
Val(Value, Back, FloatError);
|
||||
Result:=Back;
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.ReadInt8 ',Result);
|
||||
//writeln('TXMLObjectReader.ReadInt8 ',Result);
|
||||
end;
|
||||
|
||||
function TXMLObjectReader.ReadInt16: SmallInt;
|
||||
@ -899,7 +899,7 @@ begin
|
||||
Val(Value, Back, FloatError);
|
||||
Result:=Back;
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.ReadInt16 ',Result);
|
||||
//writeln('TXMLObjectReader.ReadInt16 ',Result);
|
||||
end;
|
||||
|
||||
function TXMLObjectReader.ReadInt32: LongInt;
|
||||
@ -913,7 +913,7 @@ begin
|
||||
Val(Value, Back, FloatError);
|
||||
Result:=Back;
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.ReadInt32 ',Result);
|
||||
//writeln('TXMLObjectReader.ReadInt32 ',Result);
|
||||
end;
|
||||
|
||||
function TXMLObjectReader.ReadInt64: Int64;
|
||||
@ -927,7 +927,7 @@ begin
|
||||
Val(Value, Back, FloatError);
|
||||
Result:=Back;
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.ReadInt64 ',Result);
|
||||
//writeln('TXMLObjectReader.ReadInt64 ',Result);
|
||||
end;
|
||||
|
||||
function TXMLObjectReader.ReadSet(SetType: Pointer): Integer;
|
||||
@ -952,14 +952,14 @@ begin
|
||||
StartPos:=EndPos+1;
|
||||
end;
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.ReadSet ',HexStr(Cardinal(Result),8));
|
||||
//writeln('TXMLObjectReader.ReadSet ',HexStr(Cardinal(Result),8));
|
||||
end;
|
||||
|
||||
function TXMLObjectReader.ReadStr: String;
|
||||
begin
|
||||
Result:=FElement['value'];
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.ReadStr "',Result,'"');
|
||||
//writeln('TXMLObjectReader.ReadStr "',Result,'"');
|
||||
end;
|
||||
|
||||
function TXMLObjectReader.ReadString(StringType: TValueType): String;
|
||||
@ -968,7 +968,7 @@ begin
|
||||
if (StringType=vaString) and (length(Result)>255) then
|
||||
raise Exception.Create('TXMLObjectReader.ReadString invalid StringType');
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.ReadString "',Result,'"');
|
||||
//writeln('TXMLObjectReader.ReadString "',Result,'"');
|
||||
end;
|
||||
|
||||
function TXMLObjectReader.ReadWideString: WideString;
|
||||
@ -978,7 +978,7 @@ begin
|
||||
ValueAsUTF8:=FElement['value'];
|
||||
Result:=System.UTF8Decode(ValueAsUTF8);
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.ReadWideString "',ValueAsUTF8,'"');
|
||||
//writeln('TXMLObjectReader.ReadWideString "',ValueAsUTF8,'"');
|
||||
end;
|
||||
|
||||
procedure TXMLObjectReader.SkipComponent(SkipComponentInfos: Boolean);
|
||||
@ -988,13 +988,13 @@ begin
|
||||
NextNode:=FElement.NextSibling;
|
||||
if (NextNode=nil) or (NextNode is TDOMElement) then
|
||||
FElement:=TDOMElement(NextNode);
|
||||
writeln('TXMLObjectReader.SkipComponent ');
|
||||
//writeln('TXMLObjectReader.SkipComponent ');
|
||||
end;
|
||||
|
||||
procedure TXMLObjectReader.SkipValue;
|
||||
begin
|
||||
ReadValue;
|
||||
writeln('TXMLObjectReader.SkipValue ');
|
||||
//writeln('TXMLObjectReader.SkipValue ');
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
156
converter/lazxmlforms.pas
Normal file
156
converter/lazxmlforms.pas
Normal file
@ -0,0 +1,156 @@
|
||||
{
|
||||
/***************************************************************************
|
||||
lazxmlforms.pas
|
||||
------------------
|
||||
|
||||
***************************************************************************/
|
||||
|
||||
***************************************************************************
|
||||
* *
|
||||
* This source is free software; you can redistribute it and/or modify *
|
||||
* it under the terms of the GNU General Public License as published by *
|
||||
* the Free Software Foundation; either version 2 of the License, or *
|
||||
* (at your option) any later version. *
|
||||
* *
|
||||
* This code is distributed in the hope that it will be useful, but *
|
||||
* WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
|
||||
* General Public License for more details. *
|
||||
* *
|
||||
* A copy of the GNU General Public License is available on the World *
|
||||
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
|
||||
* obtain it by writing to the Free Software Foundation, *
|
||||
* Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
|
||||
* *
|
||||
***************************************************************************
|
||||
|
||||
Author: Mattias Gaertner
|
||||
|
||||
Abstract:
|
||||
Functions to convert forms to/from xml.
|
||||
}
|
||||
unit LazXMLForms;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLProc, Laz_XMLStreaming, Laz_DOM, Laz_XMLCfg;
|
||||
|
||||
function CreateXMLWriter(ADoc: TDOMDocument; const Path: string;
|
||||
Append: Boolean; var DestroyDriver: boolean): TWriter;
|
||||
function CreateXMLReader(ADoc: TDOMDocument; const Path: string;
|
||||
var DestroyDriver: boolean): TReader;
|
||||
|
||||
procedure WriteComponentToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
AComponent: TComponent);
|
||||
procedure ReadComponentFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
var RootComponent: TComponent;
|
||||
OnFindComponentClass: TFindComponentClassEvent; TheOwner: TComponent);
|
||||
|
||||
implementation
|
||||
|
||||
function CreateXMLWriter(ADoc: TDOMDocument; const Path: string;
|
||||
Append: Boolean; var DestroyDriver: boolean): TWriter;
|
||||
var
|
||||
Driver: TAbstractObjectWriter;
|
||||
begin
|
||||
Driver:=TXMLObjectWriter.Create(ADoc,Path,Append);
|
||||
DestroyDriver:=true;
|
||||
Result:=TWriter.Create(Driver);
|
||||
end;
|
||||
|
||||
function CreateXMLReader(ADoc: TDOMDocument; const Path: string;
|
||||
var DestroyDriver: boolean): TReader;
|
||||
var
|
||||
p: Pointer;
|
||||
Driver: TAbstractObjectReader;
|
||||
DummyStream: TMemoryStream;
|
||||
begin
|
||||
DummyStream:=TMemoryStream.Create;
|
||||
try
|
||||
Result:=TReader.Create(DummyStream,256);
|
||||
DestroyDriver:=false;
|
||||
// hack to set a write protected variable.
|
||||
// DestroyDriver:=true; TReader will free it
|
||||
Driver:=TXMLObjectReader.Create(ADoc,Path);
|
||||
p:=@Result.Driver;
|
||||
Result.Driver.Free;
|
||||
TAbstractObjectReader(p^):=Driver;
|
||||
finally
|
||||
DummyStream:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure WriteComponentToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
AComponent: TComponent);
|
||||
var
|
||||
Writer: TWriter;
|
||||
DestroyDriver: boolean;
|
||||
begin
|
||||
Writer:=nil;
|
||||
DestroyDriver:=false;
|
||||
try
|
||||
Writer:=CreateXMLWriter(XMLConfig.Document,Path,false,DestroyDriver);
|
||||
XMLConfig.Modified:=true;
|
||||
Writer.WriteRootComponent(AComponent);
|
||||
XMLConfig.Flush;
|
||||
finally
|
||||
if DestroyDriver then
|
||||
Writer.Driver.Free;
|
||||
Writer.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure ReadComponentFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
var RootComponent: TComponent;
|
||||
OnFindComponentClass: TFindComponentClassEvent; TheOwner: TComponent);
|
||||
var
|
||||
DestroyDriver: Boolean;
|
||||
Reader: TReader;
|
||||
IsInherited: Boolean;
|
||||
AClassName: String;
|
||||
AClass: TComponentClass;
|
||||
begin
|
||||
Reader:=nil;
|
||||
DestroyDriver:=false;
|
||||
try
|
||||
Reader:=CreateXMLReader(XMLConfig.Document,Path,DestroyDriver);
|
||||
Reader.OnFindComponentClass:=OnFindComponentClass;
|
||||
|
||||
// get root class
|
||||
AClassName:=(Reader.Driver as TXMLObjectReader).GetRootClassName(IsInherited);
|
||||
if IsInherited then begin
|
||||
// inherited is not supported by this simple function
|
||||
DebugLn('ReadComponentFromXMLConfig WARNING: "inherited" is not supported by this simple function');
|
||||
end;
|
||||
AClass:=nil;
|
||||
OnFindComponentClass(nil,AClassName,AClass);
|
||||
if AClass=nil then
|
||||
raise EClassNotFound.CreateFmt('Class "%s" not found', [AClassName]);
|
||||
|
||||
if RootComponent=nil then begin
|
||||
// create root component
|
||||
// first create the new instance and set the variable ...
|
||||
RootComponent:=AClass.NewInstance as TComponent;
|
||||
// then call the constructor
|
||||
RootComponent.Create(TheOwner);
|
||||
end else begin
|
||||
// there is a root component, check if class is compatible
|
||||
if not RootComponent.InheritsFrom(AClass) then begin
|
||||
raise EComponentError.CreateFmt('Cannot assign a %s to a %s.',
|
||||
[AClassName,RootComponent.ClassName]);
|
||||
end;
|
||||
end;
|
||||
|
||||
Reader.ReadRootComponent(RootComponent);
|
||||
finally
|
||||
if DestroyDriver then
|
||||
Reader.Driver.Free;
|
||||
Reader.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -100,6 +100,7 @@ type
|
||||
FOnProcessCommand: TOnProcessCommand;
|
||||
FOnPropertiesChanged: TNotifyEvent;
|
||||
FOnRenameComponent: TOnRenameComponent;
|
||||
FOnSaveAsXML: TNotifyEvent;
|
||||
FOnSetDesigning: TOnSetDesigning;
|
||||
FOnShowOptions: TNotifyEvent;
|
||||
FOnUnselectComponentClass: TNotifyEvent;
|
||||
@ -120,6 +121,7 @@ type
|
||||
FTabOrderMenuItem: TMenuItem;
|
||||
FTheFormEditor: TCustomFormEditor;
|
||||
fViewLFMMenuItem: TMenuItem;
|
||||
fSaveAsXMLMenuItem: TMenuItem;
|
||||
|
||||
//hint stuff
|
||||
FHintTimer : TTimer;
|
||||
@ -221,6 +223,7 @@ type
|
||||
procedure OnShowOptionsMenuItemClick(Sender: TObject);
|
||||
procedure OnSnapToGuideLinesOptionMenuClick(Sender: TObject);
|
||||
procedure OnViewLFMMenuClick(Sender: TObject);
|
||||
procedure OnSaveAsXMLMenuClick(Sender: TObject);
|
||||
|
||||
// hook
|
||||
function GetPropertyEditorHook: TPropertyEditorHook; override;
|
||||
@ -317,6 +320,7 @@ type
|
||||
property OnShowOptions: TNotifyEvent
|
||||
read FOnShowOptions write FOnShowOptions;
|
||||
property OnViewLFM: TNotifyEvent read FOnViewLFM write FOnViewLFM;
|
||||
property OnSaveAsXML: TNotifyEvent read FOnSaveAsXML write FOnSaveAsXML;
|
||||
property ShowGrid: boolean read GetShowGrid write SetShowGrid;
|
||||
property ShowBorderSpacing: boolean read GetShowBorderSpacing write SetShowBorderSpacing;
|
||||
property ShowEditorHints: boolean
|
||||
@ -2067,6 +2071,11 @@ begin
|
||||
if Assigned(OnViewLFM) then OnViewLFM(Self);
|
||||
end;
|
||||
|
||||
procedure TDesigner.OnSaveAsXMLMenuClick(Sender: TObject);
|
||||
begin
|
||||
if Assigned(OnSaveAsXML) then OnSaveAsXML(Self);
|
||||
end;
|
||||
|
||||
procedure TDesigner.OnCopyMenuClick(Sender: TObject);
|
||||
begin
|
||||
CopySelection;
|
||||
@ -2672,6 +2681,13 @@ begin
|
||||
end;
|
||||
FPopupMenu.Items.Add(fViewLFMMenuItem);
|
||||
|
||||
fSaveAsXMLMenuItem:=TMenuItem.Create(FPopupMenu);
|
||||
with fSaveAsXMLMenuItem do begin
|
||||
Caption:= fdmSaveFormAsXML;
|
||||
OnClick:=@OnSaveAsXMLMenuClick;
|
||||
end;
|
||||
FPopupMenu.Items.Add(fSaveAsXMLMenuItem);
|
||||
|
||||
AddSeparator;
|
||||
|
||||
// options
|
||||
|
||||
@ -6,7 +6,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LCLProc, LResources, Forms, Controls, Graphics, Dialogs,
|
||||
StdCtrls, Laz_XMLStreaming, Laz_DOM, laz_xmlcfg, Buttons, TypInfo;
|
||||
StdCtrls, Laz_XMLStreaming, Laz_DOM, Laz_XMLCfg, Buttons, TypInfo;
|
||||
|
||||
type
|
||||
TMyEnum = (myEnum1, myEnum2, myEnum3);
|
||||
@ -87,7 +87,7 @@ function CreateXMLWriter(ADoc: TDOMDocument; const Path: string;
|
||||
Append: Boolean; var DestroyDriver: boolean): TWriter;
|
||||
function CreateXMLReader(ADoc: TDOMDocument; const Path: string;
|
||||
var DestroyDriver: boolean): TReader;
|
||||
|
||||
|
||||
procedure WriteComponentToXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
AComponent: TComponent);
|
||||
procedure ReadComponentFromXMLConfig(XMLConfig: TXMLConfig; const Path: string;
|
||||
@ -188,7 +188,7 @@ begin
|
||||
[AClassName,RootComponent.ClassName]);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Reader.ReadRootComponent(RootComponent);
|
||||
finally
|
||||
if DestroyDriver then
|
||||
|
||||
@ -1297,6 +1297,7 @@ resourcestring
|
||||
lisChangeClass = 'Change Class';
|
||||
fdmSnapToGridOption='Option: Snap to grid';
|
||||
lisViewSourceLfm = 'View Source (.lfm)';
|
||||
fdmSaveFormAsXML = 'Save form as xml';
|
||||
fdmSnapToGuideLinesOption='Option: Snap to guide lines';
|
||||
fdmShowOptions='Show Options for form editing';
|
||||
|
||||
|
||||
68
ide/main.pp
68
ide/main.pp
@ -105,6 +105,8 @@ uses
|
||||
UnitEditor, CodeToolsOptions, IDEOptionDefs, CheckLFMDlg,
|
||||
CodeToolsDefines, DiffDialog, DiskDiffsDialog, UnitInfoDlg, EditorOptions,
|
||||
MsgQuickFixes, ViewUnit_dlg,
|
||||
// converter
|
||||
DelphiUnit2Laz, DelphiProject2Laz, LazXMLForms,
|
||||
// rest of the ide
|
||||
Splash, IDEDefs, LazarusIDEStrConsts, LazConf, MsgView, SearchResultView,
|
||||
CodeTemplatesDlg,
|
||||
@ -113,7 +115,7 @@ uses
|
||||
BuildLazDialog, MiscOptions, InputHistory, UnitDependencies, ClipBoardHistory,
|
||||
ProcessList, InitialSetupDlgs, NewDialog, MakeResStrDlg, ToDoList,
|
||||
DialogProcs, FindReplaceDialog, FindInFilesDlg, CodeExplorer, BuildFileDlg,
|
||||
ExtractProcDlg, FindRenameIdentifier, DelphiUnit2Laz, DelphiProject2Laz,
|
||||
ExtractProcDlg, FindRenameIdentifier,
|
||||
CleanDirDlg, CodeContextForm, AboutFrm,
|
||||
// main ide
|
||||
MainBar, MainIntf, MainBase;
|
||||
@ -384,6 +386,7 @@ type
|
||||
procedure OnDesignerRenameComponent(ADesigner: TDesigner;
|
||||
AComponent: TComponent; const NewName: string);
|
||||
procedure OnDesignerViewLFM(Sender: TObject);
|
||||
procedure OnDesignerSaveAsXML(Sender: TObject);
|
||||
|
||||
// control selection
|
||||
procedure OnControlSelectionChanged(Sender: TObject);
|
||||
@ -2678,6 +2681,7 @@ Begin
|
||||
OnShowOptions:=@OnDesignerShowOptions;
|
||||
OnUnselectComponentClass:=@OnDesignerUnselectComponentClass;
|
||||
OnViewLFM:=@OnDesignerViewLFM;
|
||||
OnSaveAsXML:=@OnDesignerSaveAsXML;
|
||||
ShowEditorHints:=EnvironmentOptions.ShowEditorHints;
|
||||
ShowComponentCaptionHints:=EnvironmentOptions.ShowComponentCaptions;
|
||||
end;
|
||||
@ -11723,6 +11727,68 @@ begin
|
||||
AnUnitInfo.EditorIndex+1,[]);
|
||||
end;
|
||||
|
||||
procedure TMainIDE.OnDesignerSaveAsXML(Sender: TObject);
|
||||
var
|
||||
SaveDialog: TSaveDialog;
|
||||
SaveAsFilename: String;
|
||||
SaveAsFileExt: String;
|
||||
PkgDefaultDirectory: String;
|
||||
Filename: String;
|
||||
XMLConfig: TXMLConfig;
|
||||
ADesigner: TDesigner;
|
||||
ASrcEdit: TSourceEditor;
|
||||
AnUnitInfo: TUnitInfo;
|
||||
begin
|
||||
ADesigner:=TDesigner(Sender);
|
||||
GetDesignerUnit(ADesigner,ASrcEdit,AnUnitInfo);
|
||||
debugln('TMainIDE.OnDesignerViewLFM ',AnUnitInfo.Filename);
|
||||
|
||||
SaveAsFileExt:='.xml';
|
||||
SaveAsFilename:=ChangeFileExt(AnUnitInfo.Filename,SaveAsFileExt);
|
||||
SaveDialog:=TSaveDialog.Create(nil);
|
||||
try
|
||||
InputHistories.ApplyFileDialogSettings(SaveDialog);
|
||||
SaveDialog.Title:=lisSaveSpace+SaveAsFilename+' (*'+SaveAsFileExt+')';
|
||||
SaveDialog.FileName:=SaveAsFilename+SaveAsFileExt;
|
||||
// if this is a project file, start in project directory
|
||||
if AnUnitInfo.IsPartOfProject and (not Project1.IsVirtual)
|
||||
and (not FileIsInPath(SaveDialog.InitialDir,Project1.ProjectDirectory)) then
|
||||
begin
|
||||
SaveDialog.InitialDir:=Project1.ProjectDirectory;
|
||||
end;
|
||||
// if this is a package file, then start in package directory
|
||||
PkgDefaultDirectory:=
|
||||
PkgBoss.GetDefaultSaveDirectoryForFile(AnUnitInfo.Filename);
|
||||
if (PkgDefaultDirectory<>'')
|
||||
and (not FileIsInPath(SaveDialog.InitialDir,PkgDefaultDirectory)) then
|
||||
SaveDialog.InitialDir:=PkgDefaultDirectory;
|
||||
// show save dialog
|
||||
if (not SaveDialog.Execute) or (ExtractFileName(SaveDialog.Filename)='')
|
||||
then begin
|
||||
// user cancels
|
||||
exit;
|
||||
end;
|
||||
Filename:=ExpandFilename(SaveDialog.Filename);
|
||||
finally
|
||||
InputHistories.StoreFileDialogSettings(SaveDialog);
|
||||
SaveDialog.Free;
|
||||
end;
|
||||
|
||||
try
|
||||
XMLConfig:=TXMLConfig.Create(Filename);
|
||||
try
|
||||
WriteComponentToXMLConfig(XMLConfig,'Component',ADesigner.LookupRoot);
|
||||
XMLConfig.Flush;
|
||||
finally
|
||||
XMLConfig.Free;
|
||||
end;
|
||||
except
|
||||
on E: Exception do begin
|
||||
MessageDlg('Error',E.Message,mtError,[mbCancel],0);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TMainIDE.OnSrcNoteBookAddJumpPoint(ACaretXY: TPoint;
|
||||
ATopLine: integer; APageIndex: integer; DeleteForwardHistory: boolean);
|
||||
{off $DEFINE VerboseJumpHistory}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user