AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Projekte TfrXMLConfigFile

TfrXMLConfigFile

Ein Thema von Frühlingsrolle · begonnen am 5. Okt 2019 · letzter Beitrag vom 27. Okt 2019
Antwort Antwort
Seite 1 von 2  1 2   
Frühlingsrolle
Registriert seit: 31. Aug 2019
TfrXMLConfigFile

ist eine an INIFILES-angelehnte Delphi-Klasse die mit gleichnamigen Methoden Einstellungen in eine XML-Datei schreibt und ausliest.
Ergänzend lassen sich Werte eines Int64, TAlphaColor, TColor, TFont und TStrings hinterlegen.
Die Ausgabe ist wesentlich kompakter und übersichtlicher aufgebaut, im Gegensatz zu einer herkömmlichen INI-Datei.
Für Lazarus (FreePascal) - Projekte eignet sich die Klasse im Moment nicht auch.

Konstruktive Krtitik ist wünschenswert.
Danke für's Lesen und die anschließende Nutzung.

[#] Erweiterungen
Version 20191027
006 | Neue Methoden: ReadFontFMX(), WriteFontFmx(), 2 Überladungen von ReadColor() und WriteColor() mit dem Rückgabewert TAlphaColor(FMX).
Version 20191024
005 | Die Klasse ist nun auch FreePascal-tauglich.
004 | Neue Methoden: DateToStrEx(), StrToDateEx(), TimeToStrEx(), StrToTimeEx().
003 | Neue Eigenschaft: .SubSectionCount[].
Version 20191012
002 | Sämtliche Methoden wurden um eine SubSection erweitert. Damit lassen sich u.a. mehrere Schriftarten in einer Sektion zusammenfassen.
001 | Neue Methoden: DeleteKey(), ReadSubSections(), ReadSectionValues(), ValueExists().

[#] Korrekturen
Version 20191027
008 | Folgende Methoden wurden umbenannt:
- ReadFont() -> ReadFontVCL()
- WriteFont() -> WriteFontVCL()
Version 20191024
007 | Die Methode DateTimeToStrEx() wurde wegen der Plattformabhängigkeit überarbeitet.
006 | Die überladene ReadFont() Methode wurde überarbeitet.
005 | Die überladene ReadString() Methode liefert nun auch im Fehlerfall einen Defaultwert.
004 | Die Eigenschaft .Count wurde in .SectionCount umbenannt.
Version 20191012
003 | Die Methode DeleteSection() wurde in EraseSection() umbenannt.
002 | function ReadFont(): TFont; ist nun eine procedure ReadFont();
001 | Datum und Zeitangaben sind nach ISO 8601 formatiert.

Delphi-Quellcode:
{
  TfrXMLConfigFile

  [-] Version
        * 20191027
  [-] Author
        * Frühlingsrolle
  [-] License
        * WTFPL (http://www.wtfpl.net/about/)
  [-] Note
        * Delphi / FPC unit for storing and reading settings in XML format.
        * Works fine on Windows and Delphi(VCL & FMX).
        * Contains many warnings about implicit type conversion
          (AnsiString <> WideString) in FPC.
        * Not tested on other systems.
}


unit ufrXMLConfigFile;

{$IFNDEF MSWINDOWS}
  {$MESSAGE WARN 'Maybe it does not work on this OS.'}
{$ENDIF}

{$IFNDEF FPC}
  {$IFDEF CONDITIONALEXPRESSIONS}
    {$IF CompilerVersion > 24}  // if Delphi >= XE4
      {$LEGACYIFEND ON}         // allow $if/$ifend instead of $if/$endif
    {$IFEND}
    {$IF CompilerVersion > 22}
      {$DEFINE DELPHIxe2_UP}
    {$IFEND}
  {$ENDIF}
{$ELSE}
  {$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses
  Classes, SysUtils
  {$IFNDEF DELPHIxe2_UP}, Graphics{$ELSE}, Vcl.Graphics, FMX.Graphics, UITypes,
  UIConsts{$ENDIF}
  {$IFNDEF FPC}, XMLIntf, XMLDoc{$ELSE}, DOM, XMLWrite, XMLRead{$ENDIF};

type
  {$IFNDEF FPC}
  {$IFNDEF DELPHIxe2_UP}
  TFontVCL = Graphics.TFont;
  {$ELSE}
  TFontVCL = Vcl.Graphics.TFont;
  TFontFMX = FMX.Graphics.TFont;
  {$ENDIF}
  TfrDocument = IXMLDocument;
  TfrNode = IXMLNode;
  {$ELSE}
  TFontVCL = Graphics.TFont;
  TfrDocument = TXMLDocument;
  TfrNode = TDOMNode;
  {$ENDIF}

type
  TfrXMLConfigFile = class
  private
    FFileName: string;
    FXMLDocument: TfrDocument;
    function GetSectionCount: Integer;
    function GetSubSectionCount(const SectionName: string): Integer;
  protected
    // Date-/Time formatted after ISO 8601
    function DateTimeToStrEx(Value: TDateTime): string; virtual;
    function DateToStrEx(const Value: TDateTime): string; virtual;
    function TimeToStrEx(const Value: TDateTime): string; virtual;
    function StrToDateTimeEx(const Value: string): TDateTime; virtual;
    function StrToDateEx(const Value: string): TDateTime; virtual;
    function StrToTimeEx(const Value: string): TDateTime; virtual;
    //
    function GetVersion: Integer; virtual;
  public
    constructor Create(const AFileName: string); overload;
    constructor Create; overload;
    destructor Destroy; override;
    function ReadBoolean(const Section, Ident: string; Default: Boolean): Boolean; overload;
    function ReadBoolean(const Section, SubSection, Ident: string; Default: Boolean): Boolean; overload;
    {$IFDEF DELPHIxe2_UP}
    function ReadColor(const Section, Ident: string; Default: TAlphaColor): TAlphaColor; overload;
    function ReadColor(const Section, SubSection, Ident: string; Default: TAlphaColor): TAlphaColor; overload;
    {$ENDIF}
    function ReadColor(const Section, Ident: string; Default: TColor): TColor; overload;
    function ReadColor(const Section, SubSection, Ident: string; Default: TColor): TColor; overload;
    function ReadDate(const Section, Ident: string; Default: TDateTime): TDateTime; overload;
    function ReadDate(const Section, SubSection, Ident: string; Default: TDateTime): TDateTime; overload;
    function ReadDateTime(const Section, Ident: string; Default: TDateTime): TDateTime; overload;
    function ReadDateTime(const Section, SubSection, Ident: string; Default: TDateTime): TDateTime; overload;
    function ReadDouble(const Section, Ident: string; Default: Double): Double; overload;
    function ReadDouble(const Section, SubSection, Ident: string; Default: Double): Double; overload;
    function ReadInt64(const Section, Ident: string; Default: Int64): Int64; overload;
    function ReadInt64(const Section, SubSection, Ident: string; Default: Int64): Int64; overload;
    function ReadInteger(const Section, Ident: string; Default: Integer): Integer; overload;
    function ReadInteger(const Section, SubSection, Ident: string; Default: Integer): Integer; overload;
    function ReadString(const Section, Ident, Default: string): string; overload;
    function ReadString(const Section, SubSection, Ident, Default: string): string; overload;
    function ReadTime(const Section, Ident: string; Default: TDateTime): TDateTime; overload;
    function ReadTime(const Section, SubSection, Ident: string; Default: TDateTime): TDateTime; overload;
    function SectionExists(const Section: string): Boolean; overload;
    function SectionExists(const Section, SubSection: string): Boolean; overload;
    function ValueExists(const Section, Ident: string): Boolean; overload;
    function ValueExists(const Section, SubSection, Ident: string): Boolean; overload;
    procedure Clear;
    procedure DeleteKey(const Section, Ident: string); overload;
    procedure DeleteKey(const Section, SubSection, Ident: string); overload;
    procedure EraseSection(const Section: string); overload;
    procedure EraseSection(const Section, SubSection: string); overload;
    {$IFDEF DELPHIxe2_UP}
    procedure ReadFontFMX(const Section: string; Target, Default: TFontFMX); overload;
    procedure ReadFontFMX(const Section, SubSection: string; Target, Default: TFontFMX); overload;
    {$ENDIF}
    procedure ReadFontVCL(const Section: string; Target, Default: TFontVCL); overload;
    procedure ReadFontVCL(const Section, SubSection: string; Target, Default: TFontVCL); overload;
    procedure ReadSections(Target: TStrings);
    procedure ReadSectionValues(const Section: string; Target: TStrings); overload;
    procedure ReadSectionValues(const Section, SubSection: string; Target: TStrings); overload;
    procedure ReadStrings(const Section, Ident: string; Target: TStrings); overload;
    procedure ReadStrings(const Section, SubSection, Ident: string; Target: TStrings); overload;
    procedure ReadSubSections(const Section: string; Target: TStrings);
    procedure WriteBoolean(const Section, Ident: string; Value: Boolean); overload;
    procedure WriteBoolean(const Section, SubSection, Ident: string; Value: Boolean); overload;
    {$IFDEF DELPHIxe2_UP}
    procedure WriteColor(const Section, Ident: string; Value: TAlphaColor); overload;
    procedure WriteColor(const Section, SubSection, Ident: string; Value: TAlphaColor); overload;
    {$ENDIF}
    procedure WriteColor(const Section, Ident: string; Value: TColor); overload;
    procedure WriteColor(const Section, SubSection, Ident: string; Value: TColor); overload;
    procedure WriteDate(const Section, Ident: string; Value: TDateTime); overload;
    procedure WriteDate(const Section, SubSection, Ident: string; Value: TDateTime); overload;
    procedure WriteDateTime(const Section, Ident: string; Value: TDateTime); overload;
    procedure WriteDateTime(const Section, SubSection, Ident: string; Value: TDateTime); overload;
    procedure WriteDouble(const Section, Ident: string; Value: Double); overload;
    procedure WriteDouble(const Section, SubSection, Ident: string; Value: Double); overload;
    {$IFDEF DELPHIxe2_UP}
    procedure WriteFontFMX(const Section: string; Value: TFontFMX); overload;
    procedure WriteFontFMX(const Section, SubSection: string; Value: TFontFMX); overload;
    {$ENDIF}
    procedure WriteFontVCL(const Section: string; Value: TFontVCL); overload;
    procedure WriteFontVCL(const Section, SubSection: string; Value: TFontVCL); overload;
    procedure WriteInt64(const Section, Ident: string; Value: Int64); overload;
    procedure WriteInt64(const Section, SubSection, Ident: string; Value: Int64); overload;
    procedure WriteInteger(const Section, Ident: string; Value: Integer); overload;
    procedure WriteInteger(const Section, SubSection, Ident: string; Value: Integer); overload;
    procedure WriteString(const Section, Ident, Value: string); overload;
    procedure WriteString(const Section, SubSection, Ident, Value: string); overload;
    procedure WriteStrings(const Section, Ident: string; Value: TStrings); overload;
    procedure WriteStrings(const Section, SubSection, Ident: string; Value: TStrings); overload;
    procedure WriteTime(const Section, Ident: string; Value: TDateTime); overload;
    procedure WriteTime(const Section, SubSection, Ident: string; Value: TDateTime); overload;
    property FileName: string read FFilename;
    property SectionCount: Integer read GetSectionCount;
    property SubSectionCount[const SectionName: string]: Integer read GetSubSectionCount;
    property Version: Integer read GetVersion;
  end;

implementation

const
  FR_XML_CONFIG_FILE_VER = 20191027;


function TfrXMLConfigFile.GetSectionCount;
begin
  result := FXMLDocument.DocumentElement.ChildNodes.Count;
end;

function TfrXMLConfigFile.GetSubSectionCount(const SectionName: string): Integer;
var
  node: TfrNode;
begin
  result := 0;

  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(SectionName);
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(SectionName);
  {$ENDIF}
  if Assigned(node) then
    result := node.ChildNodes.Count;
end;

function TfrXMLConfigFile.DateTimeToStrEx(Value: TDateTime): string;
var
  fmts: TFormatSettings;
begin
  fmts.DateSeparator := '-';
  fmts.TimeSeparator := ':';
  fmts.ShortDateFormat := 'yyyy-mm-dd hh:mm:ss';
  fmts.ShortTimeFormat := 'hh:mm:ss';
  result := DateTimeToStr(Value, fmts);
end;

function TfrXMLConfigFile.DateToStrEx(const Value: TDateTime): string;
var
  fmts: TFormatSettings;
begin
  fmts.DateSeparator := '-';
  fmts.ShortDateFormat := 'yyyy-mm-dd';
  result := DateToStr(Value, fmts);
end;

function TfrXMLConfigFile.TimeToStrEx(const Value: TDateTime): string;
var
  fmts: TFormatSettings;
begin
  fmts.TimeSeparator := ':' ;
  fmts.ShortDateFormat := 'hh:mm:ss';
  result := TimeToStr(Value, fmts);
end;

function TfrXMLConfigFile.StrToDateTimeEx(const Value: string): TDateTime;
var
  fmts: TFormatSettings;
begin
  fmts.DateSeparator := '-';
  fmts.TimeSeparator := ':';
  fmts.ShortDateFormat := 'yyyy-mm-dd hh:mm:ss';
  fmts.ShortTimeFormat := 'hh:mm:ss';
  result := StrToDateTime(Value, fmts);
end;

function TfrXMLConfigFile.StrToDateEx(const Value: string): TDateTime;
var
  fmts: TFormatSettings;
begin
  fmts.DateSeparator := '-';
  fmts.ShortDateFormat := 'yyyy-mm-dd';
  result := StrToDate(Value, fmts);
end;

function TfrXMLConfigFile.StrToTimeEx(const Value: string): TDateTime;
var
  fmts: TFormatSettings;
begin
  fmts.TimeSeparator := ':' ;
  fmts.ShortDateFormat := 'hh:mm:ss';
  result := StrToTime(Value, fmts);
end;

function TfrXMLConfigFile.GetVersion: Integer;
begin
  result := FR_XML_CONFIG_FILE_VER;
end;

constructor TfrXMLConfigFile.Create(const AFileName: string);
{$IFNDEF FPC}
begin
  inherited Create;
  FXMLDocument := TXMLDocument.Create(nil);
  FXMLDocument.Options := [doNodeAutoIndent, doAttrNull];
  FXMLDocument.Active := true;
  FXMLDocument.Encoding := 'UTF-8';
  FFileName := AFileName;

  if FileExists(FFileName) then
    FXMLDocument.LoadFromFile(FFileName) else
    FXMLDocument.AddChild(ExtractFileName(ChangeFileExt(FFileName, '')));
end;
{$ELSE}
var
  rootNode: TfrNode;
begin
  inherited Create;
  FFileName := AFileName;
  if FileExists(FFileName) then
    ReadXMLFile(FXMLDocument, FFileName) else
  begin
    FXMLDocument := TXMLDocument.Create;
    rootNode := FXMLDocument.CreateElement(ExtractFileName(
                                           ChangeFileExt(FFileName, '')));
    FXMLDocument.AppendChild(rootNode);
  end;
end;
{$ENDIF}

constructor TfrXMLConfigFile.Create;
begin
  FFileName := ChangeFileExt(ParamStr(0), 'Config.xml');
  Create(FFileName);
end;

destructor TfrXMLConfigFile.Destroy;
begin
  {$IFNDEF FPC}
  FXMLDocument.SaveToFile(FFileName);
  {$ELSE}
  WriteXMLFile(FXMLDocument, FFileName);
  FXMLDocument.Free;
  {$ENDIF}
  inherited;
end;

function TfrXMLConfigFile.ReadBoolean(const Section, Ident: string;
  Default: Boolean): Boolean;
begin
  result := Boolean(ReadInteger(Section, Ident, Ord(Default)));
end;

function TfrXMLConfigFile.ReadBoolean(const Section, SubSection, Ident: string;
  Default: Boolean): Boolean;
begin
  result := Boolean(ReadInteger(Section, SubSection, Ident, Ord(Default)));
end;

{$IFDEF DELPHIxe2_UP}
function TfrXMLConfigFile.ReadColor(const Section, Ident: string;
  Default: TAlphaColor): TAlphaColor;
begin
  result := StringToAlphaColor(ReadString(Section, Ident,
                               AlphaColorToString(Default)));
end;

function TfrXMLConfigFile.ReadColor(const Section, SubSection, Ident: string;
  Default: TAlphaColor): TAlphaColor;
begin
  result := StringToAlphaColor(ReadString(Section, SubSection, Ident,
                               AlphaColorToString(Default)));
end;
{$ENDIF}

function TfrXMLConfigFile.ReadColor(const Section, Ident: string;
  Default: TColor): TColor;
begin
  result := StringToColor(ReadString(Section, Ident, ColorToString(Default)));
end;

function TfrXMLConfigFile.ReadColor(const Section, SubSection, Ident: string;
  Default: TColor): TColor;
begin
  result := StringToColor(ReadString(Section, SubSection, Ident,
                          ColorToString(Default)));
end;

function TfrXMLConfigFile.ReadDate(const Section, Ident: string;
  Default: TDateTime): TDateTime;
begin
  result := StrToDateEx(ReadString(Section, Ident, DateToStrEx(Default)));
end;

function TfrXMLConfigFile.ReadDate(const Section, SubSection, Ident: string;
  Default: TDateTime): TDateTime;
begin
  result := StrToDateEx(ReadString(Section, SubSection, Ident,
                        DateToStrEx(Default)));
end;

function TfrXMLConfigFile.ReadDateTime(const Section, Ident: string;
  Default: TDateTime): TDateTime;
begin
  result := StrToDateTimeEx(ReadString(Section, Ident,
                            DateTimeToStrEx(Default)));
end;

function TfrXMLConfigFile.ReadDateTime(const Section, SubSection, Ident: string;
  Default: TDateTime): TDateTime;
begin
  result := StrToDateTimeEx(ReadString(Section, SubSection, Ident,
                            DateTimeToStrEx(Default)));
end;

function TfrXMLConfigFile.ReadDouble(const Section, Ident: string;
  Default: Double): Double;
begin
  result := StrToFloat(ReadString(Section, Ident, FloatToStr(Default)));
end;

function TfrXMLConfigFile.ReadDouble(const Section, SubSection, Ident: string;
  Default: Double): Double;
begin
  result := StrToFloat(ReadString(Section, SubSection, Ident,
                       FloatToStr(Default)));
end;

function TfrXMLConfigFile.ReadInt64(const Section, Ident: string;
  Default: Int64): Int64;
begin
  result := StrToInt64(ReadString(Section, Ident, IntToStr(Default)));
end;

function TfrXMLConfigFile.ReadInt64(const Section, SubSection, Ident: string;
  Default: Int64): Int64;
begin
  result := StrToInt64(ReadString(Section, SubSection, Ident,
                       IntToStr(Default)));
end;

function TfrXMLConfigFile.ReadInteger(const Section, Ident: string;
  Default: Integer): Integer;
begin
  result := StrToInt(ReadString(Section, Ident, IntToStr(Default)));
end;

function TfrXMLConfigFile.ReadInteger(const Section, SubSection, Ident: string;
  Default: Integer): Integer;
begin
  result := StrToInt(ReadString(Section, SubSection, Ident, IntToStr(Default)));
end;

function TfrXMLConfigFile.ReadString(const Section, Ident,
  Default: string): string;
var
  node: TfrNode;
begin
  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);

  FXMLDocument.DocumentElement.ChildNodes.BeginUpdate;
  if Assigned(node) and node.HasAttribute(Ident) then
    result := node.Attributes[Ident] else
    result := Default;
  FXMLDocument.DocumentElement.ChildNodes.EndUpdate;
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(WideString(Section));

  if Assigned(node) and TDOMElement(node).hasAttribute((Ident)) then
    result := TDOMElement(node).GetAttribute(Ident) else
    result := Default;
  {$ENDIF}
end;

function TfrXMLConfigFile.ReadString(const Section, SubSection, Ident,
  Default: string): string;
var
  node: TfrNode;
begin
  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);
  if Assigned(node) then
  begin
    node := node.ChildNodes.FindNode(SubSection);

    FXMLDocument.DocumentElement.ChildNodes.BeginUpdate;
    if Assigned(node) and node.HasAttribute(Ident) then
      result := node.Attributes[Ident] else
      result := Default;
    FXMLDocument.DocumentElement.ChildNodes.EndUpdate;
  end else
    result := Default;
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(Section);
  if Assigned(node) then
  begin
    node := node.FindNode(SubSection);

    if Assigned(node) and TDOMElement(node).hasAttribute(Ident) then
      result := TDOMElement(node).GetAttribute(Ident) else
      result := Default;
  end else
    result := Default;
  {$ENDIF}
end;

function TfrXMLConfigFile.ReadTime(const Section, Ident: string;
  Default: TDateTime): TDateTime;
begin
  result := StrToTimeEx(ReadString(Section, Ident, TimeToStrEx(Default)));
end;

function TfrXMLConfigFile.ReadTime(const Section, SubSection, Ident: string;
  Default: TDateTime): TDateTime;
begin
  result := StrToTimeEx(ReadString(Section, SubSection, Ident,
                        TimeToStrEx(Default)));
end;

function TfrXMLConfigFile.SectionExists(const Section: string): Boolean;
begin
  {$IFNDEF FPC}
  result := Assigned(FXMLDocument.DocumentElement.ChildNodes.FindNode(Section));
  {$ELSE}
  result := Assigned(FXMLDocument.DocumentElement.FindNode(Section));
  {$ENDIF}
end;

function TfrXMLConfigFile.SectionExists(const Section,
  SubSection: string): Boolean;
var
  node: TfrNode;
begin
  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);
  if Assigned(node) then
    node := node.ChildNodes.FindNode(SubSection);
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(Section);
  if Assigned(node) then
    node := node.FindNode(SubSection);
  {$ENDIF}

  result := Assigned(node);
end;

function TfrXMLConfigFile.ValueExists(const Section, Ident: string): Boolean;
var
  node: TfrNode;
begin
  result := false;

  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);
  if Assigned(node) then
    result := node.HasAttribute(Ident);
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(Section);
  if Assigned(node) then
    result := TDOMElement(node).hasAttribute(Ident);
  {$ENDIF}
