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

Идентификатор: be2f81f2 Описание: Код загружен: 26 июня 2012, 16:51 (min@y™)
unit uXmlUtils;
 
interface
 
uses
  SysUtils, Graphics, ECXMLParser;
 
// --------------- Добавление информации в XML -----------------
procedure XmlAddStringParam(ANode: TXMLItem; const Name, Value: string);
procedure XmlAddIntegerParam(ANode: TXMLItem; const Name: string; const Value: Integer);
procedure XmlAddCardinalParam(ANode: TXMLItem; const Name: string; const Value: Cardinal);
procedure XmlAddColorParam(ANode: TXMLItem; const Name: string; const Value: TColor);
procedure XmlAddBoolParam(ANode: TXMLItem; const Name: string; const Value: Boolean);
procedure XmlAddTimeParam(ANode: TXMLItem; const Name: string; const Value: TDateTime);
procedure XmlAddDateParam(ANode: TXMLItem; const Name: string; const Value: TDateTime);
procedure XmlAddDateTimeParam(ANode: TXMLItem; const Name: string; const Value: TDateTime);
procedure XmlAddFloatParam(ANode: TXMLItem; const Name: string; const Value: Extended);
procedure XmlAddFontStyleParam(ANode: TXMLItem; const Name: string; const Value: TFontStyles);
 
// ------------ Поиск и извлечение информации из XML -----------
function XmlFindParam(ANode: TXMLItem; const Name: string): Integer;
function XmlFindNodeIndex(AParentNode: TXMLItem; const Name: string): Integer;
function XmlFindNode(AParentNode: TXMLItem; const Name: string): TXMLItem;
 
function XmlGetStringParam(ANode: TXMLItem; const Name, Default: string): string;
function XmlGetIntegerParam(ANode: TXMLItem; const Name: string; const Default: Integer): Integer;
function XmlGetCardinalParam(ANode: TXMLItem; const Name: string; const Default: Cardinal): Cardinal;
function XmlGetColorParam(ANode: TXMLItem; const Name: string; const Default: TColor): TColor;
function XmlGetBoolParam(ANode: TXMLItem; const Name: string; const Default: Boolean): Boolean;
function XmlGetTimeParam(ANode: TXMLItem; const Name: string; Default: TDateTime): TDateTime;
function XmlGetDateParam(ANode: TXMLItem; const Name: string; Default: TDateTime): TDateTime;
function XmlGetDateTimeParam(ANode: TXMLItem; const Name: string; Default: TDateTime): TDateTime;
function XmlGetFloatParam(ANode: TXMLItem; const Name: string; Default: Extended): Extended;
function XmlGetFontStyleParam(ANode: TXMLItem; const Name: string; Default: TFontStyles): TFontStyles;
 
// ------------------------- Прочие функции --------------------
function FindNamedItem(AParentNode: TXMLItem; const Name: string; const FromIndex: Integer = 0): TXMLItem;
function ReplaceIllegalSymbols(const S: string): string;
 
implementation
 
// ---------------------- Функции преобразований -------------------------------
 
// Преобразование стилей шрифта в число
function FontStyle2Int(const AFontStyle: TFontStyles): Integer;
var
  Style: TFontStyle;
begin
  Result:= 0;
 
  for Style:= Low(TFontStyle) to High(TFontStyle) do
    if Style in AFontStyle
      then Result:= Result or (1 shl Integer(Style));
end;
 
// Преобразование числа в стили шрифта
function Int2FontStyle(const iFontStyle: Integer): TFontStyles;
var
  Style: TFontStyle;
begin
  Result:= [];
 
  for Style:= Low(TFontStyle) to High(TFontStyle) do
    if iFontStyle and (1 shl Integer(Style)) <> 0
      then Result:= Result + [Style];
end;
 
// --------------- Добавление информации в XML -----------------
procedure XmlAddStringParam(ANode: TXMLItem; const Name, Value: string);
begin
  ANode.Params.Add(Name + '=' + Value);
