[VCL] TConfFile, Une alternative aux fichiers INI.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
object TMachin
  Text = 'Texte de Machine'
  Strings.Strings = (
    'Texte N'#176'1 de la Liste'
    'Texte N'#176'2 de la Liste'
    'Texte N'#176'3 de la Liste'
    'Texte N'#176'4 de la Liste'
    'Texte N'#176'5 de la Liste')
  Bidule.Font.Charset = DEFAULT_CHARSET
  Bidule.Font.Color = clWindowText
  Bidule.Font.Height = -11
  Bidule.Font.Name = 'Tahoma'
  Bidule.Font.Style = []
  Truc.Chose.Value = 666
  Truc.Text = 'Texte du Truc dans Machine'
end

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses Config, SampleComponentToString;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  Machin: TMachin;
  S: string;
  I: Integer;
begin
  Machin := TMachin.Create(nil);
  try
    Machin.Text := 'Texte de Machine';
    for I := 1 to 5 do
      Machin.Strings.Add(Format('Texte N°%d de la Liste', [i]));
    Machin.Truc.Text := 'Texte du Truc dans Machine';
    Machin.Truc.Chose.Value := 666;
    Machin.Bidule.Font := Self.Font;
 
    S := ComponentToStringProc(Machin);
  finally
    Machin.Free();
  end;
 
  ShowMessage(S);
 
  Machin := StringToComponentProc(S) as TMachin;
  try
    ShowMessage(Machin.Text + sLineBreak + Machin.Truc.Text + sLineBreak + Machin.Truc.Chose.Value.ToString() + sLineBreak + Machin.Strings.Text);
    ShowMessage(Machin.Bidule.Font.Name);
  finally
    Machin.Free();
  end;
end;
 
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
 
unit Config;
 
interface
 
uses
  System.Classes, Vcl.Graphics;
 
type
  TMachin = class(TComponent)
  public
    type
      TBidule = class(TComponent)
      private
        FFont: TFont;
        procedure SetFont(const Value: TFont);
      public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy(); override;
      published
        property Font: TFont read FFont write SetFont;
      end;
      TTruc = class(TComponent)
      private
        type
          TChose = class(TComponent)
          private
            FValue: Integer;
          published
            property Value: Integer read FValue write FValue;
          end;
      private  private
        FChose: TChose;
        FText: string;
      public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy(); override;
      published
        property Chose: TChose read FChose;
        property Text: string read FText write FText;
      end;
  private
    FText: string;
    FStrings: TStrings;
    FBidule: TBidule;
    FTruc: TTruc;
  protected
    procedure SetStrings(const Value: TStrings);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;
  published
    property Text: string read FText write FText;
    property Strings: TStrings read FStrings write SetStrings;
    property Bidule: TBidule read FBidule;
    property Truc: TTruc read FTruc;
  end;
 
 
implementation
 
uses
  System.SysUtils;
 
{ TMachin }
 
constructor TMachin.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
 
  FBidule := TBidule.Create(Self);
  FTruc := TTruc.Create(Self);
 
  FStrings := TStringList.Create();
 
  FBidule.SetSubComponent(True);
  FTruc.SetSubComponent(True);
end;
 
destructor TMachin.Destroy();
begin
  FreeAndNil(FStrings);
 
  FTruc := nil;
  FBidule := nil;
 
  inherited Destroy();
end;
 
procedure TMachin.SetStrings(const Value: TStrings);
begin
  FStrings.Assign(Value);
end;
 
 
{ TMachin.TTruc }
 
constructor TMachin.TTruc.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
 
  FChose := TChose.Create(Self);
 
  FChose.SetSubComponent(True);
end;
 
destructor TMachin.TTruc.Destroy();
begin
  FChose := nil;
 
  inherited Destroy();
end;
 
{ TMachin.TBidule }
 
constructor TMachin.TBidule.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
 
  FFont := TFont.Create();
end;
 
destructor TMachin.TBidule.Destroy();
begin
  FreeAndNil(FFont);
 
  inherited Destroy();
end;
 
procedure TMachin.TBidule.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;
 
initialization
  RegisterClasses([TMachin, TMachin.TBidule, TMachin.TTruc, TMachin.TTruc.TChose]);
 
 
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
unit SampleComponentToString;
 
interface
 
uses
  System.Classes;
 
function ComponentToStringProc(Component: TComponent): string;
function StringToComponentProc(Value: string): TComponent;
 
implementation
 
function ComponentToStringProc(Component: TComponent): string;
var
  BinStream:TMemoryStream;
  StrStream: TStringStream;
  s: string;
begin
  BinStream := TMemoryStream.Create;
  try
    StrStream := TStringStream.Create(s);
    try
      BinStream.WriteComponent(Component);
      BinStream.Seek(0, soFromBeginning);
      ObjectBinaryToText(BinStream, StrStream);
      StrStream.Seek(0, soFromBeginning);
      Result:= StrStream.DataString;
    finally
      StrStream.Free;
    end;
  finally
    BinStream.Free
  end;
end;
 
function StringToComponentProc(Value: string): TComponent;
var
  StrStream:TStringStream;
  BinStream: TMemoryStream;
begin
  StrStream := TStringStream.Create(Value);
  try
    BinStream := TMemoryStream.Create;
    try
      ObjectTextToBinary(StrStream, BinStream);
      BinStream.Seek(0, soFromBeginning);
      Result:= BinStream.ReadComponent(nil);
    finally
      BinStream.Free;
    end;
  finally
    StrStream.Free;
  end;
end;
 
end.