end;

function TfrXMLConfigFile.ValueExists(const Section, SubSection,
  Ident: string): Boolean;
var
  node: TfrNode;
begin
  result := false;

  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);
  if Assigned(node) then
  begin
    node := node.ChildNodes.FindNode(SubSection);
    if Assigned(node) then
      result := node.HasAttribute(Ident);
  end;
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(Section);
  if Assigned(node) then
  begin
    node := node.FindNode(SubSection);
    if Assigned(node) then
      result := TDOMElement(node).hasAttribute(Ident);
  end;
  {$ENDIF}
end;

procedure TfrXMLConfigFile.Clear;
{$IFNDEF FPC}
begin
  FXMLDocument.DocumentElement.ChildNodes.Clear;
end;
{$ELSE}
var
  node: TfrNode;
begin
  while true do
  begin
    node := FXMLDocument.DocumentElement.ChildNodes[0];
    if not Assigned(node) then
      break;
    FxmlDocument.DocumentElement.RemoveChild(node);
  end;
end;
{$ENDIF}

procedure TfrXMLConfigFile.DeleteKey(const Section, Ident: string);
var
  node: TfrNode;
begin
  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);

  if Assigned(node) then
    node.AttributeNodes.Delete(Ident);
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(Section);

  if Assigned(node) and TDOMElement(node).hasAttribute(Ident) then
    TDOMElement(node).RemoveAttribute(Ident);
  {$ENDIF}