end;
 
procedure XmlAddIntegerParam(ANode: TXMLItem; const Name: string; const Value: Integer);
begin
  ANode.Params.Add(Name + '=' + IntToStr(Value));
end;
 
procedure XmlAddCardinalParam(ANode: TXMLItem; const Name: string; const Value: Cardinal);
begin
  ANode.Params.Add(Name + '=' + IntToHex(Value, 8));
end;
 
procedure XmlAddColorParam(ANode: TXMLItem; const Name: string; const Value: TColor);
begin
  // Запись параметра типа Param="11BBCC" (шестнадцатеричного)
  ANode.Params.Add(Name + '=' + IntToHex(Value, 8));
end;
 
procedure XmlAddBoolParam(ANode: TXMLItem; const Name: string; const Value: Boolean);
begin
  if Value
    then XmlAddStringParam(ANode, Name, '1')
    else XmlAddStringParam(ANode, Name, '0');
end;
 
procedure XmlAddTimeParam(ANode: TXMLItem; const Name: string; const Value: TDateTime);
begin
  ANode.Params.Add(Name + '=' + TimeToStr(Value));
end;
 
procedure XmlAddDateParam(ANode: TXMLItem; const Name: string; const Value: TDateTime);
begin
  ANode.Params.Add(Name + '=' + DateToStr(Value));
end;
 
procedure XmlAddDateTimeParam(ANode: TXMLItem; const Name: string; const Value: TDateTime);
begin
  ANode.Params.Add(Name + '=' + DateTimeToStr(Value));
end;
 
procedure XmlAddFloatParam(ANode: TXMLItem; const Name: string; const Value: Extended);
begin
  ANode.Params.Add(Name + '=' + FloatToStr(Value));
end;
 
procedure XmlAddFontStyleParam(ANode: TXMLItem; const Name: string; const Value: TFontStyles);
begin
  ANode.Params.Add(Name + '=' + IntToStr(FontStyle2Int(Value)));
end;
 
// ------------ Поиск и извлечение информации из XML -----------
function XmlFindParam(ANode: TXMLItem; const Name: string): Integer;
begin
  Result:= ANode.Params.IndexOfName(Name);
end;
 
function XmlFindNodeIndex(AParentNode: TXMLItem; const Name: string): Integer;
begin
  Result:= AParentNode.IndexOfName(Name);
end;
 
function XmlFindNode(AParentNode: TXMLItem; const Name: string): TXMLItem;
var
  Index: Integer;
begin
  Result:= nil;
  Index:= AParentNode.IndexOfName(Name);
  if Index <> -1
    then Result:= AParentNode.SubItems[Index];
end;
 
function XmlGetStringParam(ANode: TXMLItem; const Name, Default: string): string;
var
  Index: Integer;
begin
  Index:= XmlFindParam(ANode, Name);
  if Index <> -1
    then Result:= ANode.Params.ValueFromIndex[Index]
    else Result:= Default;
 
  if Result = '""'
    then Result:= ''; // А то парсер фигово сохраняет пустые строки PinName=""""
end;
 
function XmlGetIntegerParam(ANode: TXMLItem; const Name: string; const Default: Integer): Integer;
var
  Index: Integer;
begin
  Index:= XmlFindParam(ANode, Name);
 
  if Index = -1
    then Result:= Default
    else if not TryStrToInt(ANode.Params.ValueFromIndex[Index], Result)
           then Result:= Default;
end;
 
function XmlGetCardinalParam(ANode: TXMLItem; const Name: string; const Default: Cardinal): Cardinal;
var
  Index: Integer;
begin
  // Чтение параметра типа Param="11BBCC" (шестнадцатеричного)
  Index:= XmlFindParam(ANode, Name);
 
  if Index = -1
    then Result:= Default
    else if not TryStrToInt('$' + ANode.Params.ValueFromIndex[Index], Integer(Result))
           then Result:= Default;
