* Initial import of SpkXml

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1704 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/spktoolbar/SpkXML/SpkXMLIni.pas

@@ -0,0 +1,561 @@
+unit SpkXMLIni;
+
+{$DEFINE SPKXMLINI}
+
+interface
+
+uses SpkXMLParser, classes, sysutils;
+
+type TSpkXMLIni = class(TObject)
+     private
+       FParser : TSpkXMLParser;
+       FAutoConvert : boolean;
+     protected
+     public
+       constructor Create; overload;
+       constructor Create(filename : string); overload;
+       destructor Destroy; override;
+       procedure LoadFromFile(filename : string);
+       procedure SaveToFile(filename : string);
+       procedure SaveToStream(AStream : TStream);
+       procedure LoadFromStream(AStream : TStream);
+       procedure Clear;
+       procedure DeleteKey(const Section, Ident: string);
+       procedure EraseSection(const Section: string);
+       function ReadString(const Section, Ident, Default: string): string;
+       procedure WriteString(const Section, Ident, Value: string);
+       function ReadBool (const Section, Ident: String; Default: Boolean): Boolean;
+       function ReadDate (const Section, Ident: string; Default: TDateTime): TDateTime;
+       function ReadDateTime (const Section, Ident: String; Default: TDateTime): TDateTime;
+       function ReadFloat (const Section, Ident: String; Default: Double): Double;
+       function ReadInteger(const Section, Ident: String; Default: Longint): Longint;
+       function ReadTime (const Section, Ident: String; Default: TDateTime): TDateTime;
+       function SectionExists (const Section: String): Boolean;
+       procedure WriteBool(const Section, Ident: String; Value: Boolean);
+       procedure WriteDate(const Section, Ident: String; Value: TDateTime);
+       procedure WriteDateTime(const Section, Ident: String; Value: TDateTime);
+       procedure WriteFloat(const Section, Ident: String; Value: Double);
+       procedure WriteInteger(const Section, Ident: String; Value: Longint);
+       procedure WriteTime(const Section, Ident: String; Value: TDateTime);
+       function ValueExists(const section, ident : string) : boolean;
+       procedure WriteStrings(const Section, Ident : String; Value : TStrings);
+       procedure ReadStrings(const Section, Ident : String; Target : TStrings);
+       procedure ReadSection (const Section: string; Strings: TStrings);
+       procedure ReadSections(Strings: TStrings);
+       procedure ReadSectionValues(const Section: string; Strings: TStrings);
+
+       property AutoConvert : boolean read FAutoConvert write FAutoConvert;
+     end;
+
+implementation
+
+{ TSpkXMLIni }
+
+constructor TSpkXMLIni.create;
+
+begin
+  inherited create;
+  FParser:=TSpkXMLParser.create;
+  FAutoConvert:=true;
+end;
+
+constructor TSpkXMLIni.create(filename : string);
+
+begin
+inherited create;
+self.LoadFromFile(filename);
+end;
+
+destructor TSpkXMLIni.destroy;
+
+begin
+  FParser.free;
+  inherited;
+end;
+
+procedure TSpkXMLIni.LoadFromFile(filename : string);
+
+begin
+try
+FParser.LoadFromFile(filename);
+except
+self.clear;
+end;
+end;
+
+procedure TSpkXMLIni.LoadFromStream(AStream: TStream);
+begin
+FParser.LoadFromStream(AStream);
+end;
+
+procedure TSpkXMLIni.SaveToFile(filename : string);
+
+begin
+FParser.SaveToFile(filename);
+end;
+
+procedure TSpkXMLIni.SaveToStream(AStream: TStream);
+begin
+FParser.SaveToStream(AStream);
+end;
+
+procedure TSpkXMLIni.Clear;
+
+begin
+FParser.Clear;
+end;
+
+procedure TSpkXMLIni.DeleteKey(const Section, Ident: string);
+
+var node : TSpkXMLNode;
+    subnode : TSpkXMLNode;
+
+begin
+node:=FParser.NodeByName[Section,false];
+if node<>nil then
+   begin
+   subnode:=node.NodeByName[Ident,false];
+   if subnode<>nil then
+      begin
+      node.delete(node.IndexOf(subnode));
+      end;
+   end;
+end;
+
+procedure TSpkXMLIni.EraseSection(const Section: string);
+
+var node : TSpkXMLNode;
+
+begin
+node:=FParser.NodeByName[Section,false];
+if node<>nil then
+   Fparser.Delete(FParser.IndexOf(node));
+end;
+
+function TSpkXMLIni.ReadString(const Section, Ident, Default: string): string;
+
+var node, subnode : TSpkXMLNode;
+
+begin
+node:=FParser.NodeByName[Section,false];
+if node=nil then result:=Default else
+   begin
+   subnode:=node.NodeByName[Ident,false];
+   if subnode=nil then result:=Default else
+      begin
+      if subnode.Parameters.ParamByName['type',false]<>nil then
+         begin
+         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='STRING' then
+            result:=subnode.text else
+            begin
+            if FAutoConvert then
+               try
+               result:=subnode.text;
+               except
+               result:=Default;
+               end else raise exception.create('Invalid object type!');
+            end;
+         end else result:=subnode.Text;
+      end;
+   end;
+end;
+
+procedure TSpkXMLIni.WriteString(const Section, Ident, Value: string);
+
+begin
+self.DeleteKey(Section,Ident);
+FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].value:='string';
+FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:=Value;
+end;
+
+function TSpkXMLIni.ReadBool (const Section, Ident: String; Default: Boolean): Boolean;
+
+var node, subnode : TSpkXMLNode;
+
+begin
+node:=FParser.NodeByName[Section,false];
+if node=nil then result:=Default else
+   begin
+   subnode:=node.NodeByName[Ident,false];
+   if subnode=nil then result:=Default else
+      begin
+      if subnode.Parameters.ParamByName['type',false]<>nil then
+         begin
+         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='BOOLEAN' then
+            begin
+            if (uppercase(subnode.text)='TRUE') or (subnode.text='1') then result:=true else result:=false;
+            end else
+                begin
+                if FAutoConvert then
+                   try
+                   if (uppercase(subnode.text)='TRUE') or (subnode.text='1') then result:=true else result:=false;
+                   except
+                   result:=Default;
+                   end else raise exception.create('Invalid object type!');
+                end;
+         end else
+             try
+             if (uppercase(subnode.text)='TRUE') or (subnode.text='1') then result:=true else result:=false;
+             except
+             result:=Default;
+             end;
+      end;
+   end;
+end;
+
+function TSpkXMLIni.ReadDate (const Section, Ident: string; Default: TDateTime): TDateTime;
+
+var node, subnode : TSpkXMLNode;
+
+begin
+node:=FParser.NodeByName[Section,false];
+if node=nil then result:=Default else
+   begin
+   subnode:=node.NodeByName[Ident,false];
+   if subnode=nil then result:=Default else
+      begin
+      if subnode.Parameters.ParamByName['type',false]<>nil then
+         begin
+         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='DATE' then
+            begin
+            try
+            result:=StrToDate(subnode.text);
+            except
+            result:=Default;
+            end;
+            end else
+                begin
+                if FAutoConvert then
+                   try
+                   result:=StrToDate(subnode.text);
+                   except
+                   result:=Default;
+                   end else raise exception.create('Invalid object type!');
+                end;
+         end else
+             try
+             result:=StrToDate(subnode.text);
+             except
+             result:=Default;
+             end;
+      end;
+   end;
+end;
+
+function TSpkXMLIni.ReadDateTime (const Section, Ident: String; Default: TDateTime): TDateTime;
+
+var node, subnode : TSpkXMLNode;
+
+begin
+node:=FParser.NodeByName[Section,false];
+if node=nil then result:=Default else
+   begin
+   subnode:=node.NodeByName[Ident,false];
+   if subnode=nil then result:=Default else
+      begin
+      if subnode.Parameters.ParamByName['type',false]<>nil then
+         begin
+         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='DATETIME' then
+            begin
+            try
+            result:=StrToDateTime(subnode.text);
+            except
+            result:=Default;
+            end;
+            end else
+                begin
+                if FAutoConvert then
+                   try
+                   result:=StrToDateTime(subnode.text);
+                   except
+                   result:=Default;
+                   end else raise exception.create('Invalid object type!');
+                end;
+         end else
+             try
+             result:=StrToDateTime(subnode.text);
+             except
+             result:=Default;
+             end;
+      end;
+   end;
+end;
+
+function TSpkXMLIni.ReadFloat (const Section, Ident: String; Default: Double): Double;
+
+var node, subnode : TSpkXMLNode;
+
+begin
+node:=FParser.NodeByName[Section,false];
+if node=nil then result:=Default else
+   begin
+   subnode:=node.NodeByName[Ident,false];
+   if subnode=nil then result:=Default else
+      begin
+      if subnode.Parameters.ParamByName['type',false]<>nil then
+         begin
+         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='FLOAT' then
+            begin
+            try
+            result:=StrToFloat(subnode.text);
+            except
+            result:=Default;
+            end;
+            end else
+                begin
+                if FAutoConvert then
+                   try
+                   result:=StrToFloat(subnode.text);
+                   except
+                   result:=Default;
+                   end else raise exception.create('Invalid object type!');
+                end;
+         end else
+             try
+             result:=StrToFloat(subnode.text);
+             except
+             result:=Default;
+             end;
+      end;
+   end;
+end;
+
+function TSpkXMLIni.ReadInteger(const Section, Ident: String; Default: Longint): Longint;
+
+var node, subnode : TSpkXMLNode;
+
+begin
+node:=FParser.NodeByName[Section,false];
+if node=nil then result:=Default else
+   begin
+   subnode:=node.NodeByName[Ident,false];
+   if subnode=nil then result:=Default else
+      begin
+      if subnode.Parameters.ParamByName['type',false]<>nil then
+         begin
+         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='FLOAT' then
+            begin
+            try
+            result:=StrToInt(subnode.text);
+            except
+            result:=Default;
+            end;
+            end else
+                begin
+                if FAutoConvert then
+                   try
+                   result:=StrToInt(subnode.text);
+                   except
+                   result:=Default;
+                   end else raise exception.create('Invalid object type!');
+                end;
+         end else
+             try
+             result:=StrToInt(subnode.text);
+             except
+             result:=Default;
+             end;
+      end;
+   end;
+end;
+
+function TSpkXMLIni.ReadTime (const Section, Ident: String; Default: TDateTime): TDateTime;
+
+var node, subnode : TSpkXMLNode;
+
+begin
+node:=FParser.NodeByName[Section,false];
+if node=nil then result:=Default else
+   begin
+   subnode:=node.NodeByName[Ident,false];
+   if subnode=nil then result:=Default else
+      begin
+      if subnode.Parameters.ParamByName['type',false]<>nil then
+         begin
+         if uppercase(subnode.Parameters.ParamByName['type',false].Value)='TIME' then
+            begin
+            try
+            result:=StrToTime(subnode.text);
+            except
+            result:=Default;
+            end;
+            end else
+                begin
+                if FAutoConvert then
+                   try
+                   result:=StrToTime(subnode.text);
+                   except
+                   result:=Default;
+                   end else raise exception.create('Invalid object type!');
+                end;
+         end else
+             try
+             result:=StrToTime(subnode.text);
+             except
+             result:=Default;
+             end;
+      end;
+   end;
+end;
+
+function TSpkXMLIni.SectionExists (const Section: String): Boolean;
+
+begin
+result:=FParser.NodeByName[Section,false]<>nil;
+end;
+
+procedure TSpkXMLIni.WriteBool(const Section, Ident: String; Value: Boolean);
+
+begin
+self.DeleteKey(Section,Ident);
+FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].Value:='boolean';
+if Value then FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:='true' else
+   FParser.NodeByName[Section,true].NodeByName[Ident,true].text:='false';
+end;
+
+procedure TSpkXMLIni.WriteDate(const Section, Ident: String; Value: TDateTime);
+
+begin
+self.DeleteKey(Section,Ident);
+FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].Value:='date';
+FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:=DateToStr(Value);
+end;
+
+procedure TSpkXMLIni.WriteDateTime(const Section, Ident: String; Value: TDateTime);
+
+begin
+self.DeleteKey(Section,Ident);
+FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].Value:='datetime';
+FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:=DateTimeToStr(Value);
+end;
+
+procedure TSpkXMLIni.WriteFloat(const Section, Ident: String; Value: Double);
+
+begin
+self.DeleteKey(Section,Ident);
+FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].Value:='float';
+FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:=FloatToStr(Value);
+end;
+
+procedure TSpkXMLIni.WriteInteger(const Section, Ident: String; Value: Longint);
+
+begin
+self.DeleteKey(Section,Ident);
+FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].Value:='integer';
+FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:=IntToStr(Value);
+end;
+
+procedure TSpkXMLIni.WriteTime(const Section, Ident: String; Value: TDateTime);
+
+begin
+self.DeleteKey(Section,Ident);
+FParser.NodeByName[Section,true].NodeByName[Ident,true].Parameters.ParamByName['type',true].Value:='time';
+FParser.NodeByName[Section,true].NodeByName[Ident,true].Text:=TimeToStr(Value);
+end;
+
+function TSpkXMLIni.ValueExists(const section, ident : string) : boolean;
+
+begin
+result:=FParser.NodeByName[section,false]<>nil;
+if result then
+   result:=result and (FParser.NodeByName[section,false].NodeByName[ident,false]<>nil);
+end;
+
+procedure TSpkXMLIni.WriteStrings(const Section, Ident : String; Value : TStrings);
+
+var node,subnode : TSpkXMLNode;
+    i : integer;
+
+begin
+self.DeleteKey(Section,Ident);
+node:=FParser.NodeByName[Section,true];
+subnode:=node.NodeByName[ident,true];
+subnode.Parameters.ParamByName['type',true].value:='strings';
+subnode.parameters.parambyname['count',true].value:=IntToStr(Value.count);
+for i:=0 to value.count-1 do
+    begin
+    subnode.NodeByName['line'+IntToStr(i),true].text:=Value[i];
+    end;
+end;
+
+procedure TSpkXMLIni.ReadStrings(const Section, Ident : String; Target : TStrings);
+
+var node, subnode, line : TSpkXMLNode;
+    i,count : integer;
+
+begin
+target.clear;
+
+node:=FParser.NodeByName[Section,false];
+if node=nil then exit;
+
+subnode:=node.NodeByName[ident,false];
+if subnode=nil then exit;
+
+if subnode.Parameters.ParamByName['type',false]=nil then exit;
+if uppercase(subnode.Parameters.ParamByName['type',false].value)<>'STRINGS' then exit;
+
+if subnode.parameters.parambyname['count',false]=nil then exit;
+
+try
+count:=StrToInt(subnode.parameters.parambyname['count',false].Value);
+except
+exit
+end;
+
+for i:=0 to count-1 do
+    begin
+    line:=subnode.NodeByName['line'+IntToStr(i),false];
+    if line=nil then
+       begin
+       target.Clear;
+       exit;
+       end;
+    target.Add(line.Text);
+    end;
+end;
+
+procedure TSpkXMLIni.ReadSection(const Section: string; Strings: TStrings);
+
+var i : integer;
+    node : TSpkXMLNode;
+
+begin
+if FParser.NodeByName[Section,false]=nil then exit;
+node:=FParser.NodeByName[Section,false];
+if node.Count=0 then exit;
+for i:=0 to node.Count-1 do
+    Strings.Add(node.NodeByIndex[i].Name);
+end;
+
+procedure TSpkXMLIni.ReadSections(Strings: TStrings);
+
+var i : integer;
+
+begin
+if FParser.count=0 then exit;
+for i:=0 to FParser.count-1 do
+    Strings.add(FParser.NodeByIndex[i].Name);
+end;
+
+procedure TSpkXMLIni.ReadSectionValues(const Section: string; Strings: TStrings);
+
+var i : integer;
+    node : TSpkXMLNode;
+
+begin
+if FParser.NodeByName[Section,false]=nil then exit;
+node:=FParser.NodeByName[Section,false];
+if node.Count=0 then exit;
+for i:=0 to node.count-1 do
+    begin
+    {$I-}
+    if (node.NodeByIndex[i].Parameters.ParamByName['type',false]<>nil) and
+       (uppercase(node.NodeByIndex[i].Parameters.ParamByName['type',false].Value)='STRINGS') then
+       Strings.add('[TStrings]')
+       else
+       Strings.add(node.NodeByIndex[i].Text);
+    end;
+end;
+
+end.