end;

procedure TfrXMLConfigFile.DeleteKey(const Section, SubSection, Ident: string);
var
  node: TfrNode;
begin
  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);
  if Assigned(node) then
  begin
    node := node.ChildNodes.FindNode(SubSection);

    if Assigned(node) and node.HasAttribute(Ident) then
      node.AttributeNodes.Delete(Ident);
  end;
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(Section);
  if Assigned(node) then
  begin
    node := node.FindNode(SubSection);

    if Assigned(node) and TDOMElement(node).hasAttribute(Ident) then
      TDOMElement(node).RemoveAttribute(Ident);
  end;
  {$ENDIF}
end;

procedure TfrXMLConfigFile.EraseSection(const Section: string);
var
  node: TfrNode;
begin
  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);

  if Assigned(node) then
    FXMLDocument.DocumentElement.ChildNodes.Remove(node);
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(Section);

  if Assigned(node) then
    FXMLDocument.DocumentElement.RemoveChild(node);
  {$ENDIF}
end;

procedure TfrXMLConfigFile.EraseSection(const Section, SubSection: string);
var
  node, subNode: TfrNode;
begin
  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);
  if Assigned(node) then
  begin
    subNode := node.ChildNodes.FindNode(SubSection);

    if Assigned(subNode) then
      node.ChildNodes.Remove(subNode);
  end;
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(Section);
  if Assigned(node) then
  begin
    subNode := node.FindNode(SubSection);

    if Assigned(subNode) then
      node.RemoveChild(subNode);
  end;
  {$ENDIF}