end;
 
function XmlGetColorParam(ANode: TXMLItem; const Name: string; const Default: TColor): TColor;
var
  Index: Integer;
begin
  // Чтение параметра типа Param="11BBCC" (шестнадцатеричного)
  Index:= XmlFindParam(ANode, Name);
 
  if Index = -1
    then Result:= Default
    else if not TryStrToInt('$' + ANode.Params.ValueFromIndex[Index], Integer(Result))
           then Result:= Default;
end;
 
function XmlGetBoolParam(ANode: TXMLItem; const Name: string; const Default: Boolean): Boolean;
var
  Index: Integer;
begin
  Index:= XmlFindParam(ANode, Name);
 
  if Index = -1
    then Result:= Default
    else Result:= XmlGetStringParam(ANode, Name, '0') = '1';
end;
 
function XmlGetTimeParam(ANode: TXMLItem; const Name: string; Default: TDateTime): TDateTime;
var
  Index: Integer;
begin
  Index:= XmlFindParam(ANode, Name);
 
  if Index = -1
    then Result:= Default
    else if not TryStrToTime(ANode.Params.ValueFromIndex[Index], Result)
           then Result:= Default;
end;
 
function XmlGetDateParam(ANode: TXMLItem; const Name: string; Default: TDateTime): TDateTime;
var
  Index: Integer;
begin
  Index:= XmlFindParam(ANode, Name);
 
  if Index = -1
    then Result:= Default
    else if not TryStrToDate(ANode.Params.ValueFromIndex[Index], Result)
           then Result:= Default;
end;
 
function XmlGetDateTimeParam(ANode: TXMLItem; const Name: string; Default: TDateTime): TDateTime;
var
  Index: Integer;
begin
  Index:= XmlFindParam(ANode, Name);
 
  if Index = -1
    then Result:= Default
    else if not TryStrToDateTime(ANode.Params.ValueFromIndex[Index], Result)
           then Result:= Default;
end;
 
function XmlGetFloatParam(ANode: TXMLItem; const Name: string; Default: Extended): Extended;
var
  Index: Integer;
begin
  Index:= XmlFindParam(ANode, Name);
 
  if Index = -1
    then Result:= Default
    else if not TryStrToFloat(ANode.Params.ValueFromIndex[Index], Result)
           then Result:= Default;
end;
 
function XmlGetFontStyleParam(ANode: TXMLItem; const Name: string; Default: TFontStyles): TFontStyles;
var
  Index, Temp: Integer;
begin
  Index:= XmlFindParam(ANode, Name);
 
  if Index = -1
    then Result:= Default
    else if TryStrToInt(ANode.Params.ValueFromIndex[Index], Temp)
           then Result:= Int2FontStyle(Temp)
           else Result:= Default;
end;
 
// ------------------------- Прочие функции --------------------
 
// Поиск в ноде сабноды с именем Name, начиная с индекса FromIndex
function FindNamedItem(AParentNode: TXMLItem; const Name: string; const FromIndex: Integer = 0): TXMLItem;
var
  Index: Integer;
begin
  Result:= nil;
 
  for Index:= FromIndex to AParentNode.Count - 1 do
    if AParentNode.SubItems[Index].Name = Name
      then begin
             Result:= AParentNode.SubItems[Index];
             Break;
           end;
end;
 
// Замена неподходящих для XML-имён символов на "_"
function ReplaceIllegalSymbols(const S: string): string;
const
  AllowedSymbols: set of Char = ['0'..'9', 'A'..'Z', 'a'..'z',
                                 'А'..'Я', 'а'..'я', '_', '+', '-'];
var
  Index: Integer;
begin
  Result:= S;
 
  for Index:= 1 to Length(Result) do
    if not (Result[Index] in AllowedSymbols)
      then Result[Index]:= '_';
end;
 
 
end.
На главную страницу сервиса обмена кодом »