components/spktoolbar/SpkXML/SpkXMLTools.pas

@@ -0,0 +1,116 @@
+unit SpkXMLTools;
+
+interface
+
+uses Windows, Graphics, SysUtils,
+     SpkXMLParser;
+
+type TSpkXMLTools = class
+     private
+     protected
+     public
+       class procedure Save(Node : TSpkXMLNode; Font : TFont); overload;
+       class procedure Load(Node : TSpkXMLNode; Font : TFont); overload;
+     end;
+
+implementation
+
+{ TXMLTools }
+
+class procedure TSpkXMLTools.Load(Node: TSpkXMLNode; Font: TFont);
+
+var Subnode, Subnode2 : TSpkXMLNode;
+
+begin
+if not(assigned(Node)) then
+   raise exception.create('TSpkXMLTools.Load: Nieprawid�owa ga��� XML!');
+if not(assigned(Font)) then
+   raise exception.create('TSpkXMLTools.Load: Brak obiektu czcionki do wczytania!');
+
+Subnode:=Node['Charset',false];
+if assigned(Subnode) then
+   Font.Charset:=TFontCharset(Subnode.TextAsInteger);
+
+Subnode:=Node['Color',false];
+if assigned(Subnode) then
+   Font.Color:=Subnode.TextAsInteger;
+
+Subnode:=Node['Name',false];
+if assigned(Subnode) then
+   Font.Name:=Subnode.Text;
+
+Subnode:=Node['Orientation',false];
+if assigned(Subnode) then
+   Font.Orientation:=Subnode.TextAsInteger;
+
+Subnode:=Node['Pitch',false];
+if assigned(Subnode) then
+   Font.Pitch:=TFontPitch(Subnode.TextAsInteger);
+
+Subnode:=Node['Size',false];
+if assigned(Subnode) then
+   Font.Size:=Subnode.TextAsInteger;
+
+Subnode:=Node['Style',false];
+if assigned(Subnode) then
+   begin
+   Subnode2:=Subnode['Bold',false];
+   if assigned(Subnode2) then
+      if Subnode2.TextAsBoolean then
+         Font.Style:=Font.Style + [fsBold] else
+         Font.Style:=Font.Style - [fsBold];
+
+   Subnode2:=Subnode['Italic',false];
+   if assigned(Subnode2) then
+      if Subnode2.TextAsBoolean then
+         Font.Style:=Font.Style + [fsItalic] else
+         Font.Style:=Font.Style - [fsItalic];
+
+   Subnode2:=Subnode['Underline',false];
+   if assigned(Subnode2) then
+      if Subnode2.TextAsBoolean then
+         Font.Style:=Font.Style + [fsUnderline] else
+         Font.Style:=Font.Style - [fsUnderline];
+   end;
+end;
+
+class procedure TSpkXMLTools.Save(Node: TSpkXMLNode; Font: TFont);
+
+var Subnode, Subnode2 : TSpkXMLNode;
+
+begin
+if not(assigned(Node)) then
+   raise exception.create('TSpkXMLTools.Save: Nieprawid�owa ga��� XML!');
+if not(assigned(Font)) then
+   raise exception.create('TSpkXMLTools.Save: Brak obiektu czcionki do zapisania!');
+
+Subnode:=Node['Charset',true];
+Subnode.TextAsInteger:=Font.Charset;
+
+Subnode:=Node['Color',true];
+Subnode.TextAsInteger:=Font.Color;
+
+Subnode:=Node['Name',true];
+Subnode.Text:=Font.Name;
+
+Subnode:=Node['Orientation',true];
+Subnode.TextAsInteger:=Font.Orientation;
+
+Subnode:=Node['Pitch',true];
+Subnode.TextAsInteger:=ord(Font.Pitch);
+
+Subnode:=Node['Size',true];
+Subnode.TextAsInteger:=Font.Size;
+
+Subnode:=Node['Style',true];
+Subnode2:=Subnode['Bold',true];
+Subnode2.TextAsBoolean:=fsBold in Font.Style;
+
+Subnode2:=Subnode['Italic',true];
+Subnode2.TextAsBoolean:=fsItalic in Font.Style;
+
+Subnode2:=Subnode['Underline',true];
+Subnode2.TextAsBoolean:=fsUnderline in Font.Style;
+end;
+
+end.