end;

{$IFDEF DELPHIxe2_UP}
procedure TfrXMLConfigFile.ReadFontFMX(const Section: string;
  Target, Default: TFontFMX);
begin
  if not Assigned(Target) then
    Exit;
  if not Assigned(Default) then
  begin
    Target.Family := ReadString(Section, 'FontName', 'Segoe UI');
    Target.Size := ReadDouble(Section, 'FontSize', 20);
    Target.Style := TFontStyles(Byte(ReadInteger(Section, 'FontStyle', 0)));
  end else
  begin
    Target.Family := ReadString(Section, 'FontName', Default.Family);
    Target.Size := ReadDouble(Section, 'FontSize', Default.Size);
    Target.Style := TFontStyles(Byte(ReadInteger(Section, 'FontStyle',
                                     Byte(Default.Style))));
  end;
end;

procedure TfrXMLConfigFile.ReadFontFMX(const Section, SubSection: string;
  Target, Default: TFontFMX);
begin
  if not Assigned(Target) then
    Exit;

  if not Assigned(Default) then
  begin
    Target.Family := ReadString(Section, SubSection, 'FontName', 'Segoe UI');
    Target.Size := ReadDouble(Section, SubSection, 'FontSize', 12);
    Target.Style := TFontStyles(Byte(ReadInteger(Section, SubSection,
                                    'FontStyle', 0)));
  end else
  begin
    Target.Family := ReadString(Section, SubSection, 'FontName',
                     Default.Family);
    Target.Size := ReadDouble(Section, SubSection, 'FontSize', Default.Size);
    Target.Style := TFontStyles(Byte(ReadInteger(Section, SubSection,
                                     'FontStyle', Byte(Default.Style))));
  end;
end;
{$ENDIF}

procedure TfrXMLConfigFile.ReadFontVCL(const Section: string;
  Target, Default: TFontVCL);
begin
  if not Assigned(Target) then
    Exit;

  if not Assigned(Default) then
  begin
    Target.Charset := TFontCharSet(ReadInteger(Section, 'Charset', 0));
    Target.Color := ReadColor(Section, 'FontColor', clWindowText);
    Target.Name := ReadString(Section, 'FontName', 'Tahoma');
    Target.Size := ReadInteger(Section, 'FontSize', 8);
    {$IFNDEF FPC}
    Target.Style := TFontStyles(Byte(ReadInteger(Section, 'FontStyle', 0)));
    {$ELSE}
    Target.Style := TFontStyles(ReadInteger(Section, 'FontStyle', 0));
    {$ENDIF}
  end else
  begin
    Target.Charset := TFontCharSet(ReadInteger(Section, 'Charset',
                                   Default.Charset));
    Target.Color := ReadColor(Section, 'FontColor', Default.Color);
    Target.Name := ReadString(Section, 'FontName', Default.Name);
    Target.Size := ReadInteger(Section, 'FontSize', Default.Size);
    {$IFNDEF FPC}
    Target.Style := TFontStyles(Byte(ReadInteger(Section, 'FontStyle',
                                     Byte(Default.Style))));
    {$ELSE}
    Target.Style := TFontStyles(ReadInteger(Section, 'FontStyle',
                                Integer(Default.Style)));
    {$ENDIF}
  end;
end;

procedure TfrXMLConfigFile.ReadFontVCL(const Section, SubSection: string;
  Target, Default: TFontVCL);
begin
  if not Assigned(Target) then
    Exit;

  if not Assigned(Default) then
  begin
    Target.Color := ReadColor(Section, SubSection, 'FontColor', clWindowText);
    Target.Name := ReadString(Section, SubSection, 'FontName', 'Tahoma');
    Target.Size := ReadInteger(Section, SubSection, 'FontSize', 8);
    {$IFNDEF FPC}
    Target.Style := TFontStyles(Byte(ReadInteger(Section, SubSection,
                                     'FontStyle', 0)));
    {$ELSE}
    Target.Style := TFontStyles(ReadInteger(Section, SubSection,
                                'FontStyle', 0));
    {$ENDIF}
  end else
  begin
    Target.Color := ReadColor(Section, SubSection, 'FontColor', Default.Color);
    Target.Name := ReadString(Section, SubSection, 'FontName', Default.Name);
    Target.Size := ReadInteger(Section, SubSection, 'FontSize', Default.Size);
    {$IFNDEF FPC}
    Target.Style := TFontStyles(Byte(ReadInteger(Section, SubSection,
                                     'FontStyle', Byte(Default.Style))));
    {$ELSE}
    Target.Style := TFontStyles(ReadInteger(Section, SubSection, 'FontStyle',
                                Integer(Default.Style)));
    {$ENDIF}
  end;
end;

procedure TfrXMLConfigFile.ReadSections(Target: TStrings);
var
  node: TfrNode;
  i: Integer;
begin
  if not Assigned(Target) then
    Exit;

  node := FXMLDocument.DocumentElement;

  Target.BeginUpdate;
  for i := 0 to node.ChildNodes.Count - 1 do
    Target.Add(node.ChildNodes[i].NodeName);
  Target.EndUpdate;
end;

procedure TfrXMLConfigFile.ReadSectionValues(const Section: string;
  Target: TStrings);
var
  node: TfrNode;
  i, nodeCount: Integer;
begin
  if not Assigned(Target) then
    Exit;

  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);
  if Assigned(node) then
  begin
    nodeCount := node.AttributeNodes.Count;

    Target.BeginUpdate;
    for i := 0 to nodeCount - 1 do
      Target.Add(node.AttributeNodes[i].Text);
    Target.EndUpdate;
  end;
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(Section);
  if Assigned(node) then
  begin
    nodeCount := node.Attributes.Length;

    Target.BeginUpdate;
    for i := 0 to nodeCount - 1 do
      Target.Add(node.Attributes[i].TextContent);
    Target.EndUpdate;
  end;
  {$ENDIF}
end;

procedure TfrXMLConfigFile.ReadSectionValues(const Section, SubSection: string;
  Target: TStrings);
var
  node: TfrNode;
  i, nodeCount: Integer;
begin
  if not Assigned(Target) then
    Exit;

  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);
  if Assigned(node) then
  begin
    node := node.ChildNodes.FindNode(SubSection);
    if Assigned(node) then
    begin
      nodeCount := node.AttributeNodes.Count;

      Target.BeginUpdate;
      for i := 0 to nodeCount - 1 do
        Target.Add(node.AttributeNodes[i].Text);
      Target.EndUpdate;
    end;
  end;
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(Section);
  if Assigned(node) then
  begin
    node := node.FindNode(SubSection);
    if Assigned(node) then
    begin
      nodeCount := node.Attributes.Length;

      Target.BeginUpdate;
      for i := 0 to nodeCount - 1 do
        Target.Add(node.Attributes[i].TextContent);
      Target.EndUpdate;
    end;
  end;
  {$ENDIF}
end;

procedure TfrXMLConfigFile.ReadStrings(const Section, Ident: string;
  Target: TStrings);
begin
  if not Assigned(Target) then
    Exit;

  Target.BeginUpdate;
  Target.CommaText := ReadString(Section, Ident, '');
  Target.EndUpdate;
end;

procedure TfrXMLConfigFile.ReadStrings(const Section, SubSection, Ident: string;
  Target: TStrings);
begin
  if not Assigned(Target) then
    Exit;

  Target.BeginUpdate;
  Target.CommaText := ReadString(Section, SubSection, Ident, '');
  Target.EndUpdate;
end;

procedure TfrXMLConfigFile.ReadSubSections(const Section: string;
  Target: TStrings);
var
  node: TfrNode;
  i: Integer;
begin
  if not Assigned(Target) then
    Exit;

  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(Section);
  {$ENDIF}
  if Assigned(node) then
  begin
    Target.BeginUpdate;
    for i := 0 to node.ChildNodes.Count - 1 do
      Target.Add(node.ChildNodes[i].NodeName);
    Target.EndUpdate;
  end;
end;

procedure TfrXMLConfigFile.WriteBoolean(const Section, Ident: string;
  Value: Boolean);
begin
  WriteString(Section, Ident, IntToStr(Ord(Value)));
end;

procedure TfrXMLConfigFile.WriteBoolean(const Section, SubSection,
  Ident: string; Value: Boolean);
begin
  WriteString(Section, SubSection, Ident, IntToStr(Ord(Value)));
end;

{$IFDEF DELPHIxe2_UP}
procedure TfrXMLConfigFile.WriteColor(const Section, Ident: string;
  Value: TAlphaColor);
begin
  WriteString(Section, Ident, AlphaColorToString(Value));
end;

procedure TfrXMLConfigFile.WriteColor(const Section, SubSection, Ident: string;
  Value: TAlphaColor);
begin
  WriteString(Section, SubSection, Ident, AlphaColorToString(Value));
end;
{$ENDIF}

procedure TfrXMLConfigFile.WriteColor(const Section, Ident: string;
  Value: TColor);
begin
  WriteString(Section, Ident, ColorToString(Value));
end;

procedure TfrXMLConfigFile.WriteColor(const Section, SubSection, Ident: string;
  Value: TColor);
begin
  WriteString(Section, SubSection, Ident, ColorToString(Value));
end;

procedure TfrXMLConfigFile.WriteDate(const Section, Ident: string;
  Value: TDateTime);
begin
  WriteString(Section, Ident, DateToStrEx(Value));
end;

procedure TfrXMLConfigFile.WriteDate(const Section, SubSection, Ident: string;
  Value: TDateTime);
begin
  WriteString(Section, SubSection, Ident, DateToStrEx(Value));
end;

procedure TfrXMLConfigFile.WriteDateTime(const Section, Ident: string;
  Value: TDateTime);
begin
  WriteString(Section, Ident, DateTimeToStrEx(Value));
end;

procedure TfrXMLConfigFile.WriteDateTime(const Section, SubSection,
  Ident: string; Value: TDateTime);
begin
  WriteString(Section, SubSection, Ident, DateTimeToStrEx(Value));
end;

procedure TfrXMLConfigFile.WriteDouble(const Section, Ident: string;
  Value: Double);
begin
  WriteString(Section, Ident, FloatToStr(Value));
end;

procedure TfrXMLConfigFile.WriteDouble(const Section, SubSection, Ident: string;
  Value: Double);
begin
  WriteString(Section, SubSection, Ident, FloatToStr(Value));
end;

{$IFDEF DELPHIxe2_UP}
procedure TfrXMLConfigFile.WriteFontFMX(const Section: string;
  Value: TFontFMX);
begin
  if not Assigned(Value) then
    Exit;

  WriteString(Section, 'FontName', Value.Family);
  WriteDouble(Section, 'FontSize', Value.Size);
  WriteInteger(Section, 'FontStyle', Byte(Value.Style));
end;

procedure TfrXMLConfigFile.WriteFontFMX(const Section, SubSection: string;
  Value: TFontFMX);
begin
  if not Assigned(Value) then
    Exit;

  WriteString(Section, SubSection, 'FontName', Value.Family);
  WriteDouble(Section, SubSection, 'FontSize', Value.Size);
  WriteInteger(Section, SubSection, 'FontStyle', Byte(Value.Style));
end;
{$ENDIF}

procedure TfrXMLConfigFile.WriteFontVCL(const Section: string;
  Value: TFontVCL);
begin
  if not Assigned(Value) then
    Exit;

  WriteInteger(Section, 'Charset', Value.Charset);
  WriteColor(Section, 'FontColor', Value.Color);
  WriteString(Section, 'FontName', Value.Name);
  WriteInteger(Section, 'FontSize', Value.Size);
  {$IFNDEF FPC}
  WriteInteger(Section, 'FontStyle', Byte(Value.Style));
  {$ELSE}
  WriteInteger(Section, 'FontStyle', Integer(Value.Style));
  {$ENDIF}
end;

procedure TfrXMLConfigFile.WriteFontVCL(const Section, SubSection: string;
  Value: TFontVCL);
begin
  if not Assigned(Value) then
    Exit;

  WriteInteger(Section, SubSection, 'Charset', Value.Charset);
  WriteColor(Section, SubSection, 'FontColor', Value.Color);
  WriteString(Section, SubSection, 'FontName', Value.Name);
  WriteInteger(Section, SubSection, 'FontSize', Value.Size);
  {$IFNDEF FPC}
  WriteInteger(Section, SubSection, 'FontStyle', Byte(Value.Style));
  {$ELSE}
  WriteInteger(Section, SubSection, 'FontStyle', Integer(Value.Style));
  {$ENDIF}
end;

procedure TfrXMLConfigFile.WriteInt64(const Section, Ident: string;
  Value: Int64);
begin
  WriteString(Section, Ident, IntToStr(Value));
end;

procedure TfrXMLConfigFile.WriteInt64(const Section, SubSection, Ident: string;
  Value: Int64);
begin
  WriteString(Section, SubSection, Ident, IntToStr(Value));
end;

procedure TfrXMLConfigFile.WriteInteger(const Section, Ident: string;
  Value: Integer);
begin
  WriteString(Section, Ident, IntToStr(Value));
end;

procedure TfrXMLConfigFile.WriteInteger(const Section, SubSection,
  Ident: string; Value: Integer);
begin
  WriteString(Section, SubSection, Ident, IntToStr(Value));
end;

procedure TfrXMLConfigFile.WriteString(const Section, Ident, Value: string);
var
  node: TfrNode;
begin
  {$IFNDEF FPC}
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);
  if not Assigned(node) then
    node := FXMLDocument.DocumentElement.AddChild(Section);

  node.Attributes[Ident] := Value;
  {$ELSE}
  node := FXMLDocument.DocumentElement.FindNode(Section);
  if not Assigned(node) then
    node := FXMLDocument.CreateElement(Section);

  TDOMElement(node)[Ident] := Value;
  FXMLDocument.DocumentElement.AppendChild(node);
  {$ENDIF}
end;

procedure TfrXMLConfigFile.WriteString(const Section, SubSection, Ident,
  Value: string);
var
  node, subNode: TfrNode;
begin
  {$IFNDEF FPC}
  // Add Section
  node := FXMLDocument.DocumentElement.ChildNodes.FindNode(Section);
  if not Assigned(node) then
    node := FXMLDocument.DocumentElement.AddChild(Section);
  // Add SubSection
  subNode := node.ChildNodes.FindNode(SubSection);
  if not Assigned(subNode) then
    subNode := node.AddChild(SubSection);

  subNode.Attributes[Ident] := Value;
  {$ELSE}
  // Add Section
  node := FXMLDocument.DocumentElement.FindNode(Section);
  if not Assigned(node) then
    node := FXMLDocument.CreateElement(Section);
  // Add SubSection
  subNode := node.FindNode(SubSection);
  if not Assigned(subNode) then
    subNode := FXMLDocument.CreateElement(SubSection);

  TDOMElement(subNode)[Ident] := Value;
  node.AppendChild(subNode);
  FXMLDocument.DocumentElement.AppendChild(node);
  {$ENDIF}
end;

procedure TfrXMLConfigFile.WriteStrings(const Section, Ident: string;
  Value: TStrings);
begin
  WriteString(Section, Ident, Value.CommaText);
end;

procedure TfrXMLConfigFile.WriteStrings(const Section, SubSection,
  Ident: string; Value: TStrings);
begin
  WriteString(Section, SubSection, Ident, Value.CommaText);
end;

procedure TfrXMLConfigFile.WriteTime(const Section, Ident: string;
  Value: TDateTime);
begin
  WriteString(Section, Ident, TimeToStrEx(Value));
end;

procedure TfrXMLConfigFile.WriteTime(const Section, SubSection, Ident: string;
  Value: TDateTime);
begin
  WriteString(Section, SubSection, Ident, TimeToStrEx(Value));
end;

end.

Geändert von Frühlingsrolle (27. Okt 2019 um 05:59 Uhr)
 
Der schöne Günther

 
Delphi 10 Seattle Enterprise
 
#2
  Alt 5. Okt 2019, 09:37
Sieht interessant aus.

1. Compiler-Warnung dass im implementation-Abschnitt ein "uses System.UITypes" fehlt

2. In der Doku sollte vermerkt werden dass man das zurückgegebene TFont nicht für sich selbst verwenden oder gar freigeben darf - Sehe ich das richtig?

3. Hätte es die Möglichkeit gegeben das als Unterklasse von TCustomIniFile zu realisieren? Dann wäre es zuweisungskompatibel zu bereits vorhandenem Quelltext.
  Mit Zitat antworten Zitat
HolgerX

 
Delphi 6 Professional
 
#3
  Alt 5. Okt 2019, 14:11
Hmm..

Delphi-Quellcode:
procedure TfrXMLConfigFile.WriteDate(const Section, Ident: string;
  Value: TDateTime);
begin
  WriteString(Section, Ident, DateToStr(Value));
end;

procedure TfrXMLConfigFile.WriteDateTime(const Section, Ident: string;
  Value: TDateTime);
begin
  WriteString(Section, Ident, DateTimeToStr(Value));
end;

Bitte: Niemals ein File, gerade XML, mit DateTimeToStr oder DateToStr...
Stelle mal zwischen Schreiben und Laden dein lokales Datumsformat um und es knallt...

Verwende Routinen, welche das Datum im ISO-Format als String erzeugen/lesen, somit ist es gleich, mit welcher Spracheinstellung geschrieben/gelesen wird..
  Mit Zitat antworten Zitat
Benutzerbild von Uwe Raabe
Uwe Raabe

 
Delphi 10.3 Rio
 
#4
  Alt 5. Okt 2019, 14:14
Verwende Routinen, welche das Datum im ISO-Format als String erzeugen/lesen, somit ist es gleich, mit welcher Spracheinstellung geschrieben/gelesen wird..
Z.B. DateToISO8601 und ISO8601ToDate aus System.DateUtils...
Uwe Raabe
  Mit Zitat antworten Zitat
Frühlingsrolle
 
#5
  Alt 5. Okt 2019, 14:37
Danke für dein Interesse!

@ Der schöne Günther

1. Die Compiler-Warnung ist nicht schlimm. Ich nehme an, dass die Unit UITypes ab Delphi2010 eingeführt wurde sowie einige Typdefinitionen nach dort verschoben wurden.
Mit einem entsprechenden Compilerschalter lässt sich die Warnung beheben.

2. Du hast recht, man sollte darauf hinweisen.
Ich wüsste jedoch nicht, wer darauf käme die Methode ReadFont().Free; auf die Weise freizugeben.
Anwenden kann man es prinzipiell so:
Delphi-Quellcode:
// Variante 1
var
  frXML: TfrXMLConfigFile;
  f: TFont;
begin
  frXML := TfrXMLConfigFile.Create;
  try
    f := frXML.ReadFont('Sektion', nil);
    self.Font.Assign(f);
  finally
    frXML.Free;
  end;
end;

// Variante 2
var
  frXML: TfrXMLConfigFile;
  f: TFont;
begin
  frXML := TfrXMLConfigFile.Create;
  try
    f := TFont.Create;
    try
      f.Assign(frXML.ReadFont('Sektion', nil));
      self.Font.Assign(f);
    finally
      f.Free;
    end;
  finally
    frXML.Free;
  end;
end;

// Variante 3
var
  frXML: TfrXMLConfigFile;
begin
  frXML := TfrXMLConfigFile.Create;
  try
    self.Font.Assign(frXML.ReadFont('Sektion', nil));
  finally
    frXML.Free;
  end;
end;
3. Es wäre möglich gewesen von der abstrakten Klasse TCustomIniFile abzuleiten.
Ich habe es nicht getan, weil mit mehr Abhängigkeiten mehr Fehler entstehen - mit jeder neuen Delphi-Version.
Außerdem sehe ich auch keinen Vorteil darin.
Vollständigkeitshalber könnte man auch hier eine abstrakte Klasse bereitstellen, wenn es Gründe gebe, mehr als eine Klasse davon abzuleiten.

@ HolgerX @ Uwe Raabe

Das sind gute Hinweise!
Gibt es etwas Vergleichbares für ältere Delphi-Versionen (< Delphi2010) um dies umzusetzen?
Mir fällt spontan ein Encode/DecodeDateTime() u.ä.
  Mit Zitat antworten Zitat
HolgerX

 
Delphi 6 Professional
 
#6
  Alt 5. Okt 2019, 16:35
Hmm..

Für TFont würde ich eine Alternative vorschlagen:

procedure TfrXMLConfigFile.ReadFont(const Section: string; ATarget : TFont; Default: TFont);

Sprich:

Delphi-Quellcode:
procedure TfrXMLConfigFile.ReadFont(const Section: string; ATarget : TFont; Default: TFont);
begin
  if Assigned(Default) then
  begin
    ATarget .Color := ReadColor(Section, 'FontColor', Default.Color);
    ATarget .Name := ReadString(Section, 'FontName', Default.Name);
    ATarget .Size := ReadInteger(Section, 'FontSize', Default.Size);
    ATarget .Style := TFontStyles(Byte(ReadInteger(Section, 'FontStyle',
                                                Byte(Default.Style))));
  end else
  begin
    ATarget .Color := ReadColor(Section, 'FontColor', clWindowText);
    ATarget .Name := ReadString(Section, 'FontName', 'Tahoma');
    ATarget .Size := ReadInteger(Section, 'FontSize', 8);
    ATarget .Style := TFontStyles(Byte(ReadInteger(Section, 'FontStyle', 0)));
  end;
end;
Es ist immer besser, dass das zu füllende Object von dem erstellt wird, der es auch verwendet und Freigibt.

Das .Assign(frXML.ReadFont('Sektion', nil)) finde ich unsauber, da man nicht direkt erkennt, wer der Owner von dem zurückgegebenen Objekt ist.

Geändert von HolgerX ( 5. Okt 2019 um 16:37 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Uwe Raabe
Uwe Raabe

 
Delphi 10.3 Rio
 
#7
  Alt 5. Okt 2019, 18:05
3. Es wäre möglich gewesen von der abstrakten Klasse TCustomIniFile abzuleiten.
Ich habe es nicht getan, weil mit mehr Abhängigkeiten mehr Fehler entstehen - mit jeder neuen Delphi-Version.
Außerdem sehe ich auch keinen Vorteil darin.
Nun, der Vorteil ergibt sich dann, wenn man einen Haufen Routinen hat, die ein TCustomIniFile als Parameter erwarten.

Was die schon bestehenden Abhängigkeiten betrifft, sehe ich die von Vcl.Forms und Vcl.Graphics wesentlich skeptischer als eine von System.Inifiles. Gerade für neuere Delphi-Versionen macht es deine Lösung für FMX-Anwendungen eher unbrauchbar. Das Schreiben und Lesen von Konfigurationsdateien sollte von dem verwendeten Framework doch unabhängig sein, oder?
Uwe Raabe
  Mit Zitat antworten Zitat
Frühlingsrolle
 
#8
  Alt 5. Okt 2019, 18:49
@ HolgerX

Genehmigt.

@ Uwe Raabe

Ich werde über TCustomIniFile nachdenken.
Um eine Abhängigkeit von Vcl.Forms und Vcl.Graphics komme ich nicht drum herum.
Forms.Application wird zum Erzeugen eines TXmlDocument-Objektes in Delphi übergeben (in FreePascal wäre es nicht nötig), und für die Schrift wird nunmal Graphics.TFont benötigt.
Das Projekt auch noch FMX-tauglich zu machen, wird nicht möglich sein. Dafür gibt es keine eindeutigen Compilerschalter für Fallunterscheidungen zwischen VCL und FMX.
Sobald innerhalb eines VCL-Projektes eine FMX-Unit in der uses-Klausel aufgenommen wird, wird das Projekt als FMX erkannt.
Ja, ich habe auch einen Beitrag (von dir) darüber gelesen, wie man ein Manifest entsprechend bereitstellen soll - getestet habe ich es jedoch nicht.
Und um eine quasi-unabhängige Klasse bereitzustellen, die überall funktioniert, müsste ich das Rad neu erfinden.
Der Aufwand ist es nicht wert.
  Mit Zitat antworten Zitat
Benutzerbild von Uwe Raabe
Uwe Raabe

 
Delphi 10.3 Rio
 
#9
  Alt 5. Okt 2019, 23:47
Um eine Abhängigkeit von Vcl.Forms und Vcl.Graphics komme ich nicht drum herum.
Das ist ohne großen Aufwand möglich!

Forms.Application wird zum Erzeugen eines TXmlDocument-Objektes in Delphi übergeben (in FreePascal wäre es nicht nötig),
Application.Exename ist am Ende auch nichts anderes als ein ParamStr(0) und dafür braucht es keine Vcl.Forms.

und für die Schrift wird nunmal Graphics.TFont benötigt.
Das ist nur dann der Fall, wenn die Methoden zum Lesen und Schreiben des Fonts in die ConfigFile-Klasse gepresst werden. Das ließe sich auch durch einen externen Wrapper oder Class-Helper realisieren, der dann für VCL und FMX in geeigneter Weise und in separaten Units implementiert wird, die dann von den einzelnen Projekten nach Bedarf verwendet werden.

Die aktuelle Implementierung der Font-Methoden in TfrXMLConfigFile ist sowieso reichlich eingeschränkt, da pro Section nur ein Font verwaltet werden kann. Das wird in realen Programmen vermutlich nur selten ausreichen.

Für Read-/WriteColor reicht übrigens auch die Verwendung von System.UITypes - zumindest in einigermaßen aktuellen Delphi-Versionen.

Übrigens:
Zitat:
ist eine an INIFILES-angelehnte Delphi-Klasse die mit gleichnamigen Methoden Einstellungen in eine XML-Datei schreibt und ausliest.
Wenn schon gleichnamige Methoden, dann auch EraseSection und nicht DeleteSection. Ebenso vermisse ich ein DeleteKey, ReadSectionValues und ValueExists. Von Read-/WriteBinaryStream und ReadSubSections sowie das Handling von "\" zum hierarchischen Aufbau der SubSections ganzu zu schweigen. Gerade bei XML sollte letzteres doch ein lohnendes Feature sein.
Uwe Raabe
  Mit Zitat antworten Zitat
Frühlingsrolle
 
#10
  Alt 13. Okt 2019, 18:46
Neue Version: 20191012
Erweiterungen und Korrekturen, siehe 1. Beitrag.
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2   

Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es 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

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:15 Uhr.
Powered by vBulletin® Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2019 by Daniel R. Wolf