Delphi.int.ru — Портал программистов

Вход Регистрация | Забыли пароль?

Просмотр кода

Идентификатор: be2f81f2 Описание: Код загружен: 26 июня 2012, 16:51 (min@y™)

  1. unit uXmlUtils;
  2.  
  3. interface
  4.  
  5. uses
  6. SysUtils, Graphics, ECXMLParser;
  7.  
  8. // --------------- Добавление информации в XML -----------------
  9. procedure XmlAddStringParam(ANode: TXMLItem; const Name, Value: string);
  10. procedure XmlAddIntegerParam(ANode: TXMLItem; const Name: string; const Value: Integer);
  11. procedure XmlAddCardinalParam(ANode: TXMLItem; const Name: string; const Value: Cardinal);
  12. procedure XmlAddColorParam(ANode: TXMLItem; const Name: string; const Value: TColor);
  13. procedure XmlAddBoolParam(ANode: TXMLItem; const Name: string; const Value: Boolean);
  14. procedure XmlAddTimeParam(ANode: TXMLItem; const Name: string; const Value: TDateTime);
  15. procedure XmlAddDateParam(ANode: TXMLItem; const Name: string; const Value: TDateTime);
  16. procedure XmlAddDateTimeParam(ANode: TXMLItem; const Name: string; const Value: TDateTime);
  17. procedure XmlAddFloatParam(ANode: TXMLItem; const Name: string; const Value: Extended);
  18. procedure XmlAddFontStyleParam(ANode: TXMLItem; const Name: string; const Value: TFontStyles);
  19.  
  20. // ------------ Поиск и извлечение информации из XML -----------
  21. function XmlFindParam(ANode: TXMLItem; const Name: string): Integer;
  22. function XmlFindNodeIndex(AParentNode: TXMLItem; const Name: string): Integer;
  23. function XmlFindNode(AParentNode: TXMLItem; const Name: string): TXMLItem;
  24.  
  25. function XmlGetStringParam(ANode: TXMLItem; const Name, Default: string): string;
  26. function XmlGetIntegerParam(ANode: TXMLItem; const Name: string; const Default: Integer): Integer;
  27. function XmlGetCardinalParam(ANode: TXMLItem; const Name: string; const Default: Cardinal): Cardinal;
  28. function XmlGetColorParam(ANode: TXMLItem; const Name: string; const Default: TColor): TColor;
  29. function XmlGetBoolParam(ANode: TXMLItem; const Name: string; const Default: Boolean): Boolean;
  30. function XmlGetTimeParam(ANode: TXMLItem; const Name: string; Default: TDateTime): TDateTime;
  31. function XmlGetDateParam(ANode: TXMLItem; const Name: string; Default: TDateTime): TDateTime;
  32. function XmlGetDateTimeParam(ANode: TXMLItem; const Name: string; Default: TDateTime): TDateTime;
  33. function XmlGetFloatParam(ANode: TXMLItem; const Name: string; Default: Extended): Extended;
  34. function XmlGetFontStyleParam(ANode: TXMLItem; const Name: string; Default: TFontStyles): TFontStyles;
  35.  
  36. // ------------------------- Прочие функции --------------------
  37. function FindNamedItem(AParentNode: TXMLItem; const Name: string; const FromIndex: Integer = 0): TXMLItem;
  38. function ReplaceIllegalSymbols(const S: string): string;
  39.  
  40. implementation
  41.  
  42. // ---------------------- Функции преобразований -------------------------------
  43.  
  44. // Преобразование стилей шрифта в число
  45. function FontStyle2Int(const AFontStyle: TFontStyles): Integer;
  46. var
  47. Style: TFontStyle;
  48. begin
  49. Result:= 0;
  50.  
  51. for Style:= Low(TFontStyle) to High(TFontStyle) do
  52. if Style in AFontStyle
  53. then Result:= Result or (1 shl Integer(Style));
  54. end;
  55.  
  56. // Преобразование числа в стили шрифта
  57. function Int2FontStyle(const iFontStyle: Integer): TFontStyles;
  58. var
  59. Style: TFontStyle;
  60. begin
  61. Result:= [];
  62.  
  63. for Style:= Low(TFontStyle) to High(TFontStyle) do
  64. if iFontStyle and (1 shl Integer(Style)) <> 0
  65. then Result:= Result + [Style];
  66. end;
  67.  
  68. // --------------- Добавление информации в XML -----------------
  69. procedure XmlAddStringParam(ANode: TXMLItem; const Name, Value: string);
  70. begin
  71. ANode.Params.Add(Name + '=' + Value);
  72. end;
  73.  
  74. procedure XmlAddIntegerParam(ANode: TXMLItem; const Name: string; const Value: Integer);
  75. begin
  76. ANode.Params.Add(Name + '=' + IntToStr(Value));
  77. end;
  78.  
  79. procedure XmlAddCardinalParam(ANode: TXMLItem; const Name: string; const Value: Cardinal);
  80. begin
  81. ANode.Params.Add(Name + '=' + IntToHex(Value, 8));
  82. end;
  83.  
  84. procedure XmlAddColorParam(ANode: TXMLItem; const Name: string; const Value: TColor);
  85. begin
  86. // Запись параметра типа Param="11BBCC" (шестнадцатеричного)
  87. ANode.Params.Add(Name + '=' + IntToHex(Value, 8));
  88. end;
  89.  
  90. procedure XmlAddBoolParam(ANode: TXMLItem; const Name: string; const Value: Boolean);
  91. begin
  92. if Value
  93. then XmlAddStringParam(ANode, Name, '1')
  94. else XmlAddStringParam(ANode, Name, '0');
  95. end;
  96.  
  97. procedure XmlAddTimeParam(ANode: TXMLItem; const Name: string; const Value: TDateTime);
  98. begin
  99. ANode.Params.Add(Name + '=' + TimeToStr(Value));
  100. end;
  101.  
  102. procedure XmlAddDateParam(ANode: TXMLItem; const Name: string; const Value: TDateTime);
  103. begin
  104. ANode.Params.Add(Name + '=' + DateToStr(Value));
  105. end;
  106.  
  107. procedure XmlAddDateTimeParam(ANode: TXMLItem; const Name: string; const Value: TDateTime);
  108. begin
  109. ANode.Params.Add(Name + '=' + DateTimeToStr(Value));
  110. end;
  111.  
  112. procedure XmlAddFloatParam(ANode: TXMLItem; const Name: string; const Value: Extended);
  113. begin
  114. ANode.Params.Add(Name + '=' + FloatToStr(Value));
  115. end;
  116.  
  117. procedure XmlAddFontStyleParam(ANode: TXMLItem; const Name: string; const Value: TFontStyles);
  118. begin
  119. ANode.Params.Add(Name + '=' + IntToStr(FontStyle2Int(Value)));
  120. end;
  121.  
  122. // ------------ Поиск и извлечение информации из XML -----------
  123. function XmlFindParam(ANode: TXMLItem; const Name: string): Integer;
  124. begin
  125. Result:= ANode.Params.IndexOfName(Name);
  126. end;
  127.  
  128. function XmlFindNodeIndex(AParentNode: TXMLItem; const Name: string): Integer;
  129. begin
  130. Result:= AParentNode.IndexOfName(Name);
  131. end;
  132.  
  133. function XmlFindNode(AParentNode: TXMLItem; const Name: string): TXMLItem;
  134. var
  135. Index: Integer;
  136. begin
  137. Result:= nil;
  138. Index:= AParentNode.IndexOfName(Name);
  139. if Index <> -1
  140. then Result:= AParentNode.SubItems[Index];
  141. end;
  142.  
  143. function XmlGetStringParam(ANode: TXMLItem; const Name, Default: string): string;
  144. var
  145. Index: Integer;
  146. begin
  147. Index:= XmlFindParam(ANode, Name);
  148. if Index <> -1
  149. then Result:= ANode.Params.ValueFromIndex[Index]
  150. else Result:= Default;
  151.  
  152. if Result = '""'
  153. then Result:= ''; // А то парсер фигово сохраняет пустые строки PinName=""""
  154. end;
  155.  
  156. function XmlGetIntegerParam(ANode: TXMLItem; const Name: string; const Default: Integer): Integer;
  157. var
  158. Index: Integer;
  159. begin
  160. Index:= XmlFindParam(ANode, Name);
  161.  
  162. if Index = -1
  163. then Result:= Default
  164. else if not TryStrToInt(ANode.Params.ValueFromIndex[Index], Result)
  165. then Result:= Default;
  166. end;
  167.  
  168. function XmlGetCardinalParam(ANode: TXMLItem; const Name: string; const Default: Cardinal): Cardinal;
  169. var
  170. Index: Integer;
  171. begin
  172. // Чтение параметра типа Param="11BBCC" (шестнадцатеричного)
  173. Index:= XmlFindParam(ANode, Name);
  174.  
  175. if Index = -1
  176. then Result:= Default
  177. else if not TryStrToInt('$' + ANode.Params.ValueFromIndex[Index], Integer(Result))
  178. then Result:= Default;
  179. end;
  180.  
  181. function XmlGetColorParam(ANode: TXMLItem; const Name: string; const Default: TColor): TColor;
  182. var
  183. Index: Integer;
  184. begin
  185. // Чтение параметра типа Param="11BBCC" (шестнадцатеричного)
  186. Index:= XmlFindParam(ANode, Name);
  187.  
  188. if Index = -1
  189. then Result:= Default
  190. else if not TryStrToInt('$' + ANode.Params.ValueFromIndex[Index], Integer(Result))
  191. then Result:= Default;
  192. end;
  193.  
  194. function XmlGetBoolParam(ANode: TXMLItem; const Name: string; const Default: Boolean): Boolean;
  195. var
  196. Index: Integer;
  197. begin
  198. Index:= XmlFindParam(ANode, Name);
  199.  
  200. if Index = -1
  201. then Result:= Default
  202. else Result:= XmlGetStringParam(ANode, Name, '0') = '1';
  203. end;
  204.  
  205. function XmlGetTimeParam(ANode: TXMLItem; const Name: string; Default: TDateTime): TDateTime;
  206. var
  207. Index: Integer;
  208. begin
  209. Index:= XmlFindParam(ANode, Name);
  210.  
  211. if Index = -1
  212. then Result:= Default
  213. else if not TryStrToTime(ANode.Params.ValueFromIndex[Index], Result)
  214. then Result:= Default;
  215. end;
  216.  
  217. function XmlGetDateParam(ANode: TXMLItem; const Name: string; Default: TDateTime): TDateTime;
  218. var
  219. Index: Integer;
  220. begin
  221. Index:= XmlFindParam(ANode, Name);
  222.  
  223. if Index = -1
  224. then Result:= Default
  225. else if not TryStrToDate(ANode.Params.ValueFromIndex[Index], Result)
  226. then Result:= Default;
  227. end;
  228.  
  229. function XmlGetDateTimeParam(ANode: TXMLItem; const Name: string; Default: TDateTime): TDateTime;
  230. var
  231. Index: Integer;
  232. begin
  233. Index:= XmlFindParam(ANode, Name);
  234.  
  235. if Index = -1
  236. then Result:= Default
  237. else if not TryStrToDateTime(ANode.Params.ValueFromIndex[Index], Result)
  238. then Result:= Default;
  239. end;
  240.  
  241. function XmlGetFloatParam(ANode: TXMLItem; const Name: string; Default: Extended): Extended;
  242. var
  243. Index: Integer;
  244. begin
  245. Index:= XmlFindParam(ANode, Name);
  246.  
  247. if Index = -1
  248. then Result:= Default
  249. else if not TryStrToFloat(ANode.Params.ValueFromIndex[Index], Result)
  250. then Result:= Default;
  251. end;
  252.  
  253. function XmlGetFontStyleParam(ANode: TXMLItem; const Name: string; Default: TFontStyles): TFontStyles;
  254. var
  255. Index, Temp: Integer;
  256. begin
  257. Index:= XmlFindParam(ANode, Name);
  258.  
  259. if Index = -1
  260. then Result:= Default
  261. else if TryStrToInt(ANode.Params.ValueFromIndex[Index], Temp)
  262. then Result:= Int2FontStyle(Temp)
  263. else Result:= Default;
  264. end;
  265.  
  266. // ------------------------- Прочие функции --------------------
  267.  
  268. // Поиск в ноде сабноды с именем Name, начиная с индекса FromIndex
  269. function FindNamedItem(AParentNode: TXMLItem; const Name: string; const FromIndex: Integer = 0): TXMLItem;
  270. var
  271. Index: Integer;
  272. begin
  273. Result:= nil;
  274.  
  275. for Index:= FromIndex to AParentNode.Count - 1 do
  276. if AParentNode.SubItems[Index].Name = Name
  277. then begin
  278. Result:= AParentNode.SubItems[Index];
  279. Break;
  280. end;
  281. end;
  282.  
  283. // Замена неподходящих для XML-имён символов на "_"
  284. function ReplaceIllegalSymbols(const S: string): string;
  285. const
  286. AllowedSymbols: set of Char = ['0'..'9', 'A'..'Z', 'a'..'z',
  287. 'А'..'Я', 'а'..'я', '_', '+', '-'];
  288. var
  289. Index: Integer;
  290. begin
  291. Result:= S;
  292.  
  293. for Index:= 1 to Length(Result) do
  294. if not (Result[Index] in AllowedSymbols)
  295. then Result[Index]:= '_';
  296. end;
  297.  
  298.  
  299. end.

Ссылка на данный код:

На главную страницу сервиса обмена кодом »