|
![]() |
|
Registriert seit: 11. Okt 2003 Ort: Elbflorenz 44.316 Beiträge Delphi 12 Athens |
#1
bei diesem Code
Code:
kommt dieses raus
Type TForm1 = Class(TForm)
Label1: TLabel; Memo1: TMemo; Procedure FormCreate(Sender: TObject); Private _xyz: TMyProc; Procedure MyProc(x: Integer); Published Property xyz: TMyProc read _xyz write _xyz Stored True; End; XML := TXMLFile.Create; Node := XML.RootNode.Nodes.Add('node1'); Node.Attributes['attr1'] := '123'; Node.Attributes['attr2'] := '456'; Node.Nodes.Add('node1_2'); Node := Node.Nodes.Add('node1_3'); Node.Nodes.Add('node1_3_1'); Node := XML.RootNode.Nodes.Add('node2'); Node := Node.Nodes.Add('node2_1'); Node.Attributes['attr3'] := 'abc'; Form1.xyz := MyProc; Node := Node.Nodes.Add('object'); Node.Serialize(Form1); XML.SaveToFile('test.xml');
XML-Code:
isses OK so?
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<xml> <node1 attr1="123" attr2="456"> <node1_2 /> <node1_3> <node1_3_1 /> </node1_3> </node1> <node2> <node2_1 attr3="abc"> <object> <Tag>0</Tag> <AlignWithMargins>False</AlignWithMargins> <Left>66</Left> <Top>72</Top> <Cursor>0</Cursor> <HelpType>htContext</HelpType> <HelpContext>0</HelpContext> <Margins ClassType="TMargins"> <Left>3</Left> <Top>3</Top> <Right>3</Right> <Bottom>3</Bottom> </Margins> <ParentCustomHint>True</ParentCustomHint> <HorzScrollBar ClassType="TControlScrollBar"> <ButtonSize>0</ButtonSize> <Color>clBtnHighlight</Color> <Increment>8</Increment> <Margin>0</Margin> <ParentColor>True</ParentColor> <Position>0</Position> <Range>0</Range> <Smooth>False</Smooth> <Size>0</Size> <Style>ssRegular</Style> <ThumbSize>0</ThumbSize> <Tracking>False</Tracking> <Visible>True</Visible> </HorzScrollBar> <VertScrollBar ClassType="TControlScrollBar"> <ButtonSize>0</ButtonSize> <Color>clBtnHighlight</Color> <Increment>8</Increment> <Margin>0</Margin> <ParentColor>True</ParentColor> <Position>0</Position> <Range>0</Range> <Smooth>False</Smooth> <Size>0</Size> <Style>ssRegular</Style> <ThumbSize>0</ThumbSize> <Tracking>False</Tracking> <Visible>True</Visible> </VertScrollBar> <Align>alNone</Align> <AlphaBlend>False</AlphaBlend> <AlphaBlendValue>255</AlphaBlendValue> <AutoSize>False</AutoSize> <BorderIcons>[biSystemMenu,biMinimize,biMaximize]</BorderIcons> <BorderStyle>bsSizeable</BorderStyle> <BorderWidth>0</BorderWidth> <Caption>Form1</Caption> <ClientHeight>201</ClientHeight> <ClientWidth>329</ClientWidth> <Color>clBtnFace</Color> <TransparentColor>False</TransparentColor> <TransparentColorValue>clBlack</TransparentColorValue> <Constraints ClassType="TSizeConstraints"> <MaxHeight>0</MaxHeight> <MaxWidth>0</MaxWidth> <MinHeight>0</MinHeight> <MinWidth>0</MinWidth> </Constraints> <Ctl3D>True</Ctl3D> <UseDockManager>False</UseDockManager> <DefaultMonitor>dmActiveForm</DefaultMonitor> <DockSite>False</DockSite> <DoubleBuffered>False</DoubleBuffered> <DragKind>dkDrag</DragKind> <DragMode>dmManual</DragMode> <Enabled>True</Enabled> <ParentFont>False</ParentFont> <Font ClassType="TFont"> <Charset>1</Charset> <Color>clWindowText</Color> <Height>-11</Height> <Name>Tahoma</Name> <Orientation>0</Orientation> <Pitch>fpDefault</Pitch> <Style>[]</Style> </Font> <FormStyle>fsNormal</FormStyle> <GlassFrame ClassType="TGlassFrame"> <Enabled>False</Enabled> <Left>0</Left> <Top>0</Top> <Right>0</Right> <Bottom>0</Bottom> <SheetOfGlass>False</SheetOfGlass> </GlassFrame> <KeyPreview>False</KeyPreview> <Padding ClassType="TPadding"> <Left>0</Left> <Top>0</Top> <Right>0</Right> <Bottom>0</Bottom> </Padding>[list=1]False</OldCreateOrder> <ParentBiDiMode>True</ParentBiDiMode> <PopupMode>pmNone</PopupMode> <Position>poDefaultPosOnly</Position> <PrintScale>poProportional</PrintScale> <Scaled>True</Scaled> <ScreenSnap>False</ScreenSnap> <SnapBuffer>10</SnapBuffer> <Visible>False</Visible> <WindowState>wsNormal</WindowState> <OnCreate>TForm1:Form1:$0047BB54</OnCreate> <xyz>TForm1:Form1:$0047B894</xyz> <Components> <Component ClassType="TLabel"> <Tag>0</Tag> <AlignWithMargins>False</AlignWithMargins> <Left>32</Left> <Top>37</Top> <Width>31</Width> <Height>13</Height> <Cursor>0</Cursor> <HelpType>htContext</HelpType> <HelpContext>0</HelpContext> <Margins ClassType="TMargins"> <Left>3</Left> <Top>3</Top> <Right>3</Right> <Bottom>3</Bottom> </Margins> <ParentCustomHint>True</ParentCustomHint> <Align>alNone</Align> <Alignment>taLeftJustify</Alignment> <AutoSize>True</AutoSize> <Caption>Label1</Caption> <Constraints ClassType="TSizeConstraints"> <MaxHeight>0</MaxHeight> <MaxWidth>0</MaxWidth> <MinHeight>0</MinHeight> <MinWidth>0</MinWidth> </Constraints> <DragCursor>-12</DragCursor> <DragKind>dkDrag</DragKind> <DragMode>dmManual</DragMode> <EllipsisPosition>epNone</EllipsisPosition> <Enabled>True</Enabled> <GlowSize>0</GlowSize> <ParentBiDiMode>True</ParentBiDiMode> <ParentColor>True</ParentColor> <ParentFont>True</ParentFont> <ParentShowHint>True</ParentShowHint> <ShowAccelChar>True</ShowAccelChar> <Layout>tlTop</Layout> <Visible>True</Visible> <WordWrap>False</WordWrap> </Component> <Component ClassType="TMemo"> <Tag>0</Tag> <AlignWithMargins>False</AlignWithMargins> <Left>32</Left> <Top>56</Top> <Width>257</Width> <Height>89</Height> <Cursor>0</Cursor> <HelpType>htContext</HelpType> <HelpContext>0</HelpContext> <Margins ClassType="TMargins"> <Left>3</Left> <Top>3</Top> <Right>3</Right> <Bottom>3</Bottom> </Margins> <ParentCustomHint>True</ParentCustomHint> <TabStop>True</TabStop> <Align>alNone</Align> <Alignment>taLeftJustify</Alignment> <BevelEdges>[beLeft,beTop,beRight,beBottom]</BevelEdges> <BevelInner>bvRaised</BevelInner> <BevelKind>bkNone</BevelKind> <BevelOuter>bvLowered</BevelOuter> <BorderStyle>bsSingle</BorderStyle> <CharCase>ecNormal</CharCase> <Color>clWindow</Color> <Constraints ClassType="TSizeConstraints"> <MaxHeight>0</MaxHeight> <MaxWidth>0</MaxWidth> <MinHeight>0</MinHeight> <MinWidth>0</MinWidth> </Constraints> <DragCursor>-12</DragCursor> <DragKind>dkDrag</DragKind> <DragMode>dmManual</DragMode> <Enabled>True</Enabled> <HideSelection>True</HideSelection> <ImeMode>imDontCare</ImeMode> <Lines ClassType="TMemoStrings"> <Strings> <String>Memo1</String> <String /> <String>abc</String> </Strings> </Lines> <MaxLength>0</MaxLength> <OEMConvert>False</OEMConvert> <ParentBiDiMode>True</ParentBiDiMode> <ParentColor>False</ParentColor> <ParentCtl3D>True</ParentCtl3D> <ParentDoubleBuffered>True</ParentDoubleBuffered> <ParentFont>True</ParentFont> <ParentShowHint>True</ParentShowHint> <ReadOnly>False</ReadOnly> <ScrollBars>ssNone</ScrollBars> <TabOrder>0</TabOrder> <Visible>True</Visible> <WantReturns>True</WantReturns> <WantTabs>False</WantTabs> <WordWrap>True</WordWrap> </Component> </Components> </object> </node2_1> </node2> </xml> (hier sind jetzt nur Stored-Property <> Default-Wert drin) bei Propertys, welche nicht von meiner Serialize-Prozedur verarbeitet werden, wird erstmal soeine Prozedur aufzurufen (wenn angegeben) und wenn Beides das Property nicht verarbeitet, dann gibt's eine Exception.
Delphi-Quellcode:
man kann diese Prozedut auch nutzen, um selbst anzugeben, welche Properties gespeichert bzw. geladen (bei Deserialize) werden sollen.
Function SerializeProc(C: TObject; Const PropertyName: AnsiString; NodeList: TXMLNodeList): Boolean;
Var Node: TXMLNode; Begin Node := NodeList.Add(PropertyName); Node.Attributes['unknown'] := 'True'; //Node.Attributes['Name'] := GetPropInfo(C, PropertyName).PropType^.Name; //Node.Attributes['Type'] := cTypeKind[GetPropInfo(C, PropertyName).PropType^.Kind]; Result := True; // True wenn verarbeitet ... egal ob ein Node erstellt, oder ignoriert wurde // bei False wird (womöglich) eine Exception geworfen, daß ein Property nicht bearbeitet wurde End; Node.Serialize(Form1, [], SerializeProc); Ist NodeList = nil, dann wird über Result bestimmt, was geschehen soll. True = Property versuchen zu speichern (falls unbekannt, dann wird diese Funktion nochmals aufgerufen ... siehe vorheriges Beispiel) False = Property nicht speichern/laden
Delphi-Quellcode:
Function SerializeProc(C: TObject; Const PropertyName: AnsiString; NodeList: TXMLNodeList): Boolean;
Var Node: TXMLNode; Begin If Assigned(NodeList) Then Begin Node := NodeList.Add(PropertyName); Node.Attributes['unknown'] := 'True'; //Node.Attributes['Name'] := GetPropInfo(C, PropertyName).PropType^.Name; //Node.Attributes['Type'] := cTypeKind[GetPropInfo(C, PropertyName).PropType^.Kind]; Result := True; End Else Begin // only if xsQueryBefore is set Result := PropertyName <> 'Name'; End; End; Node.Serialize(Form1, [xsNonStoredProperties, xsQueryBefore], SerializeProc); das Ganze läßt sich dann natürlich auch noch auf bestimmte Property eingrenzen:
Delphi-Quellcode:
als Parameter gibt's dieses:
Function SerializeProc(C: TObject; Const PropertyName: AnsiString; NodeList: TXMLNodeList): Boolean;
Var Node: TXMLNode; Begin If (C is TMyClass) and (PropertyName = 'MyProperty') Then Begin Node := NodeList.Add(PropertyName); Node.Data := LeseDaten(C, PropertyName); Result := True; End Else Result := False; End; // hier wird nur das Property "MyProperty" des übergebenen Objektes gespeichert Function SerializeProc(C: TObject; Const PropertyName: AnsiString; NodeList: TXMLNodeList): Boolean; Var Node: TXMLNode; Begin If Assigned(NodeList) Then Begin If (C is TMyClass) and (PropertyName = 'MyProperty') Then Begin Node := NodeList.Add(PropertyName); Node.Data := LeseDaten(C, PropertyName); Result := True; End Else Result := False; End Else Begin // only if xsQueryBefore is set Result := (C is TMyClass) and (PropertyName = 'MyProperty'); End; End; // hier wird alles gespeichert, was meine Funktion speichern kann // und zusätzlich noch das Property "MyProperty" (welches meine Funktion nicht kennt) Function SerializeProc(C: TObject; Const PropertyName: AnsiString; NodeList: TXMLNodeList): Boolean; Var Node: TXMLNode; Begin If Assigned(NodeList) Then Begin If (C is TMyClass) and (PropertyName = 'MyProperty') Then Begin Node := NodeList.Add(PropertyName); Node.Data := LeseDaten(C, PropertyName); Result := True; End Else Result := True; End Else Begin // only if xsQueryBefore is set Result := True; End; End;
Code:
ich räum jetzt noch den Code etwas auf
xsSortProperties sortiert die Properties
xsDefaultProperties speichert auch Properties, welche ihrem "Default"-Wert entsprechen xsNonStoredProperties speichert auch Properties, welche nicht mit "Stored" markiert sind xsSaveClassType speichert den Klassen-Typ siehe <Lines ClassType="TMemoStrings"> wäre es mit angegeben gewesen, dann stünde statt <object> jetzt <object ClassType="TForm1"> xsSavePropertyInfos ist mehr für Debugzwecke entspricht Name=".PropType^.Name" Type=".PropType^.Kind"; xsQueryBefore ruft SerializeProc auf und fragt, ob das Property gespeichert werden soll ... siehe Beispiele und lad dann eventuell den aktuellen Code mal hoch ansonsten bastel jetzt erstmal wieder am Parsen rum (das Lesen geht immernoch nicht so, wie ich es gern hätte) [add] im vollen Modus kommt sowas raus
Delphi-Quellcode:
es wird alles gespeichert ... nur "Name" nicht ... und das nicht behandelbare TIcon wurde von SerializeProc erstellt
Function SerializeProc(C: TObject; Const PropertyName: AnsiString; NodeList: TXMLNodeList): Boolean;
Const cTypeKind: Array[TTypeKind] of String = ('Unknown', 'Integer', 'Char', 'Enumeration', 'Float', 'String', 'Set', 'Class', 'Method', 'WChar', 'LString', 'WString', 'Variant', 'Array', 'Record', 'Interface', 'Int64', 'DynArray', 'UString'); Var Node: TXMLNode; Begin If Assigned(NodeList) Then Begin Node := NodeList.Add(PropertyName); Node.Attributes['unknown'] := 'True'; Node.Attributes['unknown_Name'] := GetPropInfo(C, PropertyName).PropType^.Name; Node.Attributes['unknown_Type'] := cTypeKind[GetPropInfo(C, PropertyName).PropType^.Kind]; Result := True; End Else Begin // only if xsQueryBefore is set Result := PropertyName <> 'Name'; End; End; Node.Serialize(Form1, [xsDefaultProperties, xsNonStoredProperties, xsSaveClassType, xsSavePropertyInfos, xsQueryBefore], SerializeProc);
XML-Code:
Das Deserialize fehlt auch noch ... mach erstmal Serialize fertig und wende mich dann dem deserialisieren zu (hab da noch ein paar Problemchen beim Speichern auszumerzen)
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
<xml> ... <node2> <node2_1 attr3="abc"> <object ClassType="TForm1"> <Tag Name="Integer" Type="Integer">0</Tag> <AlignWithMargins Name="Boolean" Type="Enumeration">False</AlignWithMargins> <Left Name="Integer" Type="Integer">88</Left> <Top Name="Integer" Type="Integer">96</Top> <Width Name="Integer" Type="Integer">337</Width> <Height Name="Integer" Type="Integer">230</Height> <Cursor Name="TCursor" Type="Integer">0</Cursor> <Hint Name="string" Type="UString" /> <HelpType Name="THelpType" Type="Enumeration">htContext</HelpType> <HelpKeyword Name="string" Type="UString" /> <HelpContext Name="THelpContext" Type="Integer">0</HelpContext> <Margins Name="TMargins" Type="Class" ClassType="TMargins"> <Left Name="TMarginSize" Type="Integer">3</Left> <Top Name="TMarginSize" Type="Integer">3</Top> <Right Name="TMarginSize" Type="Integer">3</Right> ... <Icon unknown="True" unknown_Name="TIcon" unknown_Type="Class" />
Ein Therapeut entspricht 1024 Gigapeut.
|
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Erstellt von | For | Type | Datum |
xml - MSXML alternative - Stack Overflow | This thread | Refback | 28. Jun 2011 16:34 |
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |